*DECK     RLINK - REAR END LINKAGES.
          IDENT  RLINK
 RLINK    SECT   (REAR-END LINKAGES.) 
          SPACE  4,10 
*         IN ALLOC
          EXT    ADW
  
*         IN CCGLINK
          EXT    APCON,ERR22
  
*         IN FAS
          EXT    RNI
  
*         IN PEM
          EXT    PDM
  
*         IN PUC
          EXT    N.TABLE,S=CON,T=APL,T=CAC,T=CON,T.APL,T.CAC,T.CON,T.CUT
          EXT    T.STMT,T.SYM,T=NLST
  
*         IN RERRS
          EXT    E.CCG,E.MO2
 RLINK    SPACE  4
***              RLINK PROVIDES ENTRY POINTS....... 
  
  
 FEC=BY   EQUENT 0
 STAGE    BSSENT 1
  
 BLL      BSSENT
 CHARMAP  BSSENT
 FEC.RTN  BSSENT
 LEXFLG   BSSENT
          EQ     "BLOWUP" 
  
  
 LDB      SUBR   =           DUMMY ENTRY POINT
 .T       IFEQ   TEST,ON,2
          SA1    =XT.STMT 
          NZ     X1,"BLOWUP" IF STATEMENT TABLE NOT EMPTY 
          EQ     EXIT.
 CGE      SPACE  4,10 
**        CGE -  CHECK (CODE) GENERATOR ERRORS
* 
*         QUERIES *ERR22* FOR ERRORS NOTED DURING (2,2) OVERLAY.
*         OUTPUTS THE PROPER DIAGNOSTIC, AS APPLICABLE. 
  
  
 CGE      SUBR   =           ...ENTRY/EXIT... 
          SA1    ERR22
          ZR     X1,EXIT.    IF NO DIAGNOSTICS TO OUTPUT
          SB7    E.MO2       INSUFFICIENT FL
          SX1    X1-1 
          NZ     X1,CGE1     IF NOT FL MESSAGE
          SB7    E.CCG       ECS/LCM HARDWARE ERROR 
  
 CGE1     FATAL  B7 
          SX6    0
          SA6    ERR22       CLEAR DIAGNOSTIC FLAG
          EQ     EXIT.
 CELLS    SPACE  4,10 
 LSR      CONENT 0           .NZ. IF FORMAL PARAMETER REFERENCE 
 N.ALTEN  CONENT 0           NUMBER OF ALTERNATE ENTRIES
  
  
*         RTT - REGISTER TRANSLATION TABLE. 
  
 RTT      BSS 
          ECHO   2,T=(1,0,2) (B,A,X)
          ECHO   1,N=(0,1,2,3,4,5,6,7)
          VFD    9/200B,3/T,45/0,3/N
  
  
*         HTT - H FIELD TRANSLATION TABLE.
  
 HTT      BSS 
          ECHO   1,T=(4,5,6,7,3)   RJOBK (A+,A-,B+,B-,X+) 
          VFD    6/T,54/0 
  
  
*         BJT - B JUMP TABLE. 
  
 BJT      BSS 
 .Z       SET    4
          ECHO   2,T=(EQ,NE,GE,LT)
 JB.T     =      .Z 
 .Z       SET    .Z+1 
  
          ECHO   1,JT=("BJUMPS")
          CON    JB.JT
 OPR      SPACE  4,10 
**        OPR - DEFINE OPR MACRO FOR JUMPS. 
  
          PURGMAC            OPR
  
          MACRO  OPR,NAM
          EQ     CI=NAM 
 OPR      ENDM
  
 OPJP     BSS 
          LOC    0
*CALL     OPRDEFS            OPT OPCODE DEFINITIONS 
          LOC    *O 
          TITLE  CII - CONVERT ISSUED INSTRUCTIONS. 
 CII      SPACE  4,10 
**        CII - CONVERT ISSUED INSTRUCTIONS.
* 
*         CALLED FROM *RAD* OF FAS TO CONVERT INSTRUCTIONS
*         FROM *SI* TO *PB* FORMAT. 
*         ENTRY  (X5) = INSTRUCTION IN *SI* FORMAT
*         EXIT   (X5) = INSTRUCTION IN *PB* FORMAT
  
  
 CII      SUBR   =           ...ENTRY/EXIT... 
  
