*DECK     GEN 
          IDENT  GEN
 GEN      SECT   ((QCG)    QUICK CODE GENERATOR.) 
 GEN      SPACE  4
*         IN ALLOC
          EXT    ADW,ALC,ALC.CAI,ALC.REG,ALC.00 
  
*         IN CONRED 
          EXT    REG=T
  
*         IN FEC
          EXT    ESTACK 
  
*         IN FTN
          EXT    CO.DBER,CO.DBID,CO.LL,CO.SNAP
  
*         IN FUN
          EXT    UAP
  
*         IN IDP
          EXT    IDP=SVB,IDP=SVX,REG= 
  
*         IN PUC
          EXT    BN=APL,BN=CODE,BN=CON,BN=FMT,BN=IOAP,BN=NLST,BN=STRT 
          EXT    BN=SUB,BN=TEM,LEVEL0,MOD,NARGS,N.ARP,N.CON,N.EPL,N.FP
          EXT    N.GL,S=AEXIT,S=CP,S=CPL,S=ENTRY,S=EXIT,S=FID,S=FILES 
          EXT    S=GPL,S=LA,S=LENP,S=SA1,S=SPA,S=SUB,S=SUBI,S=SUB0I 
          EXT    S=TA0,S=TRACE,S=UPW,S=VALUE,T=CON,T=DATS,T=ENTP,T=FPI
          EXT    T=LA,T=PAR,T=VDI,T=VDIM,T.DATS,T.DIM,T.ENTP,T.FPI,T.LA 
          EXT    T.PAR,T.SYM,T.VDI,T.VDIM,WO.CS,WO.DOOT 
          EXT    S=SA0
  
*         IN QCGC 
          EXT    DRITE,ITS,PIG,POS,RED,REG=G,RGC,RGX,RREG,TRACE,TYPLOD
          EXT    UUC,WIN,WTE
  
*         IN QSKEL/FSKEL
          EXT    F.SCT,F.SKEL,V=BSS,V=NOOP,W=ALENT,W=DFENT,W=FUNT,W=IDV 
          EXT    W=IMV,W=MASKV,W=MFPNT,W=MODG,W=PROM,W=PROS,W=SHIFV 
          EXT    W=TENT,W=TMENT 
  
*         IN REG
          EXT    AIR,ASR,CDS,CIA,CLOADJ,CRJ,DIT,DSC,GNR,GSTC,GTR,LSC
          EXT    LTG,P2=KEEP,REGLK,RG=INTR,RG=LOAD,RG=LODX,RG=STOR
          EXT    RG=TEMP,RLL,RUL,RUT,SDS,SLD,STRGLK,STS 
  
*         IN UTILITY
          EXT    MVE= 
  
          LIST   -X 
                             COMAQCG IS LISTED IN QCGC
*CALL     COMAQCG            QCG MACRO DEFINITIONS
                             COMSEIS IS LISTED IN QSKEL 
*CALL     COMSEIS            QCG SKELETON WORD FORMAT 
                             COMSQCG IS LISTED IN QCGC
*CALL     COMSQCG            QCG STRUCTURE DECLARATIONS 
                             COMSQRF IS LISTED IN QCGC
*CALL     COMSQRF            QCG REGISTER ASSOCIATES
                             DEFINS IS LISTED IN QSKEL
*CALL     DEFINS             DEFINE MACHINE OPCODES 
          LIST   *
 ISSUE    SPACE  4,10 
**        ISSUE - ISSUE OPERATION OR PSEUDO TO PB.
* 
*         ISSUE  OP,TAG,RETURN
* 
*         ENTRY  *OP* = OPERATION CODE FOR (PB.GHIJ). 
*                            (X7 IS NATURAL REGISTER) 
*                *TAG* = VALUE FOR (PB.TAG).
*                        IF PROPERLY POSITIONED, A BIAS VALUE CAN 
*                        ALSO BE PRESENT IN THE REGISTER. 
*                        BE CAREFUL.
*                            (X1 IS NATURAL REGISTER) 
*                *RETURN* = OPTIONAL RETURN ADDRESS.
*                *RETURN* OMITTED = CONTINUE IN LINE. 
*                            (B2 IS NATURAL REGISTER) 
* 
*         CALLS  WCODE. 
  
  
 ISSUE    MACRO  OP,TG,RET
          =X7    OP 
          LX7    PB.GHIJP 
* 
          IFC    NE,/TG//,3 
          =X1    TG 
          LX1    PB.TAGP
          BX7    X7+X1
* 
          WCODE  X7,RET 
          ENDM
  
 O$       MICRO  1,,/T./
 L$       MICRO  1,,/T=/
 BT       MICRO  1,,/B6/
          TITLE  EIS - EXPAND INSTRUCTION SKELETONS.
 EIS      SPACE  4,20 
**        EIS -  EXPAND INSTRUCTION SKELETON. 
* 
*         HEART OF PASS TWO PROCESSING.  *EIS* USES THE PARSED FILE,
*         BUILT DURING PASS ONE AS A PSEUDO- MICRO PROGRAMMING FILE TO
*         GENERATE OBJECT CODE FOR THE CURRENT SEQUENCE.  EACH TURPLE 
*         IS EXPANDED USING THE OR.OPR WORD AS THE ADDRESS FOR THE
*         SKELETON.  AS EACH PORTION OF THE INSTRUCTION IS PROCESSED
*         *EIS* KEEPS TRACK OF REGISTERS USED, TYPE OF USAGE, OP-CODES
*         AND SEQUENCE BREAKS WITHIN THE PASS ONE FILE. 
* 
* 
*         SPECIAL CASING IS DONE WHEN THE OP-CODE FOR A GIVEN EXPANSION 
*         DEFINES EITHER A LOAD OR STORE OPERATION.  AFTER THE J PORTION
*         OF A LOAD INSTRUCTION IS SET INTO *INS.REG*, EIS LOOKS AT THE 
*         TYPE OF REGISTERS USED TO DETERMINE WHAT TYPE OF LOAD 
*         INSTRUCTION IS TO BE COMPILED.  IN DOING THIS, *EIS* MIGHT
*         HAVE TO INSERT SPECIAL SEQUENCES OF SKELETONS TO GET THE
*         REGISTERS SET-UP CORRECTLY FOR ADDRESS GENERATION.
* 
*         CURRENTLY THERE ARE FOUR MAJOR ROUTES *EIS* MAY TAKE
*         1.  NON-STANDARD PROCESSORS 
*             EXTERNAL PROCESSOR MUST BE CALLED TO EXPAND CURRENT 
*             SKELETON. 
*         2.  A RESET OF SKELETON 
*             CURRENT SKELETON USES ANOTHER SKELETON TO COMPLETE
*             EXPANSION OF CURRENT TURPLE.
*         3.  A CALL DURING SKELETON EXPANSION
*             SUB-PROCESS INSIDE SKELETON REQUIRES A SPECIAL PROCESSOR
*             TO HANDLE SUB-FUNCTION OF TURPLE. 
*         4.  A USE OF ANOTHER SKELETON FOR A SUB-PROCESS OF CURRENT
*             TURPLE. 
*             CURRENT TURPLE IS PARTIAL DEFINED BY ANOTHER SKELETON.
* 
*         ENTRY  (B4) _ 1ST PARSED TURPLE.
* 
*         EXIT   CODE COMPILED FOR PARSED FILE. 
* 
*         --------------- L O C K  -  R E G I S T E R S --------------
* 
*                       B4 _ POINTS TO CURRENT TURPLE.
*                       A4,X4 = CURRENT INSTRUCTION SKELETON. 
* 
*         NO ROUTINE INTERNAL TO *EIS* MAY DESTROY ABOVE REGISTERS. 
*         ------------------------------------------------------------
  
  
 O=EISX   BSS    0           LAST SKELETON
  
 EIS      SUBR   =           ENTRY/EXIT...
          SX6    R.X5-R.X0
          MX7    -1 
          SA6    RGX         INITIALIZE REGISTER USAGE
          =X6    X6+1 
          SA7    REGLK
          SA7    STRGLK 
          SA6    RGC         INITIALIZE LOAD REGISTERS
  
*         RESET REGISTER SKELETON WORDS 
  
 RESET    ECHO   ,CLASS=(INTR,TEMP,LOAD,LODX,STOR)
          =A1    =XRG=CLASS+2 
          BX6    X1 
          =A6    A1-1 
 RESET    ENDD
  
 EIS.PNX  BSSENT 0
  
 .SNAP=W  IFEQ   TEST,ON
          SA5    CO.SNAP
          LX5    1RW
          PL     X5,PNX1
 TURP=W   REGS   (B4),,1E5
 PNX1     BSS    0
 .SNAP=W  ENDIF 
  
          =A5    B4+OR.OPR
          MX0    -OP.LINEL
          LX0    OP.LINEP 
          BX1    -X0*X5      EXTRACT (X1) = LINE NUMBER 
          ZR     X1,PNX4     IF NO LINE NUMBER
          RJ     BOS         BEGINNING OF STATEMENT 
  
 PNX4     ZR     X5,EXIT.    IF END OF I. L.
          CALL   RED         REFORMAT OPR FOR EXPANSION AND DEFINITION
          SA2    X6+F.SCT    LOAD CONTROL WORD FOR SKELETON 
          SX7    1+ 
          LX2    -VS.SBIP 
          SX6    X2          (X6) = SKELETON BEGIN ORDINAL (W=) 
          ERRNZ  18-VS.SBIL 
          SA7    UUC         INITIALIZE USE COUNT DECREMENT 
  
 SUB.RET  BSSENT 0           SUBSKELETON RETURN 
          SB2    X6+F.SKEL   INSTRUCTION SKELETON ADDRESS 
          SA4    B2-1        DUMMY LOAD TO ACTIVATE (A4)
  
 .SNAP=W  IFEQ   TEST,ON
          SA1    CO.SNAP
          LX1    1RW
          PL     X1,SRET1 
 SKEL=W   REGS   (X6),,1E5
 SRET1    BSS    0
 .SNAP=W  ENDIF 
  
  
 EIS.LNX  BSS    0
          SX6    -3 
          BX5    0           CLEAR REGISTER ASSEMBLE - 000. 
          SA6    IJK
          =X7    A4+1 
          =A4    A4+1 
 SPECIAL  SPACE  4,8
**        CHECK IF SKELETON REQUIRES SPECIAL HANDLING 
* 
*         S-BRANCH - BRANCH TO A NEW SKELETON X AND CONTINUE
*         CALL   - EXTERNAL PROCESSOR *RJ* TO X.
*         OTHER  - NORMAL PROCESSING. 
* 
*         ENTRY  (X4) = CURRENT SKELETON WORD.
  
          BX0    X4 
          SA7    CURSK
          AX0    SK.TYPP
          MX1    -SK.TYPL+1 
          BX7    -X1*X0      EXTRACT OPCODE TYPE
          SB7    X7 
          SA7    OPTYP
          JP     B7+EIS.TYP 
  
 EIS.TYP  BSS    0
          LOC    0
 M.COND   EQ     EIS.COND    CONDITIONAL
 M.NORM   EQ     EIS.LN1     ARITHMETIC OPCODES 
 M.INCR   EQ     EIS.LN1     LOAD REGISTER
 M.BRAN   EQ     EIS.BRN     BRANCH 
 M.SHIF   EQ     EIS.SHF     SHIFT / XMT
 M.ICALL  EQ     EIS.CALL    CALL A SUBROUTINE
 M.INOOP  EQ     NULLOP      FOR PROCESSING NOOPS 
 M.ISBRN  EQ     EIS.SBRN    FOR BRANCHING TO ANOTHER SKELETON
 M.LOAD   EQ     EIS.LOD     LOAD / STORE TURPLE
 L.MTBL   BSS                LENGTH OF TYPE JUMP-VECTOR 
          LOC    *O 
  
**        IF PROCESSING *RESET* SKELETON
  
 EIS.SBRN BSS    0
          =B2    X4          GET SKELETON ADDRESS 
 .TEST    IFEQ   TEST,ON
          MI     B2,"BLOWUP" IF OLD TURPLE RESET CALL 
 .TEST    ENDIF 
          =A4    B2-1        INITIALIZATION LOAD FOR EIS.LNX
          EQ     EIS.LNX
  
**        IF PROCESSING *CALL* SKELETON 
  
 EIS.CALL SB2    X4          JUMP ADDRESS 
          AX4    SK.ARGP
          SX1    X4 
          SB7    X4 
  
**        WHEN (P.MARG) IS POSITIVE, IT CONTAINS THE ARGUMENT TO THE
*         MACRO.
  
          LX1    P2.TAGP
          GE     B7,EIS.CL5  IF A CONSTANT
  