*         INITIALIZE REGISTERS FOR PROCESSORS --
*         (B2) = OC[PI] 
*         (B6) = RTT
*         (X0) = MASK(-6) 
*         (X4) = RTT( RI[PI] )
*         (X5) = [PI] 
  
          MX0    -6 
          SB6    RTT
          BX6    -X0*X5 
          UX7    B2,X5
          SA4    RTT+X6      I = RTT( RI[PI] )
          JP     OPJP+B2     JUMP( OPJP( OC[PI] ) 
          TITLE  INSTRUCTION PROCESSORS.
 NOP      SPACE  4,10 
**        PROCESS NOP.
  
 CI=NOP   BSS 
          EQ     EXIT.
 BOS      SPACE  4,10 
**        PROCESS BOS.
  
 CI=BOS   BSS 
          SX7    I.BOS
          LX7    PB.GHIJP    [PB] = OC[PB]
          LX5    -SI.CAP
          SX3    X5          CA[PI] 
          LX3    PB.BIASP 
          BX5    X7+X3       [PB] = [PB] + BIAS[PB] 
          EQ     EXIT.
 TYI      SPACE  4,10 
**        TYPE I  OC=10-17,22-30,31-42,44,45,47 
*         PRI RJORK   (GH IJK)
*         FROM (OC,RK,RJ,RI) TO (GHIJK) 
  
 TYI      MACRO  NAM
          IRP    NAM
 CI=NAM   BSS    0
          IRP 
 TYI      ENDM
  
          TYI    (AND,OR,XOR) 
          TYI    (ILS,IRS,NR,RNZ,UP,PK,FA)         OC = 22-30 
          TYI    (FS,DFA,DFS,RFA,RFS,IA,IS,FM,RFM,DFM) OC=31-42 
          TYI    (FD,RFD,CX)                       OC = 44,45,47
  
 TYI      BSS 
          SX7    B2          (X7) = OC
          LX7    PB.GHP 
          SX3    X4          I = RTT( RI[PI] )
          LX3    PB.IP
          BX7    X7+X3       [P] = OC[PB] + I[PB] 
          LX5    -SI.RJP
          BX2    -X0*X5 
          SA3    B6+X2       J = RTT( RJ[PI] )
          SX2    X3 
          LX2    PB.JP
          BX7    X7+X2       [PB] = [PB] + J[PB]
          LX5    SI.RJP-SI.RKP
          BX2    -X0*X5 
          SA3    B6+X2       RK = RTT( RK[PI] ) 
          SX2    X3 
          LX2    PB.KP
          BX5    X7+X2       [PB] = [PB] + K[PB]
          EQ     EXIT.
 TYPE1    SPACE  4,8
*         XMT AND XMTC NEED K=J 
  
 CI=XMT   BSS 
 CI=XMTC  BSS 
          SX7    B2          (X7) = OC
          LX7    PB.GHP 
          SX3    X4          I = RTT( RI[PI] )
          LX3    PB.IP
          BX7    X7+X3       [P] = OC[PB] + I[PB] 
          LX5    -SI.RJP
          BX2    -X0*X5 
          SA3    B6+X2       J = RTT( RJ[PI] )
          SX2    X3 
          LX2    PB.JP
          BX7    X7+X2       [PB] = [PB] + J[PB]
          LX2    PB.KP-PB.JP
          BX5    X7+X2       [PB] = [PB] + K[PB]
          EQ     EXIT.
TYPE1     SPACE  4,8
  
*         NON-COMMUTATIVE BOOLEANS ARE OCIKJ. 
  
 CI=STR   BSS    0
 CI=IMP   BSS    0
 CI=EQV   BSS    0
          SX7    B2          (X7) = OC
          LX7    PB.GHP 
          SX3    X4          I = RTT( RI[PI] )
          LX3    PB.IP
          BX7    X7+X3       [P] = OC[PB] + I[PB] 
          LX5    -SI.RJP
          BX2    -X0*X5 
          SA3    B6+X2       J = RTT( RJ[PI] )
          SX2    X3 
          LX2    PB.KP
          BX7    X7+X2       [PB] = [PB] + J[PB]
          LX5    SI.RJP-SI.RKP
          BX2    -X0*X5 
          SA3    B6+X2       RK = RTT( RK[PI] ) 
          SX2    X3 
          LX2    PB.JP
          BX5    X7+X2       [PB] = [PB] + K[PB]
          EQ     EXIT.
 LCM      SPACE  4,10 
**        LCM READ AND WRITE - TYPE I   OC=64,65
*         PRJ RK   (01I JK) I=4,5 
*         FROM (OC,RI,RJ,RK) TO (GHIJK) 
  
          ECHO   8,NAM=(DRL,DWL),II=(4,5),OP=(LD,ST)
 CI=NAM   SB2    01B
          SX4    II 
          LX5    -SI.IHP
          SX3    X5 
          LX5    SI.IHP+SI.RJP-SI.RIP    FAKE TYI (RJ=RI, RJ=RK)
          ZR     X3,TYI      IF IH = 0  */ NOT LEVEL 0
          SX7    I.OP_0 
          EQ     SUB0 
  
 SUB0     LX7    PB.GHIJP 
          SX3    X3-IH.LCM
          LX3    PB.TAGP
          BX7    X7+X3
          LX5    -SI.RJP
          BX3    -X0*X5 
          SA3    B6+X3
          SX3    X3 
          LX3    3
          LX5    SI.RJP-SI.RKP
          BX2    -X0*X5 
          SA2    B6+X2
          SX2    X2 
          BX2    X2+X3
          LX2    PB.H2P 
          BX5    X7+X2
          EQ     EXIT.
 INT      SPACE  4,10 
**        INTEGER ARITHMETIC - TYPE I  OC=77,100,101
*         IXI XJOXK   (GH IJK)  GH=36,37,42 
*         FROM (OC,RI,RJ,RK) TO (GHIJK) 
  
          ECHO   2,NAM=(IAZ,ISZ,IM),OC=(36B,37B,42B)
 CI=NAM   SB2    OC 
          EQ     TYI
 TYII     SPACE  4,10 
**        TYPE II  OC=20,21,43
*         PRI    JK   (GH IJK)  GH=20,21,43 
*         FROM (OC,CA,RI) TO (GHIJK)
  
          ECHO   1,NAM=(KLS,KRS,FMA)
 CI=NAM   BSS 
          SX7    B2          (X7) = OPCODE
          LX7    PB.GHP 
          SX3    X4          I = RTT( RI[PB] )
          LX3    PB.IP
          BX7    X7+X3       [PB] = OC[PB] + I[PB]
          LX5    -SI.CAP
          MX0    -PB.JL-PB.KL 
          BX2    -X0*X5 
          LX2    PB.KP
          ERRNZ  PB.KP+3-PB.JP     CODE ASSUMES 6/IJ
          BX5    X7+X2       [PB] = [PB] + JK[PB] 
          EQ     EXIT.
 TYIII    SPACE  4,10 
**        TYPE III  OC=50-54,74 
*         SRI    RJ+CA+IH-H2   (GH IJQ) 
*         FROM (H2,OC,CA,IH,RJ,RI H2) TO (GHIJ,TAG,BIAS,TAG2) 
  
*         LDC (CONSTANT LOAD) PREPROCESSOR. 
  
 CI=LDC   BSS    0
          SB2    OC.LD
          MX6    -SI.CAL
          SA1    =XT.CUT
          LX5    -SI.CAP
          SB7    X1 
          BX2    X6*X5
          SA1    B7+X5
          BX5    X1+X2
          LX5    SI.CAP      CA = CUT(CA) 
  
          ECHO   1,NAM=(LD,ST,STT,PLD,PST,S,ILD,TLD,TST)
 CI=NAM   BSS 
  
          UX7    B3,X4       I = RTT( RI[PI] )
          LX7    PB.IP
          SX1    B3+5        G[OC]
          LX1    PB.GHP+3 
          BX7    X7+X1       [PB] = G[PB] + I[PB] 
          LX5    -SI.RJP
          BX2    -X0*X5 
          SA3    B6+X2       J = RTT( RJ[P] ) 
          UX2    B3,X3
          SX3    B3 
          LX2    PB.JP
          BX7    X7+X2       [PB] = [PB] + J[PB]
          LX5    SI.RJP-SI.IHP
          MX1    -IH.CAIHL
          BX2    -X1*X5 
          NZ     X2,LD1      IF IHCA[PI] .NE. 0 
          LX3    1           RJ*2 
          SB7    0
          EQ     TIB2        PROCESS AS 15 BIT SRI RJ 
  
 LD1      LX3    PB.GHP 
          BX7    X7+X3       [PB] = [PB] + H[PB]
          MX0    -SI.IHL
          BX6    -X0*X5 
          ZR     X6,LD2      IF IH[PI] .EQ. 0 
          RJ     CFP         CHECK FORMAL PARAMETERS
          MX0    -PB.TAGL 
          BX6    -X0*X5 
          LX6    PB.TAGP
          BX7    X7+X6       [PB] = [PB] + TAG[PB]
 LD2      LX5    SI.IHP-SI.CAP
          MX0    -SI.CAL
          BX6    -X0*X5      CA[PI] 
          ZR     X6,LD3      IF CA[PI] .EQ. 0 
          LX6    PB.BIASP 
          BX7    X7+X6       [PB] = [PB] + BIAS[PB] 
 LD3      LX5    SI.CAP+59-SI.H2P 
          PL     X5,LD4      IF H2[PI] .EQ. 0 
          BX0    X7 
          RJ     =XRNI       READ NEXT INSTRUCTION
          BX7    X0 
          SX6    X5          H2[PI] 
          RJ     CFP         CHECK FORMAL PARAMETERS
          SX6    X5          H2[PI] 
          LX6    PB.H2P 
          BX7    X7+X6       [PB] = [PB] + H2[PB] 
 LD4      BX5    X7 
          EQ     EXIT.
 TIB      SPACE  4,10 
**        TYPE I MEMORY REFS  OC=56-63
*         SRI RJORK  (GH IJK)  G=5,6,7 H=3-7
*         FROM (OC,RK,RJ,RI) TO (GHIJK) 
  
          ECHO   1,NAM=(SLD,SST,SA)    (56,57,60) 
 CI=NAM   BSS 
          SB7    0           FLAG A +BK 
          EQ     TIB
  
          ECHO   1,NAM=(SDL,SDS,SS)    (61,62,63) 
 CI=NAM   BSS 
          SB7    1           FLAG A -BK 
  
 TIB      UX7    B3,X4       I = RTT( RI[PI] )
          LX7    PB.IP       [PB] = I[PB] 
          SX1    B3+5        G[PB]
          LX1    PB.GHP+3 
          BX7    X7+X1       [PB] = [P] + G[PB] 
          LX5    -SI.RJP
          BX2    -X0*X5 
          SA3    B6+X2
          UX2    B3,X3       J = RTT( RJ[PI] )
          SX3    B3+B3       2 * TYPE(RJ) 
          LX2    PB.JP
          BX7    X7+X2       [PB] = [PB] + J[PB]
  
 TIB2     SX1    X3+B7
          SA3    HTT+X1      GET H PART OF OPCODE 
          BX7    X7+X3       [PB] = [PB] + H[PB]
          LX5    SI.RJP-SI.RKP
          BX2    -X0*X5 
          SA3    B6+X2
          SX2    X3 
          LX2    PB.KP
          BX5    X7+X2       [PB] = [PB] + K[PB]
          EQ     EXIT.
 JPX      SPACE  4,10 
**        X JUMPS  OC=66
*         JT     XJ,IH   (03I JQ) 
*         FROM (OC,CA,RI) TO (GHI,TAG)
  
 CI=JPX   BSS 
          SX3    X4          [PB] = RTT[RI] 
          LX5    -SI.CAP
          SX7    030B+X5     I = XJT( CA[PI] )
          LX7    PB.IP
          LX3    PB.JP
          LX5    SI.CAP-SI.IHP
          BX7    X7+X3       [PB] = [PB] + J[PB]
  
*         CJP - COMMON JUMP IH PROCESSING.
  
 CJP      BSS 
          MX0    -SI.IHL
          BX3    -X0*X5 
          LX3    PB.TAGP
          BX5    X7+X3       [PB] = [PB] + IH[PB] 
          EQ     EXIT.
 JPBB     SPACE  4,10 
**        B JUMPS   OC=67 
*         JT  BI,BJ,K   (0H IJQ) H=4,5,6
*         FROM (OC,CA,RI,RJ) TO (GHIJ,TAG)
  
 CI=JPBB  BSS 
          SX7    X4          I = RTT( RJ[PI] )
          LX7    PB.IP
          LX5    -SI.CAP
          SA3    BJT+X5      GH = BJT( CA[PI] ) 
          LX3    PB.GHP 
          BX7    X3+X7       [PB] = I[PB] + GH[PB]
          LX5    SI.CAP-SI.RJP
          BX6    -X0*X5 
          SA4    B6+X6       J = RTT( RJ[PI] )
          SX3    X4 
          LX3    PB.JP
          BX7    X7+X3
          LX5    SI.RJP-SI.IHP
          EQ     CJP         ADD IN IH FIELD
 JIN      SPACE  4,10 
**        INDEXED JUMP  OC=70 
*         JP  BI+IH   (02 I0Q)
*         FROM (OC,CA,RI) TO (I.JPI,TAG,BJR)
  
 CI=JIN   BSS 
          SX7    I.JPI
          LX7    PB.GHIJP    [PB] = OC[PB]
          SX3    X4          I = RTT( RI[PI] )
          LX3    PB.BJRP
          LX5    -SI.IHP
          BX7    X7+X3       [PB] = [PB] + BJR[PB]
          EQ     CJP         ADD IH FIELD 
 RJ3      SPACE  4,10 
**        RETURN JUMP  OC=71
*         RJ  IH   (01 Q) 
*         FROM (OC,IH) TO (I.RJ3,TAG) 
  
 CI=RJ3   BSS 
          SX7    I.RJ3
          LX7    PB.GHIJP    [PB] = OC[PB]
          EQ     CJP         PROCESS IH FIELD 
 RJ6      SPACE  4,10 
**        RETURN JUMP WITH TRACEBACK   OC=72
*         RJT  IH,CA   (+01 Q)
*         FROM (OC,CA,HI) (TYPE IV) TO (I.RJ6,TAG,BIAS) 
  
 CI=RJ6   BSS 
          SX7    I.RJ6
          LX7    PB.GHIJP    [PB] = OC[P] 
          LX5    -SI.CAP
          MX0    -SI.CAL
          BX3    -X0*X5 
          LX3    PB.BIASP    BIAS[PB] = LINE NUMBER 
          BX7    X7+X3       [PB] = [PB] + BIAS[PB] 
          LX5    SI.CAP 
          SX6    X5          IH[PI] 
          RJ     CFP         CHECK FOR FORMAL PARAMETER 
          SX6    X5          IH[PI] 
          LX6    PB.TAGP
          BX5    X7+X6       [PB] = [PB] + IH[PB] 
          EQ     EXIT.
 UJP      SPACE  4,10 
**        UNCONDITIONAL JUMP   OC=73
*         EQ  IH   (04 Q) 
*         FROM (OC,IH) TO (I.UJP,TAG,BIAS)
  
 CI=UJP   BSS 
          SX7    I.UJP
          LX7    PB.GHIJP    [PB] = OC[PB]
          EQ     CJP         ADD IH FIELD 
 LAB      SPACE  4,10 
**        LABELS  OC=6
*         IH  BSS  0
*         FROM (OC,IH) TO (I.BSS,TAG) 
  
 CI=LAB   BSS 
          SX7    I.BSS
          LX7    PB.GHIJP    [PB] = OC[PB]
          EQ     CJP         ADD IH FIELD...
 ERRORS   SPACE  4,10 
**        ERRORS - THESE OP CODES SHOULD NEVER BE ENCOUNTERED.
  
  
          MACRO  ILL,NAM
 CI=NAM   EQ     "BLOWUP" 
 ILL      ENDM
  
  
 CLR      ILL 
 DAR      ILL 
 DEF      ILL 
 ENT      ILL 
 EOQ      ILL 
 EOS      ILL 
 LDV      ILL 
 RJXJ     ILL 
 RS       ILL 
 SXT      ILL 
  
          LOC    *O 
 BCT      SPACE  4,8
**        BCT - CONVERT CONSTANT TABLE. 
* 
*         REFORMAT *CUT* AS ORDINALS TO CON. ARRAY, SQUEEZE UNUSED
*         ENTRIES OUT OF *CON*. 
  
 BCT      SUBR   =
          MX6    0
          ADDWD  T.CUT
          SA3    =XT.CON
          SB2    B0          I = 0
          SB3    X2          N = L.CUT
          SB4    X3                        (B4) = CON 
          SB5    X1                        (B5) = CUT 
          SX7    0           J = 0
  
 BCT1     SA5    B5+B2
          ZR     X5,BCT2     IF CUT(I) = 0 */ CON NOT REFERENCED
  
          SA7    A5          CUT(I) = J    */ SET ORDINAL 
          SA4    B4+B2
          BX6    X4          CON(J) = CON(I)  */ MOVE TO FINAL POSITION 
          SA6    B4+X7
          SX7    X7+B1       J = J + 1
  
 BCT2     SB2    B2+B1       I = I + 1
          LT     B2,B3,BCT1  IF I < N 
          SA7    =XT=CON
          EQ     EXIT.
          TITLE  POST SUPPORT ROUTINES. 
 CFP      SPACE  4,10 
**        CFP - CHECK FOR FORMAL PARAMETERS.
* 
*         ENTRY  (X6) = IH[PI] OR H2[PI]
* 
*         EXIT   IF FP[WB]=1, RA[WC] IN O.SYM1
*                             (LSR) SET NONZERO 
*                ELSE NO CHANGE 
* 
*         CANNOT DESTROY  X5,X7 
  
  
 CFP      SUBR               ...ENTRY/EXIT... 
          BX3    X6 
          AX3    IH.IP
          NZ     X3,EXIT.    IF NOT SYMBOL TABLE SYMBOL 
          SB2    X6 
          IX3    X6+X6
          SB2    X3+B2       3*SYMORD 
          ERRNZ  3-Z=SYM
          SA2    =XT.SYM
          SB2    B2+WB.W
          SA2    X2+B2       WB OF SYMTAB 
          HX2    WB.FP
          PL     X2,EXIT.    IF NOT F.P., EXIT... 
          =A3    A2+1        WC OF SYMTAB 
          LX3    -WC.RAP
          =X2    1
          IX6    X3+X2       RA[WC] = RA[WC] + 1
          LX6    WC.RAP      RESTORE POSITION 
          SA6    A3          UPDATE RA[WC]
          SA6    LSR         FLAG F.P.
          EQ     EXIT.       DONE...
 SMB      SPACE  4,10 
**        SMB - SET MAT BIT FOR VARIABLES.
*         ALL NAMELIST MEMBERS THAT HAVE CLAS BITS(MAT,EQV,DEF,VAR) SET,
*         RESULT IN THE *EQ. * BASE MEMBER *MAT* BIT BEING CHECKED/SET. 
* 
  
  
 SMB      SUBR   =           ENTRY/EXIT.
          SA4    T=NLST 
          ZR     X4,SMB      IF NO NAMELIST ENTRIES 
          SB2    B1 
          SB3    B0 
  
 SMB3     CALL   SNR         SET NAMELIST REGISTERS 
          CLAS=  X4,WB,(MAT,EQV,DEF,VAR)
          BX3    X4*X1       X1 =   T.SYM WORD B OF REQUESTED NAME
          BX4    X3-X4
          NZ     X4,SMB4     IF(MAT,EQV,DEF,VAR)CLASS BITS NOT SET
          MX0    WB.BASEL 
          ERRNZ  WB.BASEL-12
          LX0    WB.BASEP-WB.PNTP-1 
          ERRNZ  WB.PNTL-13 
          BX3    X0*X1
          AX3    -WB.BASEP+WB.CLASP+1 
          ERRNZ  WB.PNTL-13 
          SA4    T.SYM
          SB5    X4+WB.W
          SB6    X3+B5
          LX4    X3,B1
          SA1    B6+X4       (X1)=T.SYM WORD B OF EQV CLASS BASE MEMBER 
          CLAS=  X3,WB,(MAT)
          BX6    X1+X3
          SA6    A1 
  
 SMB4     GT     B2,SMB3     IF MORE MEMBERS
          LT     B3,SMB      IF NO MORE GROUPS
          SB2    B1 
          EQ     SMB3        CHECK MEMBERS OF NEXT GROUP
          EQ     EXIT.
 PAT      SPACE  4,10 
**        PAT - PRE-PROCESS AP-LIST TABLES. 
*                FOR EACH AP-LIST ENTRY, IF TAG[AP.] .EQ. (S=CON), SET
*                BIAS[AP.] = T.CUT( BIAS[AP.]). 
*         CALLED FROM *FO=APL* AND *FO=IOM* OF FAS. 
*         ENTRY  (B6) = 0 IF PROCESSING T.APL 
*                     = 1 IF PROCESSING T.IOA 
  
  
 PAT      SUBR   =           ENTRY/EXIT.
          SA1    =XT.APL+B6 
          SA2    =XT=APL+B6 
          SA3    =XAPCON
          ZR     X3,EXIT.    IF NO CONSTANTS IN AP-LISTS
          SA5    =XS=CON
          SA4    =XT.CUT
          SB5    X4 
          SB3    B6+B1       (B3) .EQ. 1 IF T.APL, .EQ. 2 IF T.API
          ERRNZ  2-Z=IOA
          MX0    -IA.TAGL 
          MX3    -IA.BIASL
          SB2    X2 
          SA2    X1-1 
          CLAS=  X1,IA,(CRH,CHAR) 
  
*         PROCESS NEXT ENTRY OF AP-LIST TABLE.
*         (A1) = API
*         (B2) = APLEN
*         (B3) = Z=APL/Z=IOA
*         (X5) = (S=CON)
*         (B6) = T.APL/T.IOA INDICATOR
*         (B5) = FWA(T.CUT) 
  
 PAT10    ZR     B2,EXIT.    IF END OF TABLE
          SA2    A2+B1
          BX4    X1*X2
          SB2    B2-B3
          LX2    -IA.TAGP 
          BX6    -X0*X2      TAGI = TAG[AP2]
          NZ     X4,PAT20    IF CHARACTER 
          IX7    X5-X6
          LX2    IA.TAGP-IA.BIASP 
          NZ     X7,PAT20    IF TAGI .NE. (S=CON) 
          BX6    -X3*X2      BIASI = BIAS[API]
          BX7    X3*X2       CLEAR BIAS FIELD 
          SA4    X6+B5       CUI = T.CUT(BIASI) 
          BX4    -X3*X4 
          BX7    X7+X4
          LX7    IA.BIASP 
          SA7    A2 
  
 PAT20    NE     B6,B1,PAT10 IF NOT PROCESSING IO-APLISTS 
  
*         FOR IO-APLISTS, PROCESS IO1 ENTRY IF LIST ITEM. 
*         (X1) = AP1
  
          SA2    A2+B1
          LX2    -IA.TAGP 
          BX6    -X0*X2      TAGI = TAG[IO1]
          IX6    X6-X5
          LX2    IA.TAGP-IA.BIASP 
          BX4    -X3*X2      BIASI = BIAS[IO1]] 
          BX7    X3*X2       CLEAR BIAS FIELD 
          NZ     X6,PAT10    IF TAGI .NE. (S=CON) 
          SA4    X4+B5       CUI = T.CUT(BIASI) 
          BX4    -X3*X4 
          BX7    X7+X4
          LX7    IA.BIASP 
          SA7    A2          BIAS[AP2] = CUI
          EQ     PAT10
 PCA      SPACE  4,8
**        PCA - PROCESS CONSTANT REFERENCES IN T.CAC. 
  
 PCA      SUBR   =
          SA1    =XAPCON
          SA2    =XT=CAC
          ZR     X1,EXIT.    IF NO CONSTANTS IN APLISTS 
          SA3    =XT.CAC
          ZR     X2,EXIT.    IF NO T.CAC
          SA4    =XT.CUT
          SB6    X2-1 
          SB3    X4 
  
 PCA10    SA1    X3+B6
          MI     B6,EXIT.    IF TOP OF TABLE
          SB6    B6-B1
          LX1    59-WC.RBP
          PL     X1,PCA10    IF RB NE 1  */ NOT CON.
          LX1    1+WC.RBP-WC.RAP
          SA4    B3+X1       CUT[RA]
          ERRMI  WC.RAL-18
          SX2    X1 
          BX0    X1-X2       CLEAR RA 
          BX7    X4+X0       ADD IN RA[CUT ENTRY] 
          LX7    WC.RAP 
          SA7    A1 
          EQ     PCA10
*CALL COMFSCS 
 RLINK    SPACE  4,10 
          LIST   D
          END 