**        WHEN (P.MARG) IS NEGATIVE, THE MACRO ARGUMENT IS IN THE PARSED
*         TURPLE, AND (P.MARG) IS THE COMPLEMENT OF THE ORDINAL IN THE
*         TURPLE WHICH CONTAINS THE ARGUMENT. 
  
          SB7    X4 
          SA1    B4-B7       LOAD ARGUMENT FROM PARSED FILE 
 EIS.CL5  JP     B2          EXECUTE CALLED ROUTINE 
  
**        IF PROCESSING *LOAD* TYPE INSTRUCTION.
  
 EIS.LOD  MX0    -SK.QFL
          BX6    -X0*X4 
          ZR     X6,EIS.LN1  IF NO HARD REGISTER SPECIFIED
          SA6    RREG        SET HARD REGISTER
          SA6    HREG        SET LOCK FLAG
          EQ     EIS.LN1
  
**        EIS.LN1 - START PROCESSING OF CURRENT SKELETON. 
* 
*         ENTRY  (A4),(X4) = CURRENT SKELETON WORD. 
*                (IJK) = -3.
  
 EIS.COND BSS    0
 EIS.BRN  BSS    0
 EIS.SHF  BSS    0
 EIS.NOOP BSS    0
 EIS.LN1  MX0    SK.OPCL
          LX0    SK.OPCP+SK.OPCL
          BX6    X0*X4       EXTRACT OP-CODE FIELD
          LX4    -SK.QFL
          AX6    SK.OPCP
          SA6    OPCODE      CURRENT OP-CODE
  
**        RETURN HERE FOR NEXT PROCESSING OF NEXT PORTION OF INSTRUCTION
*         CURRENTLY EXPANDING WITHIN SKELETON.
  
 EIS.NX   SA1    IJK
          MX0    -SR.NUML 
          SB7    X1-3 
          GT     B7,B1,EIS.CMP     IF FINISHED. 
 EIS.JP   SPACE  4,20 
**        HERE IF NOT END OF CURRENT SKELETON.
*         JUMP TO PROCESSOR FOR CURRENT PORTION OF INSTRUCTION. 
* 
*         ENTRY  (X0) = MASK OF -SR.OADL
*                (X4) = SKELETON SHIFTED BY N*SR.OADL 
* 
*         EXIT   (X3) = (INUM) FIELD. 
*                (X6) = 0 
  
          =X6    1
          BX3    -X0*X4      REGISTER/CONSTANT NUMBER.
          MX0    -SR.OADL 
          LX4    -SR.NUML 
          SA6    UUC         SET UPDATE USE COUNT INCREMENT 
          BX1    -X0*X4 
 .TEST    IFEQ   TEST,ON     IF TEST MODE 
          SX2    X1-L.ATABLE
          PL     X2,"BLOWUP"       IF INDEX OUTSIDE VECTOR
 .TEST    ENDIF 
          SA2    X1+AT.BASE 
          SB2    X2          ADDRESS OF PROCESSOR.
          =B7    0
          BX6    0           CLEAR REGISTER ASSIGNMENT
          JP     B2 
 TYPES    EJECT  4,20 
**        INDIVIDUAL PROCESSOR SECTION FOR SPECIFIED TYPE OF REQUEST
*         NOTE   AT.I TABLE MAY NOT EXCEED 5 BITS IN LENGTH,
*                MAXIMUM LENGTH =37B... 
  
  
          MACRO  SKOP,OP,NOTLAST,LAST,STRING,OPEQ 
 .1       IFC    EQ,/OPEQ// 
          IFC    NE, LAST NOTLAST ,5
          IFC    NE, NOTLAST NONE ,4
 ADDRESS  MICRO  1,, EIS.NOTLAST
 CHRCNT   MICCNT ADDRESS
 BLANKS   MICRO  CHRCNT+1,,/            / 
          CON    "ADDRESS""BLANKS"AT.OP 
          IFC    NE, LAST NONE ,4 
 ADDRESS  MICRO  1,, EIS.LAST 
 CHRCNT   MICCNT ADDRESS
 BLANKS   MICRO  CHRCNT+1,,/            / 
          CON    "ADDRESS""BLANKS"ZT.OP 
 .1       ENDIF 
          ENDM
  
 OPSTR    MICRO              NULL DEF FOR *SKOP*
  
  
 AT.BASE  BSS                BASE OF FIELD PROCESSOR JUMP VECTOR
          LOC    0
          LIST   G,-X 
                             SKOP IS LISTED IN QSKEL
*CALL     SKOP               DEFINE LINKAGE TO AT.PROCESSORS
          LIST   *
  
 L.ATABLE BSS                NUMBER OF FIELD PROCESSORS 
          LOC    *O 
          ERRPL  L.ATABLE-1S5 
 EIS.CMP  EJECT  4,20 
**        COMPILE - FLUSH INSTRUCTION TO LONG FILE. 
* 
*             HERE WHEN  I,J,K AND Q PORTIONS OF SKELETON HAVE BEEN 
*             EVALUATED.
* 
*         ENTRY  INS.REG = REGISTERS - IJK
*                (X1) = REGISTERS - I00 
*                (X6) = REGISTERS - 0I0 
*                (X4) = SKELETON WORD SHIFTED TO SK.TYPP FIELD
  
  
 EIS.CMP  SA2    OPTYP
          MX0    -SK.OPCL 
          LX1    X4          SAVE 
          SB7    X2-M.LOAD
          NZ     B7,EIS.CM1  IF NOT *LOAD* OP-CODE
  
**        TERMINATE INSTRUCTION *LOAD* OPERATOR 
  
          BX3    X4 
          SA1    RREG 
          LX3    59-SK.ENDP+SK.OPCP 
          SB7    X1+XMT 
          NZ     B7,NULLOP   IF LOAD SATISFIED
          BX2    -X1
          MX7    -1 
          SA5    INS.REG
          SA7    A1          INDICATE SATISFIED 
          IX7    X2+X5
          LX7    PB.INSTP 
          EQ     EIS.CM6
  
 EIS.CM1  BX2    -X0*X4      OPCODE FIELD 
  
**         DUMP CURRENT INSTRUCTION.
  
          BX3    X2 
          AX3    3
          LX4    -SK.OPCL 
          SB2    X3 
          SA5    INS.REG
          MX0    -SK.TYPL 
          BX0    -X0*X4      TYPE FIELD.
  
          LX5    60-SK.OPCL-3-3 
*         (X2) = OP-CODE
*         (X5) = I,J,K PORTION OF INSTRUCTION 
*         (A5) _ INS.REG
  
          SB3    X2          GET OPCODE FOR JUMP TESTS
          SA3    A4          RESET SKELETON INSTRUCTION WORD
          LX2    -SK.OPCL    POSITION OPCODE FOR PRE-BINARY 
          HX3    SK.END      POSITION END OF SKELETON BIT 
          IX7    X5+X2       SET PRE-BIN,OPCODE + I,J,K/Q FIELDS
          ZR     B3,CBREAK   IF UNCONDITIONAL JUMP CLEAR REGS 
          SA2    DRITE
          SB3    B3-XMT/1S6  (XMT = CONDITIONALS + 1) 
          ZR     X2,COMPILE  IF NO DELAYED STORE WRITE TO PRE-BIN 
          PL     B3,COMPILE  IF NOT A JUMP WRITE TO PRE-BIN 
 CREAK    EJECT  4,8
**        CBREAK - CHECK IF CURRENT OPCODE BEING COMPILED 
*         BREAKS THE CURRENT REGISTER ALLOCATION SEQUENCE.
* 
*         NOTE - GENERAL RETURN ADDRESS FOR EXTERNAL PROCESSORS.
*         ENTRY  (X3) = SKELETON SHIFTED BY SK.ENDP 
*                (X7) = INSTRUCTION ABOUT TO BE ADDED TO T.PB 
  
 CBREAK   SA7    ESTACK 
          CALL   CIA         CLEAR REGISTER FILE
          SA2    ESTACK 
          BX7    X2 
  
**        COMPILE - OUTPUT INSTRUCTION TO LONG FILE.
* 
*         ENTRY  SAME AS *CBREAK* 
  
 EIS.CM6  BSS    0
 COMPILE  WCODE  X7           INSTRUCTION TO LONG FILE
  
**        NULLOP - NULL PROCESSING
* 
*         ENTRY  SAME AS *CBREAK* (X7) IGNORED. 
  
 NULLOP   BSSENT 0
 O=NOOP   BSSENT 0           NULLOP FOR TURPLE
 O=BVD    BSSENT 0           BEGIN VARDIM 
 O=HSBS   BSSENT 0           SUBSTRING PROCESSOR IS A NULLOP
 O=HCAT   BSSENT 0           CONCAT IS DEFERED
 O=HCOL   BSSENT 0           COLON TURPLE IS DEFERRED 
          SA1    IJK
          SX1    X1-6 
          NZ     X1,EIS.CM9  IF INSTRUCTION NOT COMPLETED 
          SA1    INS.REG
          BX7    X1 
          SA7    RUT.REG     IJK PARTS OF INSTRUCTION JUST COMPLETED
  
 EIS.CM9  MX6    0
          =X7 
          SA6    INS.REG     CLEAR REGISTER ASSEMBLY CELL 
          =A7    A6+1        CLEAR OPCODE CELL
          SA1    REGLK
          =A7    A1+1        *I* PORTION
          =A6    A7+1        *J* PORTION
          SB7    X1 
          CALL   RUL         UNLOCK REGISTER
          MX6    -1 
          SA3    CURSK
          SA4    X3 
          HX4    SK.END 
          SA6    REGLK
          PL     X4,EIS.LNX  IF NOT LAST INST. IN SKEL
          SB4    B4+Z=TURP
          EQ     EIS.PNX     PROCESS NEXT TURPLE
  
 CURSK    BSSENT 1
 HARDRG   EJECT  4,8
**        2.  ASSIGN TEMPORARY REGISTER.
**            A.  ASSIGN TEMPORARY *B* REGISTER.
  
  
 EIS.AB   SB2    X3+REG.B    SET 0TR IN B2. 
          BX6    X3 
          LX6    3           SET 0R0 FOR EIS.REG
  
**        CREATE A DUMMY ENTRY FOR THE REGFILE
  
          SX7    MAX.USEC    MAX USE COUNT PREVENTS SELECTION 
          LX7    RG.USEP
          SA7    B2+REGFILE  SET IN REGFILE 
          EQ     EIS.LRF
 EIS.AX   EJECT  4,8
 EIS.X    EJECT  4,8
**        EIS.AX AND EIS.CX - HARD *X* REGISTER PROCESSORS
* 
*         ENTRY  (X3) = REGISTER REQUESTED TO ASSIGN
* 
*         IF REGISTER REQUESTING IS NOT A STORE REGISTER, REGISTER IS 
*         SET AFTER ANY CONFLICT WITH A TEMPORARY REGISTER IS RESOLVED. 
*         IF A STORE REGISTER IS REQUESTED, A CHECK IS MADE FOR A STORE 
*         REG  DEADLOCK, ONCE THIS IS REMEDIED THE HARD REG IS SET. 
*         A DUMMY REGFILE ENTRY IS SET WITH MAX.USEC-1 FOR NOT LAST USE 
*         OR 0 FOR LAST USE.
  
 EIS.AX   SB6    X3 
          SX6    MAX.USEC-1 
          EQ     EIS.X
  
 EIS.CX   SB6    X3 
          =X6    0
          EQ     EIS.X
  
 EIS.X    SB7    X3-R.X6+REG.X     (B7) = 0TR(X.6)-0TR(TARGET)
          SX3    X3+REG.X 
          LX3    P2.BIASP    POSITION HARD REGISTER NUMBER
          IX6    X6+X3       FORM DUMMY REGFILE ENTRY 
          SA6    EISXA       SAVE DUMMY REGFILE ENTRY 
          SB2    B6          (B2) = 00R OF TARGET 
          MI     B7,EIS.X5   IF NOT REQUESTING STORE REGISTER 
          DRITE  DEACTIVATE 
          SB7    -B6
          SB7    B7-REG.X+R.X7     (B7) = 0TR(X7)-0TR(TARGET) 
          SB2    B6          (B2) = 00R OF THE TARGET 
  
**        TEST FOR TEMPORARY REG CLASH
  
 EIS.X5   SA1    B6+REG.X+REGFILE  EXAMINE ENTRY IN TARGET REGISTER 
          MX3    -RG.USEL    SET USE COUNT MASK 
          BX0    -X3*X1      EXTRACT USE COUNT
          SX0    X0-MAX.USEC SUBTRACT THE SPECIAL TEMP REG USE COUNT
          PL     X0,EIS.X7         IF A TEMP FIND A NEW REGISTER
          MI     B7,EIS.X10        IF NOT A STORE REG CLEAR IT
          SA1    B7+R.X6+REGFILE   GET REGFILE ENTRY FOR OTHER STORE REG
          BX0    -X3*X1      EXTRACT USE COUNT
          SX0    X0-MAX.USEC SUBTRACT USE COUNT GIVEN TO TEMP REGS
          MI     X0,EIS.X10  NO DEADLOCK EXISTS CLEAR TARGET REG
          SB2    B7-REG.X+R.X6     (B2) = 00R OF THE OTHER STORE REG
  
**        TROUBLE - EITHER OUR HARD REG IS CURRENTLY HOLDING A TEMPORARY
*         OR IT WILL CREATE A STORE REG DEADLOCK. WE MUST:  
*                (1) FIND A NEW TEMP REG. 
*                (2) TRANSMIT OUR TEMP TO THAT REG. AND 
*                (3) RESET THE REG=T AND USAGE TABLES.
* 
*         (B2) = 00R OF REG TO CLEAR
*         (B6) = ORIGINAL TARGET REG
  
 EIS.X7   SX5    B2          SAVE REG TO CLEAR ACROSS GTR CALL
          CALL   GTR         GET TEMPORARY REGISTER 
          IX7    X6+X5       (X7) = 0IJ 
          SX7    X7+XMT/1S3  ADD OPCODE IN FOR XMT INSTRUCTION
          SA1    X5+REG.X+REGFILE  GET REGFILE ENTRY FOR REG TO CLEAR 
          SX6    B2          0TR OF THE NEW TEMP REG
          BX3    X1 
          AX3    -P2.BIASL   ISOLATE TEMP ORDINAL INTO REG=T
          SA6    X3+REG=T    RESET TEMP TABLE ENTRY 
          LX7    PB.GHIJP    POSITION INSTRUCTION FOR WCODE 
          BX6    X1 
          SA6    B2+REGFILE  RESET USAGE TABLE (REGFILE)
          WCODE  X7          WRITE TRANSMIT INSTRUCTION 
          SB2    X5 
          CALL   RUT         CLEAR TEMPORARY REGISTER 
  
**       CLEANUP - CLEAR TARGET REG, RESET REGFILE AND SET EXIT VALUES
  
 EIS.X10  SB2    B6+REG.X 
          CALL   RUT         CLEAR REGFILE ENTRY
 EIS.X15  SA1    EISXA       GET DUMMY REGFILE ENTRY
          BX7    X1 
          SA7    B2+REGFILE  RESET USE TABLE TO DUMMY X-TAG 
          EQ     EIS.REG
  
 EISXA    BSS    1
 EIS.AT   EJECT  4,8
**            C.  ASSIGN TEMPORARY *X* REGISTER.
*                 ASSIGN X0, X7, X6 IN THAT ORDER, IF ALL ARE IN USE
*                 KILLS ANY DELAYED STORES.  IF ONE FREED USES REGISTER 
*                 FROM DELAYED STORE, IF NOT USES ONE OF LOAD REGISTERS 
*                 DEPENDING ON HOW MANY LOAD REGISTERS ARE LOCKED.
  
  
 EIS.AT   SA1    X3+REG=T 
          SB6    X3          ORDINAL OF TEMPORARY 
          SB2    X1          REGISTER - 0TR 
          NZ     X1,EIS.AT30 IF ALREADY LOADED - USE IT 
  
**        CHECK FOR UNNECESSARY TRANSMIT INSTRUCTION.  IF FOUND,
*         MAKE *I* REGISTER SAME AS *J* REGISTER SO THAT *PIG* WILL 
*         ELIMINATE INSTRUCTION.
  
          SA2    OPCODE 
          SB7    X2-XMT/1S6 
          NZ     B7,EIS.AT10 IF NOT *XMT* 
          SA2    INS.REG
          MX0    -3 
          AX2    3
          BX0    -X0*X2      *J* REGISTER 
          SA2    X0+REGFILE+REG.X      FETCH STATUS OF *J* REGISTER 
          MX1    -RG.USEL 
          BX1    -X1*X2      USE COUNT
          NZ     X1,EIS.AT10 IF USE COUNT NOT ZERO
  
*         TRANSMIT INSTRUCTION IS UNNECESSARY 
  
          SB2    X0+REG.X    *I* REGISTER - 0TR 
          EQ     EIS.AT30 
  
 EIS.AT10 CALL   GTR         GET A TEMPORARY REGISTER 
  
**        FOUND REGISTER FREE FOR TEMPORARY ASSIGNMENT. 
*         (B2) = 0TR. 
*         (B6) = ORDINAL OF TEMPORARY.
  
 EIS.AT30 SX3    B6 
          SX7    B2 
          LX3    P2.BIASP    POSITION REG=T ORDINAL 
          =X2    MAX.USEC 
          MX0    -3 
          BX6    X2+X3       DUMMY TAG FOR REGFILE
          SA7    B6+REG=T    SET *REG=T* FILE 
          SA6    B2+REGFILE 
          BX6    -X0*X7 
          LX6    3
          EQ     EIS.LRF
 CLTEMP   EJECT  4,20 
**        CLEAR REGISTER ASSIGNMENT FOR CURRENT SKELETON. 
*             A.  PROCESS TEMPORARY - WITH CLEARING OF T-REGISTER.
  
 EIS.CT   SA2    X3+REG=T    LOAD TEMPORARY REGISTER CELL 
          =X7    0
          MX1    -3 
          SA7    A2          CLEAR TEMPORARY REGISTER CELL
  
**        CLEAR *USEFILE* USAGE COUNT ON REGISTER POINTED TO BY *0TR* 
*         IN *X2*.
*         (X1) = REGISTER MASK. 
*         (X2) = 0TR FOR REGISTER TO BE CLEARED.
  
 EIS.CT5  BX6    -X1*X2      REGISTER ONLY = 00R
          SB2    X2 
          BX7    0
          LX6    3           =0R0 
          SA7    X2+REGFILE 
          EQ     EIS.LRF
 EIS.CB   SPACE  4,10 
**        EIS.CB - LAST USE OF *B* REGISTER.
  
  
 EIS.CB   SX2    X3 
          MX1    -3 
          EQ     EIS.CT5     CONTINUE 
 EIS.G    SPACE  4,20 
**        EIS.G - LOAD INVENTED OPERAND.
  
**        EIS.GP READS UP AN INVENTED OPERAND OF THE P TYPE 
*                THIS IS IDENTICAL TO EIS.P IN ALL ASPECTS EXCEPT 
*                THE TABLE FROM WHICH THE OPERAND IS FETCHED. 
* 
*         ENTRY  (X3) = THE ORDINAL INTO REG=GP TABLE (SR.NUM FIELD)
  
 EIS.GP   BSSENT 0
          SA2    X3+REG=G    GET PSEUDO OPERAND 
          EQ     EIS.P4 
 EIS.GL   SPACE  4,10 
**        EIS.GL -
*                PROCESSES GENERATED L TYPE OPERANDS. 
*                OPERANDS RECENTLY STORED IN THE REG=G TABLE ARE
*                READ UP AND PASSED TO EIS.L AS IF THEY WERE NORMAL 
*                OPERANDS TAKEN FROM THE I. L.
*         EIS.GLN - 
*                SAME AS EIS.GL ONLY THE USE COUNT IS NOT DECRIMENTED 
*         EIS.GLL - 
*                SAME AS EIS.GL ONLY TYPE IS SET TO 1 FOR LOWER HALF
*         EIS.GLNL -
*                SAME AS EIS.GL ONLY TYPE IS 1 AND USE COUNT IS OFF.
* 
*         ENTRY  (X3) = ORDINAL INTO REG=G (SR.NUM FIELD) 
* 
*         EXIT   (X5) = OPERAND TO PROCESS
*                (X6) = TYPE UPPER/LOWER
  
  
 EIS.GLN  SX7    0           (X7) = USE COUNT DECRIMENT 
          SA7    UUC         DO NOT  DECREMENT USE COUNT
 EIS.GL   SX6    0           (X6) = TYPE UPPER
          EQ     EIS.GL2     PROCESS GENERATED OPERAND
  
 EIS.GLNL SX7    0           (X7) USE COUNT DECRIMENT 
          SA7    UUC         DO NOT DECRIMENT USE COUNT 
 EIS.GLL  SX6    1           (X6) = TYPE LOWER
          EQ     EIS.GL2     PROCESS GENERATED OPERAND
  
  
 EIS.GL2  SA5    X3+REG=G    GET PSEUDO OPERAND 
          MX0    60-RG.USEL 
          LX0    RG.USEP
          BX5    X0*X5       REMOVE USE COUNT 
          =X7    1           NEW USE COUNT
          IX5    X5+X7       ADD USE COUNT INTO OPERAND 
          EQ     EIS.L2      PROCESS LOAD 
 EIS.LL   SPACE  4,10 
**        EIS.LL - PROCESS LOAD OF LOWER PART OF DOUBLE WORD VARIABLE.
* 
*         ENTRY  (X3) = RELATIVE ORDINAL OF TAG TO BE LOADED. 
*                (B7) = REGISTER NUMBER. IF 0 - ANY REGISTER. 
  
 EIS.LNL  =X6    0
          SA6    UUC
  
 EIS.LL   SA5    X3+B4       TAG TO BE LOADED 
          =X6    1           INDICATE LOWER HALF
          EQ     EIS.L2 
 EIS.L    EJECT  4,8
**           C. PROCESS LOAD INTO *A*,*X* REGISTER. 
*                ENTRY - (X3) = RELATIVE ORDINAL OF TAG TO BE LOADED. 
*                        (B7) = REGISTER NUMBER. IF 0 - ANY REGISTER. 
  
 EIS.LNU  SPACE  4,8
**        EIS.LNU - SAME AS EIS.L BUT DOES NOT RESET USE COUNT OF 
*         TAG BEING LOADED. 
  
  
 EIS.LNU  =X6    0
          SA6    UUC
 EIS.L    SA5    X3+B4       TAG TO BE LOADED 
          =X6    0           UPPER HALF 
  
 EIS.L2   SA6    TYPLOD      LOAD TYPE CELL 1 FOR LOWER, 0 FOR UPPER
          SB6    X6 
  
 .TEST    IFEQ   TEST,ON
          MX0    -RG.USEL 
          BX1    -X0*X5      EXTRACT USE COUNT
          ZR     X1,"BLOWUP" IF OPREAND WAS NOT DUC-ED
          SX1    X1-RLOCK 
          PL     X1,"BLOWUP" IMPOSSIBLE USE COUNT 
 .TEST    ENDIF 
  
          SA1    IJK         SR. FIELD INDICATOR: -3 IF K,0 IF J,3 IF I 
          =X0    X1-1 
          SA1    OPTYP       GET SK.TYP FIELD OF CURRETN SKELETON WORD
          =X1    X1-M.LOAD
          LX6    RG.TYPP
          BX5    X5+X6
          SA2    RREG 
          MI     X0,EIS.L3   IF PROCESSING J OR K FIELDS
          PL     X2,EIS.L3   IF HARD REGISTER LOAD
          ZR     X1,EIS.STO  IF OPTYP IS LOAD/STORE COMPILE A STORE 
 EIS.L3   DRITE  DEACTIVATE 
          BX1    X5 
          SB2    B6 
          BX0    X5 
          SBIT   X1,P2.INTRP
          PL     X1,EIS.L5   IF NOT INTERMEDIATE
          SBIT   X0,P2.ARRP 
          PL     X0,EIS.L5   IF NOT ARY-LOD 
          SB2    B6 
          CALL   SLD         LOAD SUBSCRIPTED ARRAY 
          EQ     EIS.L21
  
 EIS.L5   SB3    RG=LOAD
          CALL   DSC         DETERMINE REGISTER STATUS CLASS
          SA2    GSTC 
          LX3    X7 
          BX7    X2 
          SA7    EIS.LST     SAVE LOCATION OF STATUS WORD 
          BX7    X3 
          SA2    P2=KEEP
          BX1    X2*X1
          SA3    TYPLOD 
          BX2    X5 
          SBIT   X2,P2.SHRTP
          MI     X2,EIS.L10  IF SHORT CONSTANT
          IX1    X1+X3
          ZR     B2,EIS.L7   IF TAG NOT IN REGISTER 
          MX0    P2.TAGL
          BX0    X0*X1
          LX0    P2.TAGL
          SX2    X0-"P2=PFX"
          PL     X2,EIS.L6   IF NOT SYMTAB SYMBOL 
          SA2    T.SYM
          =B6    X2+WB.W
          IX2    X0+X0
          IX0    X2+X0
          SA2    X0+B6       WB(TAG)
          BX0    X2 
          CLAS=  X2,WB,(EQV,BMEM) 
          BX2    X0*X2
          NZ     X2,EIS.L7   IF SYMBOL EQUIVALENCED 
  
 EIS.L6   BSS    0
          NZ     B2,EIS.L12   IF TAG IN REGISTER
 EIS.L7   SB2    X3          INDICATE UPPER OR LOWER
          CALL   LTG         LOAD TAG 
          EQ     EIS.L15
  
 EIS.L10  SB3    RG=LODX
          NZ     B2,EIS.L12  IF TAG IN REGISTER 
          CALL   LSC         LOAD SHORT CONSTANT
          EQ     EIS.L15
  
 EIS.L12  ZR     B7,EIS.L15  IF TAG IN CORRECT REGISTER 
          SA7    EIS.INST    SAVE INSTRUNCION 
          AX6    3
          =A6    A7+EIS.JREG-EIS.INST  SAVE *J* REGISTER
          CALL   GNR         GET REGISTER 
          SA2    EIS.JREG 
          BX3    X6 
          =A1    A2-EIS.JREG+EIS.INST 
          IX0    X6+X2       =0IJ 
          SB5    B2 
          IX7    X1+X0       OP-CODE + IJ 
          LX7    PB.INSTP+3 
          WCODE  X7 
          SA1    STRGLK 
          MI     X1,EIS.L13  IF NO ASSIGNMENT TO CLEAR
          SA1    X1+REGFILE 
          SX0    RLOCK
          BX6    -X0*X1      UNLOCK STORE REGISTER
          SA6    A1 
 EIS.L13  BX6    X3 
          SB2    B5 
  
*         INDICATE TAG IN REGISTER IN REGISTER. 
*         UPDATE USE COUNT ON TAG AND PUT IN REGFILE. 
*         (B2) = REGISTER (0TR) 
*         (X5) = TAG (FROM PARSED FILE) 
*         (X6) = REGISTER (0R0) 
*                (EIS.LST) = LOCATION OF TAG STATUS WORD
  
 EIS.L15  SA1    IJK
          SX0    X1-1 
          PL     X0,EIS.L20  IF NOT PROCESSING  J OR K  FIELD 
          SX3    RLOCK
          SX1    -B2
          SB7    X1+R.X6
          LT     B0,B7,EIS.L20  IF TAG NOT IN STORE REGISTER
          SA2    B7+REGFILE+R.X7
          BX1    X3*X2
          ZR     X1,EIS.L20  IF OTHER STORE REGISTER NOT LOCKED 
          SX7    B2 
          SA7    EIS.LK      SAVE OTR OF REGISTER TAG IS IN 
          SA3    UUC
          SX7    B0 
          SA7    A3          SET USE COUNT TO ZERO TEMPORARILY
          BX7    X3 
          SA7    EIS.LUC     CURRENT USE COUNT
          SA3    TYPLOD 
          SA1    EIS.LST     GET LOCATION OF STATUS WORD
          SB7    X1          ORDINAL IN TABLE OF STATUS WORD
          AX1    18 
          SA2    X1          FETCH ORIGIN OF TABLE
          SA1    X2+B7
          SB3    X3 
          RJ     STS         SET STATUS OF TAG
          SB3    RG=TEMP
          CALL   SFR
          NZ     X7,EIS.L16  IF TEMPORARY REGISTER NOT AVAILABLE
          SX6    B2          OTR ASSIGNED BY *SFR*
          SA6    EIS.LX 
          SA2    EIS.LK      OTR OF REG HOLDING TAG 
          SB2    X2 
          EQ     EIS.L19     SET STATUS USING REAL USE COUNT
  
 EIS.L16  SB3    RG=LODX
          CALL   GNR
          SX7    B2          OTR OF REG ASSIGNED BY *GNR* 
          SA7    EIS.LX 
          SA3    TYPLOD 
          SB2    X3 
          CALL   GST
          NZ     B2,EIS.L17  IF TAG IN REGISTER - XMIT
          SA1    EIS.LST     GET LOCATION OF STATUS WORD
          SB7    X1          ORDINAL IN TABLE OF STATUS WORD
          AX1    18 
          SA2    X1          FETCH ORIGIN OF TABLE
          SA1    X2+B7
          SA3    TYPLOD      UPPER/LOWER
          LX3    P2.BIASP    POSITION TYPE
          IX1    X1+X3       ADD(TYPLOD) INTO BIAS
          SA3    EIS.LX      ASSIGNED REGISTER
          SB2    X3 
          MX0    -3 
          BX6    -X0*X3 
          LX6    3
          CALL   CLI
          EQ     EIS.L19
  
 EIS.L17  SA2    EIS.LX      OTR OF REGISTER TO TRANSMIT TO 
          SB2    X2 
          MX0    -3 
          BX2    -X0*X2      (00R) *I* REGISTER 
          SA3    EIS.LK 
          SX6    B0 
          SB5    X3          OTR OF REGISTER TRANSMITTING FROM
          BX7    -X0*X3      (00R) *J* REGISTER 
          SA1    B5+REGFILE  *X* REGFILE ENTRY
          SA3    B5+REGFILE-REG.A  *A* REGFILE ENTRY
          BX1    X3-X1
          AX1    OP.USEL
          NZ     X1,EIS.L18  IF TAGS NOT EQUAL CLEAR X REGFILE NTRY ONLY
          SA6    A3          CLEAR OLD *A* REGFILE ENTRY
  
 EIS.L18  SA6    A1          CLEAR OLD *X* REGFILE ENTRY
          LX2    3
          IX7    X7+X2
          SX7    X7+XMT/1S3 
          LX7    PB.GHIJP 
          SB5    B2 
          WCODE  X7          TRANSMIT 
          SB2    B5 
  
 EIS.L19  SA1    EIS.LUC     SAVED USE COUNT
          BX7    X1 
          SA7    UUC         RESTORE USE COUNT
  
 EIS.L20  SA3    TYPLOD 
          SA1    EIS.LST     GET LOCATION OF STATUS WORD
          SB7    X1 
          AX1    18 
          SA2    X1          FETCH ORIGIN OF TABLE
          SA1    X2+B7
          SB3    X3 
          CALL   STS         SET STATUS OF TAG
          MX0    -3 
          SX1    B2 
          BX6    -X0*X1 
          LX6    3           0R0
  
 EIS.L21  SA1    HREG 
          ZR     X1,EIS.LRF  IF HARD REGISTER TO REMAIN UN-LOCKED 
          BX2    X6 
          MX7    0
          LX2    -3 
          SA7    A1          CLEAR HREG 
          SB7    X2 
          CALL   RLL         LOCK REGISTER
          EQ     EIS.LRF
 EIS.LUC  DATA   0           USE COUNT SAVED HERE 
 EIS.LK   DATA   0           OTR OF REG TAG IS IN 
 EIS.LX   DATA   0           REG ASSIGNED AFTER GNR CALL
  
 EIS.LST  CON    "BLOWUP"    LOCATION OF TAG STATUS WORD
 EIS.STO  SPACE  4,20 
**        EIS.STO - STORE PROCESSOR.
* 
*         ENTRY  (X5) = STORE TARGET (THE LEFT MEMBER)
*                       SHOULD = OR.1OP OR OR.2OP 
  
 EIS.STO  SA2    INS.REG     GET (0R0) FOR RIGHT HAND SIDE
          BX7    0
          LX6    X2 
          SA7    UUC         DO NOT DECRIMENT USE COUNT 
          AX2    3           (X2) = (00R) 
          SB2    X2+REG.X    ADD IN TYPE FOR (0TR)
          SX0    B2-R.X6
          PL     X0,EIS.ST1  IF IN *STORE* REGISTER 
          SB7    X2 
          RJ     RLL         LOCK RHS IN CASE ASR CALLS DRITE(FP OR LCM)
          RJ     ASR         ASSIGN STORE REGISTER
          SX7    -XMT 
          SA7    RREG        SET *RIGHT MEMBER NOT IN STORE REG* FLAG 
          SA1    INS.REG
          AX1    3
          SB7    X1 
          RJ     RUL         UNLOCK RHS REG 
  
*         CHECK LEFT MEMBER FOR VARIABLE TYPE 
*                (B2) = 0TR RIGHT MEMBER
*                (X5) = LEFT MEMBER 
  
 EIS.ST1  BX2    X5 
          SBIT   X2,P2.INTRP
          PL     X2,EIS.ST3  IF NOT INTERMEDIATE, SKIP ARRAY LOAD 
  
*         LEFT MEMBER IS A *SUBSCRIPTED ARRAY INVOLVING ADDRESS FUNCTION
  
          SA1    RREG        GET HARD REG CELL
          SX7    B2 
          SB7    X1+XMT 
          SA7    A1          SET HARD REG = 0TR OF RIGHE HAND SIDE
          NZ     B7,EIS.ST2   IF RIGHT HAND SIDE IN STORE REG 
  
*         COMPILE A TRANSMIT OF THE RIGHT MEMBER INTO A STORE REG.
  
          SA3    INS.REG     GET CURRENT 0R0, THE J-REG 
          MX0    -3 
          BX2    -X1         SET XMT OPCODE IN (X2) 
          IX7    X3+X2       ADD  XMT + 0J0 
          LX6    3           (X6) = R00 OF THE I-REG
          IX7    X7+X6       ADD I-REG TO INSTRUCTION WORD
          LX7    PB.INSTP 
          WCODE  X7          WRITE TRANSMIT INSTRUCTION 
 EIS.ST2  SB2    B6          SET TYPE ( 1 IF UPPER, 0 IF LOWER) 
          =X7    1
          SA7    UUC         SET USE COUNT DECREMENT CELL.
          CALL   SLD         LOAD SUBSCRIPTED ARRAY 
          EQ     EIS.REG
  
*         SET DELAYED STORE IN MOTION 
  
 EIS.ST3  SB3    B2          SET 0TR OF RIGHT HAND SIDE 
          SB2    B6          SET TYPE ( 1 FOR UPPER, 0 FOR LOWER) 
          CALL   SDS         SET DELAYED STORE
          EQ     EIS.REG
 EIS.IR   SPACE  4,10 
**        EIS.IR - SET INTERMEDIATE RESULT REGISTER.
* 
*             ENTRY  (B4) _ TURPLE. 
*             EXIT   (X6) REGISTER NUMBER - 0R0.
*             USES   A1,A2,A3  X0  B2,B7
*             CALLS  CDS
  
  
 EIS.IRL  SB6    1           SET TYPE = FOR 1 LOWER HALF
          EQ     EIS.IR1
  
 EIS.IR   SB6    0           SET TYPE = 0 FOR UPPER HALF
          EQ     EIS.IR1
  
*         CHECK IF NEXT TURPLE IS A STORE TURPLE
  
 EIS.IR1  SA2    B4+Z=TURP   GET NEXT OPERATOR
          BX6    0
          SA6    UUC         DO NOT DECRIMENT USE COUNT 
          MX0    -OP.CHINL
          AX2    OP.CHINP 
          BX2    -X0*X2      EXTRACT OPERATOR CHARACTOR INDEX 
          SX2    X2-O.=      SUBTRACT INDEX FOR A STORE 
          NZ     X2,EIS.IR10 IF NEXT TURP NOT A STORE, GET ANY FREE REG 
          CALL   ASR         FIND AVAILABLE STORE REGISTER
          EQ     EIS.IR30    CONTINUE 
  
*         IF INTERMEDIATE NOT INPUT INTO *STORE* TURPLE 
  
 EIS.IR10 CALL   AIR         ASSIGN INTERMEDIATE REGISTER 
          PL     B2,EIS.IR20 IF REGISTER AVAILABLE
          CALL   ASR         USE STORE REGISTER 
          EQ     EIS.IR30 
  
 EIS.IR20 ZR     X7,EIS.IR30 IF REGISTER FREE 
          CALL   RUT         CLEAR TEMPORARY REGISTER 
  
**        (B2) = 0TR. FOR RESULTS.
  
 EIS.IR30 =X5    0
          SB3    B6          INTERMEDIATE TYPE (UPPER/LOWER)
          CALL   DIT         DEFINE INTERMEDIATE
          EQ     EIS.REG
 EIS.K    SPACE  4,10 
**        SET CONSTANT FOR CURRENT INSTRUCTION. 
  
 EIS.AA   BSS    0
 EIS.CA   BSS    0
 EIS.K    SX6    X3          6 BIT TYPE CONSTANT. 
          =B2    -1          INDICATE NOT A REGISTER (FOR EIS.LRF)
          LX6    3
          EQ     EIS.LRF
 EIS.Q    SPACE  4,10 
**        EIS.Q - IMMEDIATE 18 BIT OPERAND. 
* 
*         NOTE THAT INCREMENT UNIT IS NOT USED TO EXTRACT THE FIELD FROM
*         THE SKELETON WORD, BECAUSE SIGN EXTENSION IS NOT WANTED.
  
  
 EIS.Q    SA2    A4          RELOAD SKELETON WORD 
          MX0    -SK.JPADL
          LX2    -SK.JPADP
          MX6    0           TAG = 0
          BX7    -X0*X2      BIAS = JPAD
          EQ     EIS.P5      PROCESS AS INTERMEDIATE
 EIS.S    SPACE  4,10 
**        EIS.S - SYMORD OF OPERAND IS IN AN (S=ORD) CELL.
  
  
 EIS.S    SA2    A4          GET SKELETON WORD
          LX2    -SK.JPADP
          SA2    X2          GET SYMBOL TABLE TAG 
          ERRNZ  18-SK.JPADL
          BX6    X2          TAG = (JPAD) 
          MX7    0
          EQ     EIS.P5 
 EIS.P    SPACE  4,10 
**        PROCESS TAG AND BIAS FIELD SIMULTANEOULSY.
*         WILL PROCESS P2.TAGL AND/OR P2.BIASL ELEMENTS OF TURPLE 
*         OPERAND FOR ADD IN TO INSTRUCTION BUILD WORD. 
* 
*         ENTRY  (X3)  RELATIVE WORD IN PARSE FILE TO USE 
*                (B4)  START OF TURPLE
* 
*         EXIT   TO EIS.PX5 TO COMPLETE INSTRUCTION BUILD.
  
  
 EIS.P    BSS    0
          SA2    X3+B4       LOAD PARSED FILE WORD = 18/TAG,18/BIAS,24/0
  
 EIS.P4   MX0    -PB.BIASL
          LX2    -P2.BIASP
          BX7    -X0*X2      TRUNC(P2.BIAS) 
          MX0    -P2.TAGL 
          LX2    P2.BIASP-P2.TAGP 
          BX6    -X0*X2      P2.TAG 
  
*         (X6) = TAG
*         (X7) = 18-BIT BIAS
  
 EIS.P5   SA5    OPTYP
          SB7    X5-M.SHIF
  
*         REPOSITION TAG PREFIX FROM P2 TO PB POSITION. 
  
          MX0    P2.PFXL
          LX0    P2.PFXL+P2=PFX 
          BX0    X0*X6       EXTRACT TAG PREFIX 
          BX6    -X0*X6      CLEAR PREFIX FROM TAG
          LX0    P=PFX-P2=PFX      REPOSITION 
          BX6    X0+X6
          LX7    -PB.BIASL
          BX6    X6+X7       18/BIAS,24/0,18/TAG
          ZR     B7,EIS.REG  IF IMEDIATE VALUE IS A SHIFT COUNT 
  
**        WE ARE COMPILING A 30-BIT INSTRUCTION. WE MUST
*         BE CAREFUL TO PLACE OUR IMEDIATE VALUE IN THE COR-
*         RECT POSITION SO THAT EIS.REG WILL SHIFT IT TO THE
*         SAME POSITION REGARDLESS OF WHERE IJK IS PIONTING.
  
          SA3    IJK                  GET VARIABLE SHIFT COUNT
          SB6    X3-60+PB.TAGL-PB.KL  NEGATIVE OF DISIRED SHIFT COUNT 
          ERRPL  6-PB.TAGL+PB.KL   POSSIBLE DANGER OF DROPPED BITS
          SB6    -B6         SET SHIFT COUNT
          LX6    B6,X6       POSITION IMEDIATE FIELDS 
          EQ     EIS.REG
 EIS.LRF  SPACE  4,20 
**        LOCK REGISTER FILE FOR REGISTER USED IN CURRENT INSTRUCTION 
* 
*         ENTRY  (B2) = 0TR 
*                (X6) = 0R0, AS ABOVE.
* 
*         EXIT   LOCK BIT SET IN (REGFILE) IF ASSIGNMENT IS FOR 
*                            *K* PORTION OF INSTRUCTION.
*                CLEAR LOCK BIT ON *K* IF PROCESSING *J*
  
  
 EIS.LRF  SA2    IJK
          SA1    REGLK
          MX7    -1 
          PL     X2,EIS.LRF5 IF NOT PROCESSING *K*
          MI     B2,EIS.REG  IF A CONSTANT (NOT A REGISTER) 
          SX5    B2 
          MX1    -3 
          BX2    -X1*X5      GET REGISTER -00R
          SB7    X2 
          CALL   RLL         LOCK REGISTER
          SA7    REGLK       SAVE REGISTER  -00R. 
          =A7    A7+1 
          EQ     EIS.REG     CONTINUE 
  
 EIS.LRF5 SA7    A1          CLEAR *REGLK*
          NZ     X2,EIS.REG  IF NOT PROCESSING *J*
          SA7    CLOADJ 
          SB7    X1 
          CALL   RUL         UNLOCK REGISTER
*         EQ     EIS.REG
 REG      EJECT  4,8
**        9.  SET REGISTER IN TO BUILD REGISTER,(X5), AND CONTINUE
*             TO NEXT.
*             ENTRY  (X6) = REGISTER - 0R0
* 
*             EXIT   (X1) REGISTER SHIFTED APPROPRIATELY. 
*                    (X4) SHIFTED BY -L.INUM
*                    (B6) UPDATED BY 3. 
*                    INS.REG =  REGISTER ADDED IN PROPER POSITION.
  
  
 EIS.REG  SA3    IJK
          SA1    INS.REG
          SB6    X3 
          PL     X3,EIS.RG5  IF POSITIVE SHIFT
          SB6    B6+60       NO DROPPING THE BITS.. 
 EIS.RG5  LX2    B6,X6
          BX6    X1+X2
          LX4    -SR.OADL 
          SX7    X3+3 
          SA6    A1          UPDATE ASSIGNED
          SA7    A3          UPDATE *IJK* 
          EQ     EIS.NX      CONTINUE FOR NEXT PORTION OF INSTRUCTION.
  
 INS.REG  BSZENT 1           IJK PARTS OF INSTRUCTION 
 OPCODE   DATA   0           OPCODE 
 IJK      BSZENT 1           = 3 PROCESSING *I* PART
                             = 0    -       *J*  -
                             =-3    -       *K*  -
 OPTYP    DATA   0           M.XXX FOR OP-CODE FIELD OF SKELETON
  
  
 EIS.INST DATA   0           INSTRUNCION TO PUT TAG IN CORRECT REGISTER 
 EIS.JREG DATA   0           *J* REGISTER FOR ABOVE 
 HREG     BSSZ   1           LOCK HARD REGISTER FLAG
 RUT.REG  BSZENT 1           IJK PARTS OF PREVIOUS INSTRUCTION
          TITLE  (O=)  PROCESSORS CALLED BY SKELETONS.
 O=XXX    SPACE  4,10 
**        O=XXX - THIS SECTION CONTAINS SPECIAL PROCESSING ROUTINES 
*                 USED FOR EXPANSION OF SKELETONS.
 BOS      SPACE  4,10 
**        BOS - BEGINNING OF STATEMENT. 
* 
*         ENTRY  (A5) _ CURRENT TURPLE HEADER.
*                (X0) = COMPLEMENT MASK OF [OP.LINE]. 
*                (X1) = [OP.LINE] OF CURRENT TURPLE.
*                (X5) = CURRENT TURPLE HEADER.
* 
*         EXIT   LINE NUMBER REMOVED FROM CURRENT TURPLE HEADER.
*                (X5) = ADJUSTED TURPLE HEADER. 
*                (TRACE) = CURRENT LINE NUMBER. 
* 
*         ISSUES (I.BOS) PSUEDO.
*                (I.OTR) IF *ER* SELECTED.
*                (RJ FID) IF *DB=ID* SELECTED.
* 
*         USES   ALL BUT  A0,  B4.
*         CALLS  WCODE. 
  
  
 BOS      SUBR   0           ENTRY/EXIT...
          BX6    X0*X5       REMOVE LINE NUMBER FROM (OP.)
          LX1    -OP.LINEP
          SA2    CO.DBER
          SA3    CO.DBID
          BX2    X2+X3
          BX5    X0*X5       ADJUST (X5) ALSO 
          LX7    X1 
          SA6    A5 
          SA7    TRACE
          ZR     X2,BOS4     IF ERROR RECOVERY DE-SELECTED
          NZ     X3,BOS3     IF CO.DBID ON
          DRITE  DEACTIVATE 
          EQ     BOS4 
  
 BOS3     CALL   CIA         CLEAR ALL REGISTERS
 BOS4     SA1    TRACE
          SX3    I.BOS
          LX1    PB.BIASP 
          LX3    PB.GHIJP 
          BX4    X1+X3
          WCODE  X4          ISSUE  * BOS  LINE-NUMBER *
          SA2    B4+Z=TURP   NEXT TURPLE
          BX3    -X2
          HX3    TH.SKEL
          AX3    -TH.SKELL   EXTRACT (SIGN EXTEND) NEGATIVE SKEL ORDINAL
          SX3    X3+V=BSS 
          NZ     X3,BOS5     IF BSS NOT NEXT
          CLAS=  X0,OP,BSSI 
          BX6    X0+X2
          SA6    A2          MARK BSS ISSUED
          =A1    A2+OR.1OP
          RJ     PBW         PREPARE BSS FOR WCODE
          SA7    ESTACK      SAVE BSS 
          CALL   CIA         CLEAR ALL REGISTERS
          SA2    ESTACK 
          BX7    X2 
          WCODE  X7          ISSUE BSS
  
 BOS5     SA2    CO.DBER
          SA3    CO.DBID
          SX6    I.BOS&I.OTR
          BX2    X2+X3
          ZR     X2,EXIT.    IF OBJECT-TIME-REPRIEVE DE-SELECTED
          SA2    MOD
          HX2    MO.BLK 
          MI     X2,EXIT.    IF PROCESSING BLOCK DATA 
          LX6    PB.GHIJP 
          BX7    X4-X6       SWITCH OPCODE
          ZR     X3,BOS8     IF INTERACTIVE DEBUG NOT SELECTED
          WCODE  X7 
          CALL   CIA         CLEAR ALL REGISTERS
          SX3    I.RJ3
          SA4    S=FID
          LX3    PB.GHIJP 
          LX4    PB.TAGP
          BX7    X3+X4
  
 BOS8     WCODE  X7,EXIT. 
 O=CAR    SPACE  4,8
**        CAR -  CLEAR ALL REGISTER ASSOCIATES. 
* 
*         ENTRY  (B4) _ CURRENT *TURPLE* BEING PROCESSED. 
* 
*         EXIT   *DRITE* CLEARED. 
*                ALL REGISTER ASSOCIATES CLEARED. 
*                EXIT TO NULLOP 
* 
*         CALLS  CAR. 
  
 O=CAR    BSSENT             ENTRY... 
          CALL   CIA         CLEAR REGISTER FILE
          EQ     NULLOP 
 O=CBJ    SPACE  4,10 
**        O=CBJ -  COMPILE INDEXED (B) JUMP.
* 
*         ENTRY  (X1) = LABEL 
*                (A4,X4) = SKELETON WORD
* 
*         EXIT   TO EIS.CMP 
*                (X7) = INSTRUCTION TO COMPILE
*                (X3) = SKELETON SHIFTED BY P.IEND
*                AN  * JP   B6 + L.N  *  HAS BEEN CONSTRUCTED 
  
  
 O=CBJ    BSSENT 0           ENTRY... 
          LX1    -P2.TAGP+PB.TAGP 
          SX5    R.B6        ** B6 ONLY **
          =X2    I.JPI
          BX1    X1+X5
          LX2    PB.GHIJP 
          BX7    X1+X2       12/GHIJ,18/TAG(IF EXISTS),18/0,12/B-REG
          EQ     CBREAK      RETURN TO COMPILE INSTRUCTION
 O=CDW    SPACE  4,8
**        CDW -  CHECK *DRITE* FLAG AND PROCESS IF SET. 
* 
*         ENTRY  (B4) _ CURRENT *TURPLE* BEING PROCESSED. 
* 
*         EXIT   *DRITE* CLEARED. 
*                EXIT TO NULLOP 
* 
*         CALLS  CDS
  
  
 O=CDW    BSSENT             ENTRY... 
          DRITE  DEACTIVATE 
          EQ     NULLOP 
 O=CBSS   SPACE  4,10 
**        CBSS - DEFINE LABEL.
* 
*         ENTRY  (X1) = LABEL TO DEFINE.
*                (X4) = SKELETON WORD 
* 
*         EXIT   TO *CBREAK*
*                (X3) = SKELETON SHIFTED BY SK.ENDP 
*                (X7) = INSTRUCTION FORMATTED FOR LONG FILE 
* 
*         NOTE THAT QCG CANNOT TAKE ADVANTAGE OF THE INACTIVE LABEL 
*         BIT (WB.INA), BECAUSE IT IS NOT GUARENTEED CORRECT UNTIL
*         THE ENTIRE PROGRAM-UNIT HAS BEEN SCANNED. 
* 
*         USES   CANNOT DESTROY  A0,A4  B4
  
  
 PBW      SUBR               PREPARE BSS FOR WCODE
          LX1    -P2.TAGP 
          MX0    -P2.ORDL 
          BX2    -X0*X1 
          MX0    P2.PFXL
          LX0    P2.PFXL+P2=PFX 
          BX0    X0*X1
          LX0    P=PFX-P2=PFX      REPOSITION TAG PREFIX
          BX2    X0+X2
          =X0    I.BSS
          LX0    PB.GHIJP 
          LX2    PB.TAGP
          BX7    X0+X2
          EQ     EXIT.
 O=PLA    SPACE  4,8
 O=PLA    BSSENT 0
          SA2    B4 
          HX2    OP.BSSI
          MI     X2,NULLOP   IF BSS  ISSUED AT BOS
          SPACE  4,8
 O=CBSS   RJ     PBW
          EQ     CBREAK 
 CRJT     SPACE  4,10 
**        CRJ -  COMPILE SIMPLE RJT (WITH TRACE)
* 
*         ENTRY  (X1) = 18/TAG OF ROUTINE,42/0
*                (X4) = SKELETON WORD 
* 
*         EXIT   TO NULLOP
*                (X3) = SKELETON SHIFTED BY P.IEND
  
  
 O=CRJ    BSSENT             ENTRY... 
          SA4    CURSK
          SA2    X4          FETCH CURRENT SKEL WORD
          HX2    SK.ARG 
          MI     X2,CRJ2     IF (X1) ALREADY IN RIGHT FORMAT
          LX1    -P2.TAGP 
          MX0    -P2.TAGL 
          BX1    -X0*X1 
          SA1    X1 
          LX1    P2.TAGP
 CRJ2     SA3    TRACE
          MX0    P2.TAGL
          BX6    X0*X1       TAG
          CRJ    MUST        COMPILE RJT (WITH TRACE) 
          EQ     NULLOP      EXIT.. 
 CDCS     SPACE  4,8
**        O=CDCS - RESET USER/FIXED COLLATE.
  
 O=CDCS   BSSENT 0
          =A1    B4+OR.1OP
          MX0    -P2.BIASL
          LX1    -P2.BIASP
          BX6    -X0*X1 
          SA6    WO.CS       SET COLLATE FIXED/USER 
          EQ     NULLOP 
 CDDOT    SPACE  4,8
**        O=CDDOT - RESET ZERO/ONE-TRIP LOOP. 
  
 O=CDDOT  BSSENT 0
          =A1    B4+OR.1OP
          MX0    -P2.BIASL
          LX1    -P2.BIASP
          BX6    -X0*X1 
          SA6    WO.DOOT     SET DO TRIP 0/1
          EQ     NULLOP 
 CDLOO    SPACE  4,8
**        O=CDLOO - RESET OBJECT LIST ON/OFF. 
  
 O=CDLOO  BSSENT 0
          =A1    B4+OR.1OP
          MX0    -P2.BIASL
          LX1    -P2.BIASP
          SA2    OCIOL
          BX1    -X0*X1 
          LX2    PB.GHIJP 
          LX1    PB.BIASP 
          BX7    X1+X2
          WCODE  X7,NULLOP   OC$ OR I.IOL 0/1 
  
 OCIOL    BSSENT 1           CURRENT OBJECT LIST CONTROL OPCODE 
 O=ENT    SPACE  4,10 
**        O=ENT - ALTERNATE ENTRY POINT DEFINITION. 
* 
*         EXIT   TO O=CBSS -- 
*                (X1) = GL TO BE DEFINED
  
  
 O=ENT    BSSENT             ENTRY... 
          SA1    N.GL 
          SX6    X1+B1       COUNT GENERATED LABELS 
          SA6    A1 
          =A2    B4+OR.1OP   GET ENTRY TAG
          SA3    N.ALTEN     GET NUMBER OF ALTERNATE ENTRIES
          BX6    X1 
          =X7    X3+1 
          AX2    P2.TAGP     POSITION SYMBOL TABLE ORDINAL
          SA7    A3          UPDATE ALTERNATE ENTRY COUNT 
          LX5    B1,X2       MULTIPLY ORDINAL BY 2
          ERRNZ  K.SYM
          SA3    T.SYM       (X3) = SYM TAB ORDINAL 
          MX0    60-WC.EGLL  SET ENTRY GENERATED LABEL MASK 
          IX5    X5+X2       INDEX = 2*ORD + ORD
          ERRNZ  3-Z=SYM
          LX0    WC.EGLP     POSITION EGL MASK
          =B7    X3+WC.W
          LX6    WC.EGLP     POSITION GL ORDINAL
          SA3    X5+B7       GET WC. OF ENTRY 
          SX1    X1+K2.GL    TAG FOR GENERATED LABEL
          BX3    X0*X3       CLEAR EGL FIELD
          BX6    X6+X3       ADD GL ORDINAL INTO WC.EGL 
          LX1    P2.TAGP
          SA6    A3          RESET WC 
          EQ     O=CBSS 
 O=GENT   SPACE  4,7
**        O=GENT - MAIN CONTROLER OF ALTERNATE ENTRY CODE GENERATION. 
*                IT PRESIDES OVER A LARGE SKELETON DRIVEN LOOP. 
*                O=GENTX IS THE RETURN POINT FROM SKELETON CALLS. 
  
  
 O=GENT   BSSENT 0
          SA1    S=ENTRY     ORDINAL OF MAIN ENTRY
          SX6    X1+
          SA6    ENT.STO     INITIALIZE SYMBOL TABLE ORDINAL FOR SCAN 
  
 O=GENTX  BSSENT 0
          SA2    N.ALTEN     GET ALTERNATE ENTRY COUNT
          =X7    X2-1 
          ZR     X2,NULLOP   IF NO MORE ALTERNATE ENTRIES 
          SA5    ENT.STO     GET SYM TAB ORDINAL OF LAST ENTRY
          SA7    A2          RESET NUMBER OF ALT ENTS (N.ALTEN) 
          LX3    X5,B1       MULTIPLY SYM ORDINAL BY TWO
          SA2    T.SYM       GET SYMBOL TABLE FWA FOR SEARCH LOOP 
          IX3    X3+X5       (X3) = 3 * SYM TAB ORDINAL 
          =X3    X3+WB.W     (X3) = WB ORDINAL OF LAST ENTRY
          SB7    Z=SYM       SET WB ORD INCRIMENT FOR SYM TAB SEARCH
          SX6    X5+
  
**        SYMBOL TABLE ENTRY SEARCH:  
*         SCAN SYMBOL TABLE UNTIL ALTERNATR ENTRIES ARE EXAUSTED. 
  
 GENT5    =X3    X3+B7       INCRIMENT WB ORDINAL 
          =X6    X6+1        INCRIMENT SYMTAB ORDINAL 
          IX1    X2+X3       ADD ORIGIN TO  WB ORDINAL. 
          =A1    X1          GET WB OF POSSEBLE ENTRY 
          SBIT   X1,WB.ENTP 
          PL     X1,GENT5    IF NOT AN ENTRY
          SBIT   X1,WB.LABP/WB.ENTP 
          MI     X1,GENT5    IF LABEL 
  
**        WE HAVE AN ENTRY. NOW SET REG=G TABLE, WITH THE 
*         THE ENTRY AND ENTRY GENERATED LABEL (EGL),AND CALL
*         W=ALENT (THE NORMAL ALT ENT CODE SKEL). 
  
          MX0    -WC.EGLL    SET EGL MASK 
          =A1    A1-WB.W+WC.W      GET WC 
          LX1    -WC.EGLP    POSITION EGL FIELD 
          =A6    A5          RESET SYM TAB ORDINAL (ENT.STO)
          LX6    P2.TAGP     POSITION TAG FOR GP PROCESSING 
          BX1    -X0*X1      EXTRACT EGL FIELD
          SA6    REG=G       (GP1) = ALTERNATE ENTRY TAG
          SX7    X1+K2.GL 
          LX7    P2.TAGP     POSITION TAG FOR GP2 
          SA7    REG=G+1     (GP2) = EGL
          SX6    W=ALENT     SKELETON FOR STANDARD ENTRY CODE 
          SA7    ENT.EGL     SAVE ENTRY GENERATED LABEL TAG 
          EQ     SUB.RET
 O=FPENT  SPACE  4,10 
**        O=FPENT 
*                DECIDES TO PROCEED WITH NORMAL ENTRY CODE OR TO
*                TO SANDWITCH IN FP CODE. NORMAL FP CODE IS GENERATED 
*                BY W=FPENT WHICH LEADS TO W=ADSUB (ADD SUB CODE) AND 
*                W=VDENT (VAR DIM) CALLS. 
  
  
 O=FPENT  BSSENT 0
          SX6    0
          SA6    =XENTRJ     FLAG NO RJ ISSUED SINCE CODE MODIFICATION
  
 FPENT1   BSS    0
          SA4    ENT.STO     ENTRY POINT SYMORD 
          RJ     ISA         ISSUE SAVE A0 OR RJ CPL. 
          SA4    ENT.STO
          RJ     OSC         ISSUE SUB CODE 
          RJ     OZC         ISSUE SUB0 CODE
          SA1    ENT.VD            GET VAR DIM FLAG 
          SA1    ENTRJ
          NZ     X1,FPENT2   IF RJ ISSUED (OR NOT NEEDED) 
          SA2    N.GL 
          =X6    X2+1 
          SX4    X2+K.GL   TAG OF GL
          SA6    A2          N.GL = N.GL + 1
          ISSUE  I.RJ3,X4    RJ GL
          ISSUE  I.BSS,X4    GL BSS 0 
          ISSUE  I.ZERO      BSS 1
  
 FPENT2   SA1    ENT.VD      VARDIM FLAG
          ZR     X1,EVD1     IF NO VARDIM CODE
          SHRINK T=PAR,0
          SA5    T=VDIM      LENGTH OF THE SPARE I.L. 
          ALLOC  T.PAR,X5    GET SPACE FOR THE SPARE I.L. 
          SA2    T.VDIM      FWA OF VDIM I.L. 
          SA3    T.PAR       DESTINATION OF VDIM I. L. MOVE 
          MOVE   X5,X2,X3    MOVE VDIM I. L. TO T.PAR 
          SA1    ALC.00 
          BX7    X1          UNLOCK (B4)
          SA7    ALC.REG
          SA1    ENT.STO
          RJ     MAV         MARK VD IN *VDI* ALLOWED FROM THSI ENTRY 
          RJ     MVT         NO-OP STORES NOT APPLICABLE
          CALL   PIG         PROCESS I.L. FOR GEN 
          SA1    ALC.CAI
          BX7    X1          RESTORE (B4) LOCK -> (T.PAR) 
          SA7    ALC.REG
          SA1    T.PAR
          =B4    X1          SET B4 FOR EIS 
          EQ     EIS.PNX     RESTART GEN TO PROCESS VAR DIM I. L. 
  
 O=FPHDR  BSSENT 0
          MX6    1
          SA6    ENTRJ       FLAG RJ NOT NEEDED TO VOID HEADER
          EQ     FPENT1 
*CALL COMFISA 
*CALL COMFOSC 
*CALL COMFMAV 
 MVT      SPACE  4,10 
**        MVT - MARK VARDIM TURPLES NOT ALLOWED FOR THIS ENTRY. 
  
 MVT      SUBR
          SA1    T.VDI
          SA2    T.PAR
          SA3    T=VDI
          SX6    V=NOOP 
          LX6    TH.SKELP 
          =X0    O.NONE 
          LX0    TH.OVALP 
          BX6    X6+X0
          SA1    X1-1 
          SB7    X3 
          SB2    X2 
          SB7    A1+B7
  
 MVT10    SB6    A1-B7
          ZR     B6,EXIT.    IF VDI EXHAUSTED 
          =A1    A1+1 
          HX1    VD.ALO 
          MI     X1,MVT10    IF THIS VD APPLIES TO THIS ENTRY POINT 
          LX1    VD.ALOP+1-VD.LENP
          SB6    X1-1 
          ERRNZ  VD.LENL-18 
          LX1    VD.LENP-VD.PNTP
          SX0    X1+B6
          ERRNZ  VD.PNTL-18 
          LX1    B1,X0
          IX0    X1+X0
          SA6    B2+X0       STORE = NOOP 
          EQ     MVT10
  
**        RETURN FROM PROCESSING VAR DIM  I. L. 
*         HERE WE RESET THE VD I. L. FOR THE NEXT ENTRY 
  
  
 O=EVD    BSSENT 0           END VARDIM 
          DRITE  DEACTIVATE  CHECK DELAYED WRITE
          CALL   CIA         CLEAR REGFILE
 EVD1     SA1    ENT.EGL     GET ENTRY GENERATED LABEL
          ZR     X1,O=FINX   IF PROCESSING MAIN ENTRY 
          ERRZR  K.GL 
          BX7    X1 
          SX6    W=TENT      SET TERMINATE ENTRY CODE 
          SA7    REG=G+1     SET GP2 FOR W=TENT 
          EQ     SUB.RET
 O=FUNT   SPACE  4,10 
**        O=FUNT  SETS X6 AND X7 TO FUNCTION RESULT IF NEEDED.
  
  
 O=FUNT   BSSENT 0
          SA1    MOD         GET PROGRAM MODE 
          SX6    W=TMENT     NORMAL TERMINAL CODE SKEL FOR MAIN ENTRY 
          SBIT   X1,MO.FUNP 
          PL     X1,SUB.RET  IF NOT A FUNCTION
          LX1    MO.FUNP+1-MO.MODEP      POSITION MODE
          MX0    -MO.MODEL   SET MODE MASK
          BX0    -X0*X1      EXTRACT MODE 
          SB7    X0-M.CHAR
          ZR     B7,SUB.RET  IF CHARACTER FUNCTION
          SX6    W=DFENT
          SA1    S=VALUE
          SX1    X1+M.DBL 
          =X2    X1+M.CPLX-M.DBL
          LX3    B1,X1
          LX4    B1,X2
          IX1    X3+X1
          IX2    X4+X2
          SA3    T.SYM
          =B7    X3+WB.W
          SA1    X1+B7
          SA2    X2+B7
          BX0    X1+X2
          HX0    WB.MDF 
          MI     X0,SUB.RET  IF THERE IS DOUBLE OR COMPLEX ENTRY
          EQ     NULLOP      CONTINUE WITH SINGLE FUNCTION SKEL 
 O=MENT   SPACE  4,10 
**        O=MENT MAIN ENTRY CODE PROCESSOR. 
*                CHOOSES BETWEEN FP MAIN ENTRY CODE AND NORMAL MAIN 
*                ENTRY CODE.
  
  
 O=MENT   BSSENT 0
          RJ     ICP         ISSUE CP. AND GPL. TABLES
          SA1    MOD
          MX0    -MO.CLIFL
          LX1    -MO.CLIFP
          BX1    -X0*X1 
          NZ     X1,MENT05   IF CHARACTER FUNCTION
          SA1    N.FP        GET NUMBER OF FORMAL PARAMETERS
          SX5    W=FUNT      FUNCTION ENTRY CODE SKELETON 
          ZR     X1,MENT1    IF NO FORMAL PAREMETERS
  
 MENT05   SX5    W=MFPNT     SUBSKEL FOR MAIN ENTRY 
  
 MENT1    CBSS   0           FORCE UPPER ON START BLOCK 
          ISUSE  STRT        USE   START. 
          SA2    CO.DBER
          ZR     X2,MENT2    IF OTR DESELEDTED
          RJ     SOR         SET OBJECT TIME REPRIEVE 
  
 MENT2    SA1    S=EXIT 
          ISSUE  I.BSS,X1    EXIT. BSS 0
          SA1    =XN.ARP
          ZR     X1,MENT25   IF NO ALT ENTRIES
          ISSUE  7110B       SX1 0
          SA1    S=AEXIT
          ISSUE  I.BSS,X1    AEXIT. BSS 0 
  
 MENT25   BX7    0
          =X6    X5          (X6) = SUBSKEL ORDINAL 
          SA7    ENT.EGL     SET EGL FLAG TO INDICATE MAIN ENTRY
          SA1    S=ENTRY
          BX7    X1 
          SA7    ENT.STO     FLAG MAIN ENTRY
          EQ     SUB.RET
  
 ENT.EGL  BSZENT 1           ENTRY GENERATED LABEL CELL 
 ENT.STO  BSZENT 1           SYM TAB ORDINAL FOR ENTRY SYM TAB SCAN.
 ENT.SUB  BSZENT 1           ADD SUB FLAG 
 CC$SUB   EQU    ENT.SUB
 ENT.SB0  BSZENT 1
 CC$SUB0  EQU    ENT.SB0
 ENT.VD   BSZENT 1           VARDIM I. L. FLAG
 N.ALTEN  BSZENT 1           ALTERNATE ENTRY COUNTER
*CALL COMFICP 
 O=FIN    SPACE  4,10 
**        O=FIN - END OF IL.
* 
*         ENTRY  (B4) = TURPLE. 
*         EXIT   TO EISX. 
  
  
 O=FIN    BSSENT             ENTRY... 
          SA2    MOD
          HX2    MO.PRO 
          PL     X2,FIN3     IF A SUB PROGRAM 
          CBSS   0           FORCE UPPER
          ISUSE  STRT        USE START
          SA2    CO.DBER
          ZR     X2,FIN2     IF OTR DE-SELECTED 
          RJ     SOR         SET OBJRCT TIME REPRIEVE 
 FIN2     SX6    W=PROM      SET MAIN PROGRAM SKELETON
          EQ     SUB.RET     PROCESS MAIN PROLOGUE
  
 FIN3     LX2    MO.PROP-MO.BLKP
          MI     X2,O=FINX   IF BLOCK DATA, TERMINATE 
          RJ     OST         OUTPUT SUB TABLES
          SX6    W=PROS 
          EQ     SUB.RET     ISSUE PROLOG 
  
*         PROLOG SKELETONS RETURN TO O=FINX.
  
 O=FINX   BSSENT             ...RETURN FROM PROLOG SKELETONS
          CBSS   0           FORCE UPPER ON START BLOCK 
          WPOP   I.EMI       END MACHINE INSTRUCTIONS 
          SA2    =XN.STMAX
          SA3    =XN.ST 
          MX6    X2+X3
          SA6    A2          MAX IN NEWEST TEMP VECTOR SIZE 
          CALL   ITS         ISSUE TEMP STORAGE 
          SA1    T=CON
          BX6    X1 
          SA6    N.CON       FOR PASS 3 
          WPOP   OC$END,EISX       EXIT.. 
 OST      EJECT 
**        OST - OUTPUT SUB AND SUB0 INDEX TABLES. 
  
 OST      SUBR
          SA1    ENT.SUB
          ZR     X1,OST10    IF NO SUBS 
          ISUSE  SUB
          SA1    S=SUB
          ISSUE  I.BSS,X1    SUB. BSS 0 
          ISUSE  TEM
          SA1    S=SUBI 
          ISSUE  I.BSS,X1    SUBI. BSS 0
          =X6    0
          RJ     OSI         ISSUE SUBI.
  
 OST10    ISUSE  TEM
          SA1    S=SUB0I
          ISSUE  I.BSS,X1    SUB0I. BSS 0 
          =X6    1
          RJ     OSI         ISSUE SUB0I. 
          EQ     EXIT.
 OSI      SPACE  4,10 
**        OSI - ISSUE SUB INDEX TABLE.
* 
*         ENTRY  X6 = 0/1 FOR SUB/SUB0
  
 OSI      SUBR
          SA6    OSIA 
          MX7    0
          SA7    OSIB 
          SA7    OSID        TOTAL = 0
          SA1    T.ENTP 
          =A0    -1 
          SB5    X1 
          EQ     OSI20
  
*         ISSUE ZERO TERMINATOR FOR THIS LIST.
  
 OSI10    SA2    OSIB 
          SA4    OSID 
          IX1    X4-X2
          ZR     X1,OSI20    IF NO SUBS THIS LIST 
          ISSUE  I.ZERO 
          SA1    T.ENTP 
          SB5    X1 
          SA1    OSIB 
          SX6    X1+B1       TOTAL = TOTAL + 1
          SA6    A1 
          SA6    A4          NEW LEN = TOTAL
          SX6    X4+B1
          SA1    OSIC 
          SA2    X1+B5
          SA1    OSIA 
          SA1    OSIS+X1
          SB3    X1 
          LX6    B3 
          BX7    X2+X6
          SA7    A2          SUBI[ENTP(I)] = OLD SUBI LEN+1 
  
 OSI20    SA0    A0+2        SKIP HEADER
          SX6    A0-B1       POINTS TO HEADER 
          SA5    B5+A0
          SA6    OSIC 
          SA1    T=ENTP 
          SB7    X1 
          SB7    A0-B7
          PL     B7,EXIT.    IF ENTP FINISHED 
          SB6    60 
  
 OSI30    NZ     B6,OSI40    IF THIS WORD NOT EXHAUSTED 
          SB6    60 
          =A0    A0+1 
          SA5    B5+A0
  
 OSI40    SB6    B6-15
          MX0    -EF.ORDL 
          AX3    B6,X5
          BX6    -X0*X3 
          ZR     X6,OSI10    IF END OF LIST 
          SA1    T.SYM
          LX7    B1,X6
          IX3    X7+X6
          =B7    X1+WB.W
          SA1    B7+X3
          MX0    -WB.FPNOL
          SA2    =XT.FPI
          LX1    -WB.FPNOP
          BX1    -X0*X1 
          IX3    X1+X2
          SA3    X3-1 
          SA4    OSIA 
          SA2    OSIM2+X4 
          BX0    X2*X3
          ZR     X0,OSI30    IF THIS FP NOT APPLICABLE
          SA2    OSIM3+X4 
          BX0    X2*X3
          ZR     X0,OSI30    IF SUB0 AND NOT LEVEL 0
          SA1    OSIO+X4     INSTRUCTION OPCODE 
          ISSUE  X1,X6
          SA1    OSIB 
          =X6    X1+1 
          SA6    A1          TOTAL = TOTAL + 1
          SA1    T.ENTP 
          SB5    X1 
          EQ     OSI30
  
 OSIA     BSS    1
 OSIB     BSSZ   1
 OSIC     BSS    1
 OSID     BSSZ   1
 OSIS     CON    EH.SUBIP,EH.SB0IP
 OSIO     CON    I.SUBI,I.SB0I
 OSIM2    BFMW   FP,LEN 
          BFMW   FP,(VDS,SUB0)
 OSIM3    VFD    60/-0
          BFMW   FP,LEV0
 O=GFD    SPACE  4,10 
**        O=GFD - GENERATE FILE DECLARATION.
* 
*         ENTRY  (B4) -> (V=FILE) TURPLE. 
*                (1OP.BIAS) = FILE TABLE INDEX. 
* 
*         EXIT   TO EIS.PNX 
  
  
 TP       MICRO  1,, P2 
  
  
 O=GFD    BSSENT 0           ENTRY... 
          SB5    B4 
*CALL     COMFGFD                  GENERATE FILE DECLARATIONS 
          SB4    B4+Z=TURP
          EQ     EIS.PNX
 O=HDR    SPACE  4,10 
**        O=HDR - BEGINNING OF PROGRAM-UNIT.
* 
*         ENTRY  (B4) = TURPLE. 
*         EXIT   TO EIS.PNX . 
  
  
 O=HDR    BSSENT             ENTRY... 
          SB4    B4+Z=TURP
          WPOP   OC$IDNT
          SA2    MOD
          HX2    MO.BLK 
          MI     X2,EIS.PNX  IF BLOCKDATA, NO TRACE WORD
          WPOP   OC$TRAC
          SA2    MOD
          HX2    MO.PRO 
          SA1    S=UPW
          PL     X2,HDR6     IF NOT MAIN PROGRAM
          ZR     X1,EIS.PNX  IF NO FILE ARGUMENTS 
          ISSUE  OC$BSS,X1   UPW.  BSS 0
          SA2    NARGS
          SX7    X2+B1
          LX1    X7,B1       FILETAB LEN = 2 * (NARGS + 1)
          LX1    -PB.TAGP+PB.BIASP
          ISSUE  OC$FVEC,X1,EIS.PNX 
  
 HDR6     SA1    S=SA1
          ISSUE  OC$BSS,X1   SAVEA1 BSS 0 
          WPOP   I.ZERO 
  
*         CID REQUIRES SAVEA0 TO BE AT SAVEA1+1.
  
          SA1    S=SA0
          ISSUE  OC$BSS,X1   SAVEA0  BSS  0 
          WPOP   OC$BMI 
          WPOP   I.ZERO 
          WPOP   I.EMI,EIS.PNX
 DATA     SPACE  4,10 
**        DATA - PROCESS DATA TURPLE AND TABLE. 
  
  
 O=DATA   BSSENT 0
          SA1    T=DATS 
          BX4    X1 
          LX1    PB.BIASP-PB.TAGP 
          ISSUE  I.DATA,X1
  
          SB5    0
          SB6    X4 
          SB2    DATA10      EXIT FROM WTE
  
 DATA10   SA1    T.DATS 
          EQ     B5,B6,DATA20      IF DATA TABLE EXHAUSTED
          SA5    X1+B5
          BX7    X5 
          SB5    B5+1 
          JP     WTE         WRITE DATA TABLE ENTRY TO PREBINARY
  
 DATA20   SHRINK T=DATS,0 
          EQ     NULLOP 
 O=ILL    SPACE  4,8
**        O=ILL - TURPLE CODE LOST. 
  
 O=ILL    BSSENT
          EQ     "BLOWUP" 
 O=LCC    SPACE  4,10 
**        O=LCC - LOADER CONTROL CARD.
* 
*         ENTRY  (B4) = TURPLE. 
*         EXIT   TO EIS.PNX . 
  
  
 O=LCC    BSSENT             ENTRY... 
          =A1    B4+OR.1OP
          SX7    OC$LCC 
          LX1    0-P2.BIASP+PB.BIASP
          LX7    PB.GHIJP 
          =A2    B4+OR.2OP
          BX7    X7+X1
          LX2    0-P2.BIASP+PB.TAGP 
          BX7    X7+X2
          SB4    B4+Z=TURP
          WCODE  X7,EIS.PNX 
 O=PLIM   SPACE  4,10 
**        O=PLIM - MARK END OF FILE DEFINITIONS.
  
  
 O=PLIM   BSSENT             ENTRY... 
          SB4    B4+Z=TURP
*CALL COMFPLI                ISSUE QXNTRY. APLIST 
          EQ     EIS.PNX
 O=RGT    SPACE  4,10 
**        O=RGT - ALTERNATE RETURN
  
  
 O=RGT    BSSENT 0
          MX2    P2.BIASL 
          LX2    P2.BIASL+P2.BIASP
          =A1    B4+OR.2OP
          BX3    X1-X2       NEGATE BIAS
          MX1    1
          BX3    X2*X3
          LX1    1+P2.SHRTP 
          BX6    X1+X3
          SA6    REG=G+1     GL2 = -2OP 
          =A5    B4+OR.1OP
          SA3    UAP
          SX1    X3+K2.AP 
          LX1    P2.ORDP
          LX5    -P2.BIASP
          SX6    X5 
          LX6    P2.BIASP 
          BX6    X1+X6
          SA6    REG=G       GL1 = APIND + BIAS[OP1]
          EQ     NULLOP      CONTINUE WITH SKEL 
 O=SEX    SPACE  4,10 
**        O=SEX  - START EXECUTABLES. 
* 
*         ENTRY  (B4) = TURPLE
*         EXIT   TO EIS.PNX 
*         CALLS  CBSS, SOR, WCODE.
  
  
 O=SEX    BSSENT             ENTRY... 
          SB4    B4+Z=TURP
          ISUSE$ CON         USE CON. 
          WPOP   OC$CON      PROCESS LITERALS 
          ISUSE$ FMT         USE FMT. 
          WPOP   OC$FMT      PROCESS FORMATS
          ISUSE$ APL         USE APL. 
          WPOP   OC$APL      PROCESS AP-LIST
          ISUSE$ IOAP        USE IOAPL. 
          WPOP   OC$IOM      PROCESS I/O APLISTS. 
          ISUSE$ NLST        USE NLST.
          WPOP   OC$NLST     PROCESS NAMELIST DEFS
          SX2    BN=CODE
          SX6    OC$USE 
          LX2    PB.BIASP 
          LX6    PB.GHIJP 
          BX7    X2+X6       ISSUE   * USE  CODE. * 
          WCODE  X7 
          SX6    I.LOO
          SA6    OCIOL       CURRENT OBJECT ON/OFF OPCODE 
          WPOP   OC$BMI,EIS.PNX    BEGIN MACHINE INSTRUCTIONS 
 SOR      SPACE  4,10 
**        SOR -  SET OBJECT TIME REPRIEVE CODE
* 
*         ISSUES OBJECT-TIME-REPRIEVE HEADER -- 
*                        +   SB0   B2-LEN.      CT.LENP = L.10
*                            SB0   B2+TRACE.    CT.TRAC = L.0 
*         CALLS  WCODE. 
* 
*         EXIT   TO CALLER
  
 SOR      SUBR   0
          SX4    I.OTR
          SA2    S=LENP 
          =X2    X2+K.SYM 
          LX4    PB.GHIJP 
          LX2    PB.TAGP
          BX7    X2+X4       12/I.OTR,18/TAG OF LENGTH WORD,30/0
          WCODE  X7          SB0    B2-LEN. 
          SX2    SB=BK+2S3   AVOID FORCE UPPER WITH REAL INST 
          LX2    PB.INSTP 
          SA3    S=TRACE
          =X4    X3+K.SYM 
          LX4    PB.TAGP
          IX7    X2+X4       12/6102,18/TAG OF TRACE WORD,30/0
          WCODE  X7,EXIT.    SB0   B2+L.0 
          TITLE  PROCESSORS TO SELECT SUB-SKELETONS.
 O=IM     SPACE  4,10 
**        O=IM - INTEGER MULTIPLY.
  
  
 O=IM     BSSENT 0           ENTRY... 
          SX6    W=IMV       GENERAL INTEGER MULTIPLY 
          EQ     SUB.RET
 O=ID     SPACE  4,10 
**        O=ID - INTEGER DIVIDE.
  
  
 O=ID     BSSENT 0
          SX6    W=IDV       GENERAL INTEGER DIVIDE 
          EQ     SUB.RET
 O=MASK   SPACE  4,10 
**        O=MASK - SELECT MASK GENERATION CODE. 
  
  
 O=MASK   BSSENT 0
          SX6    W=MASKV     SET GENERAL MASK 
          EQ     SUB.RET
 O=MOD    SPACE  4,10 
**        O=MOD - SELECT CODE FOR MODULUS FUNCTION. 
  
  
 O=MOD    BSSENT 0
          SX6    W=MODG      SET GENERAL MODULUS SKEL 
          EQ     SUB.RET
          SPACE  4,8
*         O=SHIFT - SELECT SUBSKEL FOR SHIFT FUNCTION 
  
 O=SHIFT  BSSENT 0
          SX6    W=SHIFV     SET GENERAL SHIFT SKEL 
          EQ     SUB.RET
          TITLE  (O=DO)  DO LOOP SKELETON PROCESSORS. 
 O=DOB    SPACE  4,10 
**        O=DOB - FINAL ACTION OF A DO-BEGIN SKELETON.
* 
*         ENTRY  (X1) = DO-TOP LABEL OPERAND. 
* 
*         EXIT   TO O=CBSS -- 
*                (X1) = DO-TOP LABEL OPERAND. 
*                (B4) ADVANCED OVER MEGA-TURPLE.
  
  
 O=DOB    BSSENT 0           ENTRY... 
          SB4    B4+2*Z=TURP ADVANCE REST OF MEGATURP 
          EQ     O=CBSS 
 O=DOBZ   SPACE 4,10
**        O=DOBZ - BEGIN ZERO TRIP DO LOOP
*         DOBZ CREATES A 1 SUBTRACT FROM TRIP COUNT.
*         ITS ONLY JOB IS TO CREATE A GENERATED L 
*         OPERAND (GL1) WHICH IS A SHORT CONSTANT  1. 
* 
*         ENTRY  NONE 
* 
*         EXIT   (REG=G) = I. L. FORMAT ENTRY FOR SHORT CON -1
* 
*         SAVES  A4,X4,B4 
  
  
  
 O=DOBZ   BSSENT 0
          =X0    1
          MX2    1
          LX0    P2.SHRTP    SET SHORT CONSTANT BIT 
          =X6    0           USE COUNT INCRIMENT = 0
          LX2    1+P2.BIASP  POSITION CONSTANT
          BX2    X2+X0       CONSTRUCT STATUS WORD
          RJ     POS         PREPARE OPERAND STATUS WORD
          SA6    REG=G       SET GL1
          EQ     NULLOP 
 O=DOC    SPACE  4,10 
**        O=DOC - FIRST ACTION OF A DO CONCLUSION SKELETON. 
* 
*         ENTRY  (X1) = 0, IFF (DO=SHORT) LOOP CONCLUDING.
* 
*         EXIT   TO *EIS.LNX* = CONTINUE WITH SKELETON. 
*                (GL1) = SHORT CONSTANT -1. 
  
  
 O=DOC    BSSENT 0           ENTRY... 
          MX1    P2.BIASL-1 
          CLAS=  X3,P2,(SHRT) 
          LX1    P2.BIASL+P2.BIASP
          BX2    X3+X1
          SX6    B0 
          CALL   POS         PROCESS OPERAND STATUS 
          SA6    REG=G       SET (GL1) = MINUS ONE
          EQ     EIS.LNX     EXIT.. 
 O=DOEND  SPACE  4,10 
 O=PDE    SPACE  4,10 
**        O=PDE - FINAL ACTION OF A DO-CONCLUSION SKELETON. 
* 
*         O=PDE IS MAINLY PROVIDED FOR COMPATIBILITY WITH THE BRIDGE -- 
*         ITS FUNCTION IS NOT NECESSARY TO QCG, BUT IS POSSIBLY A SLIGHT
*         EFFICIENCY IMPROVEMENT. 
* 
*         EXIT   TO *EIS.PNX*.
*                (B4) ADVANCED OVER MEGATURPLE. 
  
  
 O=PDE    BSSENT 0           ENTRY/EXIT...
          SB4    B4+2*Z=TURP ADVANCE OVER MEGA-TURPLE 
          EQ     EIS.PNX     EXIT.. 
          TITLE  (O=GO)  COMPUTED GOTO PROCESSOR. 
 O=CGT    SPACE  4,10 
**        O=CGT  COMPUTED GOTO PROCESSOR
*                HERE THE KEY DECISION IS WHETHER THE LINE NUMBER 
*                IS GREATER THAN 7777B. THE REASON FOLLOWS: 
*                THE ACTUAL JUMP CODE HAS THE FORM  JP   B6+L.N 
*                                             L.N   RGT  =XGOTOER.
*                                                   EQ   TAG1 
*                                                   ........
*                                                   EQ   TAGN 
*                    TWELVE BITS OF THE RJT WORD RESERVED FOR THE 
*                LINE NUMBER(TRACEBACK). IF LINE NO.IS GREATER THAN 
*                7777B ANOTHER WORD IS USED TO CARRY THE LINE NO. 
*                NOW, THE GOC SUB-SKELS SET B6, AND THUS MUST BE
*                DIFFER TO ACCOUNT FOR THE EXTRA WORD.IN BOTH CASES 
*                B6 IS ZERO IF THE CONTROL VARIABLE IS NOT BETWEEN
*                1 AND N. OTHERWISE B6 POINTS TO THE APPROPRIATE
*                EQ   TAGI .
  
 O=PCG    SPACE  4,10 
**        SET UP GP AND SUBSKEL ORDINAL FOR COMPUTED GO TO. 
  
  
 O=PCG    BSSENT 0
          SA5    N.GL        GET GL ORDINAL 
          =X1    I.JPI+6S12  OPCODE FOR INDEX JUMP +6 FOR B6
          ERRNZ  PB.BJRP
          ERRNZ  12-PB.GHIJL
          =X6    X5+1 
          SX5    X5+K.GL     ADD ON GL PREFIX 
          ERRMI  K.GL 
          LX1    PB.GHIJP    POSITION OPCODE AND B6 INDICATOR 
          =A6    A5          RESET GL COUNTER 
          LX5    PB.TAGP     POSITION TAG 
          IX7    X1+X5       ADD TAG TO OPCODE + B6 INDICATOR 
          WCODE  X7          WRITE: JP  B6+GL.N 
          =X7    I.BSS
          LX7    PB.GHIJP 
          IX7    X7+X5
          WCODE  X7,NULLOP   WRITE:  GL.N   BSS  0
 O=PASG   SPACE  4,10 
**        PASG- ASSIGN TURPLE PROCESSOR.
*         MAINTAIN LABEL ADDRESS (LA.) TABLE AND DEFINE GL1.
  
 O=PASG   BSSENT 0
          SA1    S=LA 
          SA2    T=LA 
          LX1    P2.TAGP
          LX2    P2.BIASP 
          =X6    0
          BX2    X1+X2
          RJ     POS         PREPARE OPERAND
          SA6    REG=G       GL1 = LA. + K, K= T=LA 
          =A1    B4+OR.1OP
          MX0    -P2.TAGL 
          LX1    -P2.TAGP 
          BX6    -X0*X1 
          ADDWD  T.LA        LA(K) = SYMORD(1OP)
          EQ     NULLOP 
 END      SPACE  4,10 
          LIST   D
          END 
