Retro1.org codex

          IDENT  KRONREF,FETS,KRONREF
          ABS
          ENTRY  KRONREF
          ENTRY  MFL=
          SYSCOM B1          DEFINE (B1) = 1
*COMMENT  KRONREF - SYSTEM CROSS REFERENCE PROGRAM.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  KRONREF - KRONOS SYSTEM CROSS REFERENCE PROCESSOR.
          SPACE  4
*****     *KRONREF* - KRONOS SYSTEM CROSS REFERENCE PROCESSOR.
*         G. R. MANSFIELD.   70/10/26.
*         A. D. FORET.       75/04/18.
          SPACE  4
***              *KRONREF* GENERATES A CROSS REFERENCE OF SYSTEM
*         SYMBOLS USED BY DECKS ON A MODIFY OPL.
          SPACE  4
***       CONTROL CARD CALL.
*
*
*         KRONREF(P1,P2,P3)
*                PN MAY BE OF THE FOLLOWING FORMS.
*                            PN
*                            PN=NAME
*
*         OPTIONS.
*
*                P           OPL INPUT FROM FILE *OPL*.
*                P=FNAME     OPL INPUT FROM FILE *FNAME*.
*
*                L           LIST OUTPUT ON FILE *OUTPUT*.
*                L=FNAME     LIST OUTPUT ON FILE *FNAME*.
*
*                S           SYSTEMS TEXT FROM OVERLAY *NOSTEXT*.
*                S=NAME      SYSTEMS TEXT FROM OVERLAY *NAME*.
*
*                G           SYSTEMS TEXT FROM FILE *TEXT*.
*                G=FNAME     SYSTEMS TEXT FROM FILE *FNAME*.
*                            OVERRIDES ANY *S* SELECTION.
          SPACE  4
***       DAYFILE MESSAGES.
*
*         * ERROR IN KRONREF ARGUMENTS. * - AN ILLEGAL CONTROL CARD
*                                           WAS SELECTED.
*
*         * ERROR IN SYSTEM TEXT. * - DESIGNATED SYSTEM TEXT IS IN THE
*                                     WRONG FORMAT.
*
*         * KRONREF COMPLETE.* - NORMAL COMPLETION MESSAGE.
*
*         * MEMORY OVERFLOW. * - NOT ENOUGH STORAGE AVAILABLE TO STORE
*                                TABLES.
*
*         * NO REFERENCES LISTED.* - OPL FILE DID NOT REFERENCE ANY
*                                    SYSTEM TEXT SYMBOLS.  CHECK FOR
*                                    EMPTY OR INVALID OPL FILE OR BAD
*                                    SYSTEM TEXT.
*
*         * PL ERROR IN DECK (NAME). * - BAD OPL/OPLC DECK.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*         * SCANNING DECKNAME * - WHERE DECKNAME IS CURRENTLY BEING
*                                 PROCESSED.
          SPACE  4
****      ASSEMBLY CONSTANTS.
 
 
 BUFL     EQU    100B        SCRATCH BUFFER LENGTH
 PBUFL    EQU    4001B       OPL FILE BUFFER LENGTH
 MXCCL    EQU    37B         MAXIMUM LENGTH OF ONE COMPRESSED CARD
 MTBSL    EQU    26000B      NOMINAL TABLE LENGTH
 MINC     EQU    1000B       MEMORY INCREMENT FOR *TOV*
 LCFE     EQU    99999       LINE COUNT TO FORCE EJECT
****
          TITLE  MACRO DEFINITIONS.
 ADDWRD   SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
          SPACE  4
**        ADDWRD - ADD WORD TO MANAGED TABLE.
*
*         ADDWRD TNAM,WORD
*
*         ENTRY  *TNAM* = TABLE NAME.
*                *WORD* = -X- REGISTER CONTAINING WORD.
*                *WORD* = BOOLEAN -X- REGISTER EXPRESSION.
*
*         USES   A0, X1.
*
*         CALLS  ADW.
 
 
          PURGMAC  ADDWRD
 ADDWRD   MACRO  TNAM,WORD
          IFC    NE,$X1$WORD$,1
          BX1    WORD
          R=     A0,TNAM
          RJ     ADW
 ADDWRD   ENDM
 ALLOC    SPACE  4,10
**        ALLOC - ALLOCATE TABLE SPACE.
*
*         ALLOC  TNAM,N
*
*         ENTRY  *TNAM* = TABLE NAME.
*                *N* = NUMBER OF WORDS TO ADD.
*
*         USES   A0, X1.
*
*         CALLS  ATS.
 
 
          PURGMAC  ALLOC
 ALLOC    MACRO  TNAM,N
          R=     X1,N
          R=     A0,TNAM
          RJ     ATS
 ALLOC    ENDM
 OPC      SPACE  4,10
**        OPC - OPCODE TABLE ENTRY.
*
*         OPC    OPCODE,ADDRESS
*
*         ENTRY  *OPCODE* = OPERATION CODE.
*                *ADDRESS* = ADDRESS OF PROCESSOR.
 
 
          PURGMAC  OPC
 OPC      MACRO  OPCODE,ADDR
          VFD    60/0R;A
          IFC    NE,*ADDR**
          VFD    60/ADDR
          ELSE   1
          CON    OPCX
 OPC      ENDM
 TABLE    SPACE  4,10
**        TABLE - GENERATE MANAGED TABLE POINTERS.
*
*         TABLE  TNAM
*
*         ENTRY  *TNAM* = TABLE NAME.
*
*         EXIT   *F.TNAM* = ADDRESS OF TABLE FWA POINTER.
*                *L.TNAM* = ADDRESS OF TABLE LENGTH POINTER.
 
 
          PURGMAC  TABLE
          MACRO  TABLE,TNAM,N
 TNAM     EQU    *
          VFD    60/MTBS
 F.TNAM   EQU    FTAB+TNAM
          RMT
 L.TNAM   EQU    LTAB+TNAM
          ORG    L.TNAM
          DATA   0
          ORG    NTAB+TNAM
          VFD    60/N
          RMT
 TABLE    ENDM
          TITLE  FETS AND STORAGE ASSIGNMENTS.
 FETS     SPACE  4,10
**        FETS.
 
 
          ORG    103B
 FETS     BSS    0
 
 O        BSS    0
 OUTPUT   FILEC  PBUF,PBUFL,(FET=6)
 
 P        BSS    0
 OPL      RFILEB PBUF,PBUFL,(FET=8),EPR
 FTAB     SPACE  4,10
**        MANAGED TABLES ARE REFERENCED BY THE TABLE NUMBER *TNAM*.
*         THE FWA OF A TABLE IS CONTAINED IN *F.TNAM*.
*         THE LENGTH OF A TABLE IS CONTAINED IN *L.TNAM*.
*         THESE SYMBOLS ARE GENERATED BY THE *TABLE* MACRO.
 
 
 FTAB     BSS    0
          LOC    0
 TNME     SPACE  4,10
**        TNME - TABLE OF REFERENCED NAMES.
*         ENTRY = 1 WORD.
*
*T        12/,48/  *NAME*
*         NAME   NAME RIGHT JUSTIFIED
 
 
 TNME     TABLE  10          NAMES
 TREF     SPACE  4,10
**        TREF - TABLE OF REFERENCES.
*         ENTRY = 1 WORD.
*
*T        42/  *DECK*,18/  IN
*         DECK   DECK NAME
*         IN     INDEX IN *TNME*
 
 
 TREF     TABLE  200
 
*         REMAINDER OF MANAGED TABLE VALUES.
 
 FTABL    BSS    0
          LOC    *O
 
          VFD    60/MTBS     LWA+1 ALL TABLES
 LTAB     BSS    0
 NTAB     EQU    LTAB+FTABL
          HERE
          TITLE  STORAGE ASSIGNMENTS.
 DATA     SPACE  4,10
*         COMMON DATA.
 
 
 T1       DATA   0           TEMPORARY STORAGE
 T2       DATA   0
 FL       DATA   0           FIELD LENGTH
 SL       DATA   0           SYSTEM SYMBOL LENGTH
 RF       DATA   0           REFERENCE FLAG
 PP       DATA   0           PP CODE
 DN       DATA   0           DECK NAME
 CH       DATA   0           NEXT CHARACTER
 CP       DATA   0           CHARACTER POINTER
 LIST     SPACE  4,10
*         LIST CONTROLS.
 
 
 LC       CON    LCFE        LINE COUNT
 LL       CON    0           LINE LIMIT
 PD       CON    0           PRINT DENSITY
 PN       CON    1           PAGE NUMBER
 ST       CON    0,LSRA      ADDRESS OF SUBTITLE LINES
 TX       CON    0           SYSTEXT PRESENT FLAG
          SPACE  4
*         PROGRAM LIBRARY STATISTICS.
 
 
 BLANK    CON    0           BLANK STATEMENTS
 CALL     CON    0           *CALL STATEMENTS
 CODE     CON    0           LINES OF CODE NOT OTHERWISE COUNTED
 COMNT    CON    0           * TYPE COMMENT STATEMENTS
 INACT    CON    0           INACTIVE STATEMENTS
 BLOCK    SPACE  4
*         BLOCK STORAGE.
 
 
          USE    BUFFERS
 
*         TITLE LINE.
 
 TITL     DATA   30H1  CROSS REFERENCE OF OPL.
          DATA   10H OPL FILE=
 PLNM     DATA   10H
          DATA   10HSYS. TEXT=
 TXNM     DATA   10H *NONE*
          DATA   10H
          DATA   10H
 DATE     DATA   1H
 TIME     DATA   1H
          DATA   4APAGE
 PAGE     DATA   1H
 TITLL    EQU    *-TITL
 
 CDTX     BSS    MXCCL       CARD TEXT
          USE    *
          TITLE  MAIN PROGRAM.
 KRONREF  SPACE  4,10
**        KRONREF - MAIN PROGRAM.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 1.
*
*         CALLS  LCL, LNK, LOC, LSR, LSS, OPC, PRS, RMT, SCA.
*
*         MACROS ENDRUN, MESSAGE, RECALL, WRITEC, WRITER.
 
 
 KRONREF  SB1    1           (B1) = 1
          RJ     PRS         PRESET PROGRAM
          RJ     LSS         LOAD SYSTEMS SYMBOLS
 
*         BEGIN NEW DECK.
 
 REF1     RJ     RMT         READ MODIFIER TABLE
          NZ     X1,REF4     IF EOR
 
*         SCAN DECK CARDS.
 
 REF2     RJ     RPF         READ CARD
          NZ     X1,REF1     IF EOR
          SA1    CDTX        CHECK FIRST CHARACTER
          NZ     X1,REF3     IF NOT BLANK STATEMENT
          SA1    BLANK       COUNT BLANK STATEMENT
          SX6    B1
          IX6    X6+X1
          SA6    A1
          EQ     REF2        LOOP FOR NEXT STATEMENT
 
 REF3     RJ     LOC         PROCESS LOCATION FIELD
          ZR     X6,REF2     IF NO PROCESSING
          SA1    TX
          ZR     X1,REF2     IF NO SYSTEXT
          RJ     OPC         PROCESS OPCODE
          NZ     X1,REF2     IF NOT INTERESTING
          SA2    RF
          ZR     X2,REF2     IF REFERENCE FLAG OFF
          RJ     SCA         SCAN ADDRESS
          EQ     REF2        CONTINUE SCAN
 
*         LIST REFERENCE TABLE.
 
 REF4     SA1    L.TREF
          ZR     X1,REF6     IF NO REFERENCES
          RJ     LNK         LINK TABLES
          RECALL P
          SA1    TX
          ZR     X1,REF4.1   IF NO SYSTEXT
          RJ     LSR         LIST SYMBOL REFERENCES
 REF4.1   RJ     LCL         LIST SPECIAL CALLS
          RJ     PLS         ISSUE PROGRAM LIBRARY STATISTICS MESSAGES
          SA1    PN
          LX1    59
          NG     X1,REF5     IF PAGE COUNT EVEN
          WRITEC O,(=2L1 )
 REF5     WRITER O,R
          MESSAGE  (=C* KRONREF COMPLETE.*)
          ENDRUN
 
 REF6     MESSAGE  (=C* NO REFERENCES LISTED.*)
          ENDRUN
          TITLE  DECK SCANNING.
 LOC      SPACE  4,10
**        LOC - PROCESS LOCATION FIELD.
*
*         EXIT   (X6) = NEXT CHARACTER OR 0 IF NO NEXT CHARACTER.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 6.
*
*         CALLS  ASN, ESR, SNC.
 
 
 LOC4     SA1    COMNT       COUNT * TYPE COMMENT STATEMENTS
          SX6    B1
          IX6    X6+X1
          SA6    A1+
          SX6    B0+         CLEAR NEXT CHARACTER
*         EQ     LOCX        RETURN
 
 LOC      SUBR               ENTRY/EXIT
          SX1    B0          SET CHARACTER POINTER
          PX6    X1,B0
          SA6    CP
          RJ     SNC         SET NEXT CHARACTER
          SA2    CDTX
          AX2    54
          ZR     X2,LOC1     IF NO LOCATION FIELD
          SX7    X6-1R*
          ZR     X7,LOC2     IF FIRST CHARACTER = (*)
          RJ     SNC         SET NEXT CHARACTER
          RJ     ASN         ASSEMBLE NAME
 LOC1     RJ     SNC         SET NEXT CHARACTER
          SA1    CODE        COUNT LINE OF CODE
          SX6    B1
          IX6    X6+X1
          SA6    A1
          EQ     LOCX        RETURN
 
 LOC2     RJ     SNC         SET NEXT CHARACTER
          RJ     ASN         ASSEMBLE NAME
          SA1    =4RCALL
          BX2    X1-X6
          ZR     X2,LOC2.1   IF CALL FOUND
          SA1    =5RCALLC
          BX2    X1-X6       CHECK CALLC
          ZR     X2,LOC2.1   IF *CALLC
          SA1    =6RIFCALL
          BX2    X1-X6       CHECK IFCALL
          ZR     X2,LOC2.0   IF *IFCALL
          SA1    =7RNIFCALL
          BX2    X1-X6       CHECK IFCALL
          NZ     X2,LOC4     IF NOT *IFCALL
 LOC2.0   RJ     SNC         SET NEXT CHARACTER
          RJ     ASN         ASSEMBLE NAME
 LOC2.1   SA1    CALL        COUNT *CALL, *CALLC, *IF/NIFCALL
          SX6    B1
          IX6    X6+X1
          SA6    A1
          RJ     SNC         SET NEXT CHARACTER
          SX2    X6-1R
          NG     X2,LOC3     IF NEXT " SEPARATOR
          RJ     SNC         SET NEXT CHARACTER
 LOC3     RJ     ASN         ASSEMBLE NAME
          SX5    B0          ENTER COMMON DECK REFERENCE
          RJ     ESR         ENTER SPECIAL REFERENCE
          SX6    B0
          EQ     LOCX        RETURN
 OPC      SPACE  4,10
**        OPC - CHECK OP CODE.
*
*         ENTRY  (CP) = CHARACTER POINTER,
*                (X0) = SEPARATOR MASK.
*
*         EXIT   (X1) = 0 IF ADDRESS FIELD TO BE PROCESSED.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*                B - 2.
*
*         CALLS  ASN.
 
 
 OPC4     SA6    RF
          SX1    B1
 
 OPC      SUBR               ENTRY/EXIT
          RJ     ASN         ASSEMBLE NAME
          SA1    TOPC        CHECK OPCODE TABLE
          SB2    B1+B1
 OPC1     ZR     X1,OPCX     IF END OF TABLE - RETURN
          BX2    X6-X1
          SA1    A1+B2
          NZ     X2,OPC1     LOOP IF NO MATCH FOUND
          SA2    A1-B1       EXIT TO PROCESSOR
          SB2    X2
          JP     B2          GO TO PROCESSOR
 
 OPC2     SX6    1
          EQ     OPC4        SET REFERENCE FLAG
 
 OPC3     SX6    0           CLEAR REFERENCE FLAG
          SA6    PP          CLEAR PP CODE
          EQ     OPC4        SET REFERENCE FLAG
 TOPC     SPACE  4,10
**        TOPC - TABLE OF OPCODES.
*
*         ALL THOSE WITHOUT A SECOND ARGUMENT WILL NOT HAVE THE
*         ADDRESS FIELD EVALUATED.
 
 
 TOPC     BSS    0
          OPC    IDENT
          OPC    SST,OPC2
          OPC    END,OPC3
          OPC    TITLE
          OPC    EJECT
          OPC    SPACE
          OPC    PERIPH,PERIPH
          OPC    EXECUTE,EXECUTE
          OPC    SYSTEM,SYSTEM
          OPC    ABS
          OPC    STEXT
          OPC    BASE
          OPC    LIST
          OPC    ENDM
          OPC    ENDIF
          OPC    ENDD
          OPC    ENTRY,ENTRY
          OPC    DIS
          OPC    MICRO
          OPC    IFC
          OPC    XTEXT
          OPC    NOLABEL
          OPC    LIT
          OPC    ERR
          OPC    DATA
          OPC    STEXT
          OPC    COMMENT
          OPC    MACRO
          OPC    OPDEF
          OPC    USE
          DATA   0
          TITLE  DECK SCANNING.
 ENTRY    SPACE  4,10
**        ENTRY - PROCESS ENTRY FOR SPECIAL ENTRY POINTS.
*
*         ENTRY  (CP) = CHARACTER POINTER.
*
*         EXIT   (X1) = 0, IF ADDRESS FIELD TO BE PROCESSED.
*
*         USES   X - 1, 5.
*                A - 1.
*
*         CALLS  ASN, ESR, SNC.
 
 
 ENTRY    BSS    0           ENTRY
          SA1    PP
          NZ     X1,OPCX     IF PP CODE
          RJ     SNC         SET NEXT CHARACTER
          RJ     ASN         ASSEMBLE NAME
          SA1    ETRA-1      CHECK FOR SPECIAL ENTRY POINTS
 ETR1     SA1    A1+B1
          ZR     X1,OPCX     IF END OF TABLE - SET NOT INTERESTING
          BX1    X6-X1
          NZ     X1,ETR1     IF NO MATCH
          SX5    B1+B1
          RJ     ESR         ENTER SPECIAL REFERENCE
          SX1    B1
          EQ     OPCX        RETURN
 
*         TABLE OF SPECIAL ENTRY POINTS.
 
 ETRA     BSS    0
          CON    4RARG=      SUPPRESS ARGUMENT CRACKING
          CON    4RCLB=      COMMAND LINE BUFFER FET
          CON    4RDMP=      DUMP CONTROL
          CON    4RDPA=      *DMP=* PROGRAM WITH ARGUMENTS
          CON    4RLDR=      ALLOW EXECUTE-ONLY READ (LOADER)
          CON    4RLIB=      ALLOW EXECUTE-ONLY READ (OTHER)
          CON    4RMFL=      SET MINIMUM FIELD LENGTH
          CON    4RNPC=      NOS PARAMETER CRACKING FORMAT FLAG
          CON    4RRFL=      SET FIELD LENGTH
          CON    4RSDM=      SUPPRESS DAYFILE MESSAGE
          CON    4RSSJ=      SPECIAL SYSTEM JOB
          CON    4RSSM=      SECURE SYSTEM MEMORY
          CON    4RUTL=      PF UTILITY
          CON    4RVAL=      VALIDATION JOB
          CON    0
 EXECUTE  SPACE  4,10
**        EXECUTE - PROCESS EXECUTE MACRO.
*
*         ENTRY  (CP) = CHARACTER POINTER.
*
*         EXIT   (X1) = 0, IF ADDRESS FIELD TO BE PROCESSED.
*
*         USES   X - 1.
*                A - 1.
*
*         CALLS  ASN, ESR, SNC.
 
 
 EXECUTE  BSS    0           ENTRY
          SA1    PP
          ZR     X1,OPC      IF NOT PP CODE
          RJ     SNC         ASSEMBLE CALLED PACKAGE
          RJ     ASN         ASSEMBLE NAME
          SX5    B1          ENTER PP CALL
          RJ     ESR
          SX1    B1          ADDRESS FIELD NOT TO BE PROCESSED
          EQ     OPCX        EXIT
 PERIPH   SPACE  4,10
**        PERIPH - PROCESS PERIPH.
*
*         ENTRY  (CP) = CHARACTER POINTER.
*
*         EXIT   (X1) = 0, IF ADDRESS FIELD TO BE PROCESSED.
*
*         USES   X - 1, 5.
*                A - 1.
*
*         CALLS  ASN, ESR, SNC.
 
 
 PERIPH   BSS    0           ENTRY
          SX6    B1          SET PP FLAG
          SA6    PP
          SX5    B1
          RJ     ENT         ENTER PP NAME
          EQ     OPCX        EXIT
 SYSTEM   SPACE  4,10
**        SYSTEM - PROCESS SYSTEM.
*
*         ENTRY  (CP) = CHARACTER POINTER.
*
*         EXIT   (X1) = 0, IF ADDRESS FIELD TO BE PROCESSED.
*
*         USES   X - 1, 5.
*                A - 1.
*
*         CALLS  ASN, ESR, SNC.
 
 
 SYSTEM   BSS    0           ENTRY
          SA1    PP
          NZ     X1,OPCX     IF PP CODE
          RJ     SNC         SET NEXT CHARACTER
          RJ     ASN         ASSEMBLE NAME
          MX5    42          ONLY ENTER 3 CHARACTER NAME
          BX5    X5*X6
          NZ     X5,SYS1     IF MORE THAN 3 CHARACTERS IN NAME
          SX5    3
          RJ     ESR         ENTER SPECIAL REFERENCE
          SX1    B1          SET INTERESTING FLAG
          EQ     OPCX        RETURN
 
 SYS1     SX1    B0+         SET NOT INTERESTING FLAG
          EQ     OPCX        RETURN
 SCA      SPACE  4,10
**        SCA - SCAN ADDRESS.
*
*         ENTRY  (X0) = SEPARATOR MASK.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6.
*                B - 2, 3, 4.
*
*         CALLS  ADW, ASN, SNC.
*
*         MACRO  ADDWRD.
 
 
 SCA      SUBR               ENTRY/EXIT
 SCA1     RJ     SNC         SET NEXT CHARACTER
 SCA2     SB2    X6-1R
          ZR     B2,SCAX     IF END OF FIELD - RETURN
          SB3    X6
          LX7    X0,B3
          NG     X7,SCA1     SKIP SEPARATOR
          SB2    X6-1R0
          NG     B2,SCA4     IF ALPHA
          SB3    X6-1R+
          NG     B3,SCA3     IF NUMERIC
          SB2    X6-1R$
          ZR     B2,SCA      IF *$* - RETURN
          EQ     B2,B1,SCAX  IF *$*  - RETURN
          EQ     SCA4        OTHER THAN *$*
 
 SCA3     RJ     SNC         NEXT CHARACTER
          SB3    X6
          LX7    X0,B3
          PL     X7,SCA3     IF END OF ELEMENT
          EQ     SCA2        PROCESS CHARACTER
 
 SCA4     RJ     ASN         ASSEMBLE NAME
          SA1    SL
          SA2    F.TNME
          SB2    B1+B1
          SB3    X1
          SA1    X2
          SB4    X2
 SCA5     BX7    X1-X6
          SB3    B3-B2
          ZR     X7,SCA6     IF FOUND
          SA1    A1+B2
          NZ     B3,SCA5     LOOP TO END OF TABLE
          SA1    CH
          BX6    X1
          EQ     SCA2        PROCESS CHARACTER
 
 SCA6     MX4    1           SET REFERENCE FLAG
          SA2    DN
          BX6    X1+X4
          SX3    A1-B4
          SA6    A1
          ADDWRD TREF,X2+X3  ENTER REFERENCE
          SA1    CH
          BX6    X1
          EQ     SCA2        PROCESS CHARACTER
          TITLE  LIST PROCESSORS.
 LCL      SPACE  4,10
**        LCL - LIST SPECIAL CALLS.
*
*         USES   X - ALL.
*                A - ALL.
*
*         CALLS  LRC, SFN, SSR.
 
 
 LCL      SUBR               ENTRY/EXIT
          SA1    TX
          NZ     X1,LCL0     IF SYSTEXT PRESENT
          MX6    0           ZERO TITLES
          SA6    LCLD
          SA6    A6+B1
 LCL0     SA1    =1H
          SA1    =1H
          SX6    LCLA        SET SUBTITLE
          BX7    X1
          SA6    ST+1
          SA7    BUF+1
          RJ     SSR         SORT SPECIAL REFERENCES
 LCL1     SA1    LCLC        ADVANCE POINTER
          SX6    X1+2
          SA2    X6
          SA6    A1
          ZR     X2,LCLX     IF END OF TABLE - RETURN
          SA4    A2+B1       TYPE CODE
          SX6    X2          SET SUBTITLE
          SX7    LCFE        FORCE EJECT
          SA6    ST
          SA7    LC
          SA1    F.TNME      (X1) = FWA
          SA2    SL          (X2) = LENGTH
          IX1    X1+X2
          SA3    L.TNME
          IX2    X3-X2
 LCL2     ZR     X2,LCL1     IF END OF REFERENCE TABLE
          SA3    X1+B1       NEXT ENTRY
          BX6    X3-X4
          ZR     X6,LCL4     IF REQUESTED TYPE
 LCL3     SX1    X1+2        ADVANCE TABLE
          SX2    X2-2
          EQ     LCL2        LOOP
 
 LCL4     SX6    X1          SAVE POSITION
          SX7    X2
          SA6    T1
          SA7    A6+B1
          MX0    42          SPACE FILL NAME
          SA5    A3-B1
          BX1    X0*X5
          RJ     SFN         SPACE FILL NAME
          LX6    -3*6
          SA6    BUF
          RJ     LRC         LIST REFERENCE CHAIN
          SA1    T1          RESET POSITION
          SA2    A1+B1
          SA3    LCLC        RESET TYPE
          SA4    X3+B1
          EQ     LCL3        LOOP
 
 LCLA     DATA   10H   DECK
          DATA   10H
          DATA   C*DECK REFERENCES.*
 
 LCLB     BSS    0
          CON    =C*   COMMON DECK CALLS.*
          CON    0
 
 LCLD     BSS    0
          CON    =C*   PP PACKAGES CALLED.*
          CON    1
 
          CON    =C*   SPECIAL ENTRY POINTS.*
          CON    2
 
          CON    =C*   SYSTEM MACRO REQUEST REFERENCES.*
          CON    3
 
          CON    0
 
 LCLC     CON    LCLB-2
 LNK      SPACE  4,10
**        LNK - LINK TABLES.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 3, 4.
 
 
 LNK      SUBR               ENTRY/EXIT
          SA1    L.TNME      LEFT JUSTIFY NAMES
          SA2    F.TNME
          MX0    6
          SB2    B1+B1
          SB3    X1
          SA1    X2
 LNK1     LX1    6
          BX2    X0*X1
          ZR     X2,LNK1     IF CHARACTER NOT LEFT JUSTIFIED
          BX6    X1
          SA6    A1
          SB3    B3-B2
          SA1    A1+B2
          NZ     B3,LNK1     IF NOT THE LAST NAME
          SA1    L.TREF      LINK REFERENCES
          SA2    F.TREF
          MX0    42
          SB2    X1
          SA3    F.TNME
          SB2    B2-B1
          SA2    X2+B2
          SB4    X3
          BX5    X0*X2
 LNK2     SA1    B4+X2
          SX3    A2
          BX4    X0*X1
          SB2    B2-B1
          SA2    A2-B1
          BX7    -X0*X1
          IX6    X4+X3
          BX7    X5+X7
          SA6    A1
          SA7    A2+B1
          BX5    X0*X2
          PL     B2,LNK2     IF MORE REFERENCES
          EQ     LNKX        RETURN
 LRC      SPACE  4,10
**        LRC - LIST REFERENCE CHAIN.
*
*         ENTRY  (X5) = FIRST CHAIN ENTRY.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 6.
*
*         CALLS  SFN, WOF.
 
 
 LRC6     MX6    0
          SA6    A6+B1
          SX1    BUF
          RJ     WOF         WRITE LINE TO OUTPUT
 
 LRC      SUBR               ENTRY/EXIT
          SA1    LC          CHECK LINE COUNT
          SA2    LL          GET LINE LIMIT
          SX6    X1+B1
          IX2    X6-X2
          PL     X2,LRC2     IF NOT ROOM FOR FIRST LINE
          SA3    BUF+1       COMPARE CURRENT VALUE WITH LAST
          SA2    =10H
          BX7    X2-X3
          ZR     X7,LRC1     IF NO VALUE
          SA2    LRCB
          BX7    X3
          SA7    A2
          BX2    X3-X2
          BX6    X1          RESTORE *LC*
          ZR     X2,LRC2     IF NO VALUE CHANGE
 LRC1     SX1    =C*  *
          RJ     WOF         WRITE LINE TO OUTPUT
          SA1    LC
          BX6    X1
 LRC2     SA6    A1
          SX5    X5
          NZ     X5,LRC3     IF ANY REFERENCES
          SA1    =10H **NONE**
          MX6    0
          BX7    X1
          SA7    BUF+2
          SA6    A7+B1
          SX1    BUF
          RJ     WOF         WRITE LINE TO OUTPUT
          EQ     LRCX        RETURN
 
 LRC3     SA1    BUF         SAVE FIRST 2 WORDS OF BUFFER
          SA2    A1+B1
          BX6    X1
          LX7    X2
          MX0    42
          SA6    LRCA
          SA7    A6+B1
 LRC4     SB6    -11
          ZR     X5,LRCX     IF END OF LIST - RETURN
 LRC5     ZR     X5,LRC6     IF END OF LIST
          SA2    X5          NEXT ENTRY
          BX1    X0*X2       SPACE FILL NAME
          SX5    X2          SET NEXT ADDRESS
          RJ     SFN         SPACE FILL NAME
          LX6    60-6
          SA6    BUF+13+B6
          SB6    B6+B1
          NG     B6,LRC5     IF NOT END OF LINE
          MX6    0
          SA6    A6+B1
          SX1    BUF
          RJ     WOF         WRITE LINE TO OUTPUT
          SA1    =1H         CLEAR BUFFER
          BX6    X1
          LX7    X1
          SA6    BUF
          SA7    A6+B1
          EQ     LRC4        LOOP
 
 LRCA     DATA   0,0
 LRCB     DATA   0           LAST VALUE
 LSR      SPACE  4,10
**        LSR - LIST SYSTEM SYMBOL REFERENCES.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  COD, LRC, SFN, WOF.
 
 
 LSR      SUBR               ENTRY/EXIT
          SX3    B1+         SET NOT END OF REFERENCES
 LSR1     SA1    LSRC        ADVANCE SYMBOL CHECK
          SX6    X1+3
          SA2    X6          SUBTITLE LINE ADDRESS
          SA6    A1
          ZR     X3,LSRX     IF END OF SYMBOL LIST
          ZR     X2,LSR2     IF NO SUBTITLE
          SX7    X2          SET SUBTITLE
          SX6    LCFE        FORCE EJECT
          SA7    ST
          SA6    LC
          EQ     LSR3        SKIP LINE CHECK
 
 LSR2     SA1    LC          CHECK LINE COUNT
          SA3    LL          GET LINE LIMIT
          SX1    X1+2
          IX7    X1-X3
          PL     X7,LSR3     IF NO ROOM FOR LINE
          SX1    =C*  *      LIST BLANK LINE
          RJ     WOF         WRITE LINE TO OUTPUT
 LSR3     SA1    LSRC        SET MASK
          SA3    X1+B1       MASK
          SA4    A3+B1       CHARACTER MATCH
          SA1    F.TNME      (X1) = FWA
          SA2    SL          (X2) = LENGTH
 LSR4     SA5    X1          NEXT ENTRY
          BX6    X5*X3
          IX7    X6-X4
          ZR     X7,LSR6     IF MATCH FOUND
          SX1    X1+2        ADVANCE TABLE
 LSR5     SX2    X2-2
          NZ     X2,LSR4     IF NOT END OF TABLE
          EQ     LSR1        PROCESS NEXT SYMBOL TYPE
 
 LSR6     SX6    X1          SAVE POSITION
          SX7    X2
          SA6    T1
          SA7    A6+B1
          MX0    42          SPACE FILL NAME
          BX1    X0*X5
          RJ     SFN
          LX6    -3*6
          SA6    BUF
          SA1    A5+B1       CONVERT VALUE
          RJ     COD
          LX6    3*6
          SA6    A6+B1
          MX7    -0          CLEAR ENTRY
          SA7    A5
          RJ     LRC         LIST REFERENCE CHAIN
          SA1    T1          ADVANCE SYMBOL CHAIN
          SA2    A1+B1
          SX1    X1+2
          SA3    LSRC        RESET MASK AND CHARACTER
          SA3    X3+B1
          SA4    A3+B1
          EQ     LSR5        LOOP TO NEXT REFERENCE
 
 LSRA     DATA   10H   SYMBOL
          DATA   10H  VALUE
          DATA   C*DECK REFERENCES.*
 
 LSRB     BSS    0
 
          CON    =C*   DIRECT LOCATIONS.*
          VFD    12/0,30/7777777777B,18/0
          CON    0
 
          CON    =C*   PP RESIDENT ENTRY POINTS.*
          VFD    18/0,24/77777777B,18/0
          CON    0
 
          CON    0
          VFD    6/77B,18/0,18/777777B,18/0
          VFD    6/1L.,54/0
 
          CON    0
          VFD    42/77777777777777B,18/0
          CON    0LPPFW
 
          CON    =C*   MONITOR FUNCTIONS.*
          VFD    18/0,6/77B,36/0
          VFD    18/0,6/1RM,36/0
 
          CON    =C*   MASS STORAGE TABLE WORDS.*
          VFD    12/0,18/777777B,30/0
          VFD    12/0,18/2LGL,30/0
 
          CON    0
          VFD    12/0,18/777777B,30/0
          VFD    12/0,18/2LLL,30/0
 
          CON    =C*   GLOBAL/LOCAL FNT WORDS, ORDINALS.*
          VFD    12/0,18/777777B,30/0
          VFD    12/0,18/2LTG,30/0
 
          CON    0
          VFD    12/0,18/777777B,30/0
          VFD    12/0,18/2LTL,30/0
 
          CON    0
          VFD    12/0,18/777777B,30/0
          VFD    12/0,18/2LFO,30/0
 
          CON    =C*   CENTRAL MEMORY POINTERS.*
          VFD    18/0,12/7777B,30/0
          VFD    18/0,6/1RP,36/0
 
          CON    =C*   CENTRAL MEMORY LOCATIONS.*
          VFD    18/0,12/7777B,30/0
          VFD    18/0,12/1LL,30/0
 
          CON    0
          VFD    18/0,12/7777B,30/0
          VFD    18/0,12/2RLL,30/0
 
          CON    =C*   CONTROL POINT AREA WORDS.*
          VFD    18/0,12/7777B,30/0
          VFD    18/0,12/1LW,30/0
 
          CON    0
          VFD    18/0,12/7777B,30/0
          VFD    18/0,12/2RWE,30/0
 
          CON    0
          VFD    18/0,12/7777B,30/0
          VFD    18/0,12/2RWL,30/0
 
          CON    =C*   EJT, EST, QFT RELATED.*
          VFD    18/0,12/7777B,30/0
          VFD    18/0,12/1LE,30/0
 
          CON    0
          VFD    18/0,12/7777B,30/0
          VFD    18/0,12/1LQ,30/0
 
          CON    =C*   NFL SYMBOLS, AND DAYFILE MESSAGE OPTIONS.*
          VFD    18/0,6/77B,36/0
          VFD    18/0,6/1RN,36/0
 
          CON    =C*   FILE TYPES, AND MASS STORAGE CONSTANTS.*
          VFD    12/0,12/7777B,36/0
          VFD    12/0,12/2RFT,36/0
 
          CON    0
          VFD    12/0,12/7777B,36/0
          VFD    12/0,12/2RMS,36/0
 
          CON    0
          VFD    12/0,18/777777B,30/0
          VFD    12/0,18/2LSF,30/0
 
          CON    0
          VFD    12/0,12/7777B,36/0
          VFD    12/0,12/2RSS,36/0
 
          CON    0
          VFD    12/0,12/7777B,36/0
          VFD    12/0,12/2RTS,36/0
 
          CON    =C*   ORIGIN TYPES AND QUEUE TYPES.*
          VFD    12/0,12/7777B,36/0
          VFD    12/0,12/2ROT,36/0
 
          CON    0
          VFD    12/0,12/7777B,36/0
          VFD    12/0,12/2RQT,36/0
 
          CON    =C*   ERROR FLAGS.*
          VFD    12/0,12/7777B,36/0
          VFD    12/0,12/2RET,36/0
 
          CON    =C*   MISCELLANEOUS.*
          VFD    36/0,6/77B,18/0
          CON    0
 
          CON    0,0
 
 LSRC     CON    LSRB-3
          TITLE  SUBROUTINES.
 ABT      SPACE  4,10
**        ABT - ABORT JOB.
*
*         ENTRY  (A0) = FWA OF MESSAGE.
*
*         MACROS ABORT, MESSAGE.
 
 
 ABT      MESSAGE A0,,R      OUTPUT MESSAGE
          ABORT
 ADW      SPACE  4,10
**        ADW - ADD ENTRY TO A TABLE.
*
*         ENTRY  (A0) = TABLE POINTER ADDRESS.
*                (X1) = ENTRY.
*
*         EXIT   (X6) = ENTRY.
*                (A6) = ADDRESS OF ENTRY.
*                (X3) = INDEX OF ENTRY.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2.
*
*         CALLS  ATS.
*
*         MACROS ALLOC.
 
 
 ADW1     BX6    X1          ENTER WORD
          SX7    X3+B1       ADVANCE LENGTH
          SA6    X2+B2
          SA7    A3
 
 ADW      SUBR               ENTRY/EXIT
          SA2    FTAB+A0     CHECK TABLE ROOM
          SA3    LTAB+A0
          SA4    A2+B1
          IX6    X2+X3
          SB2    X3
          IX7    X4-X6
          NZ     X7,ADW1     IF ROOM FOR WORD
          SA2    NTAB+A0     ALLOCATE TABLE
          BX6    X1          SAVE WORD
          SA6    ADWA
          ALLOC  A0,X2
          SA4    NTAB+A0     RESET LAST LENGTH
          SA1    ADWA        RESTORE WORD
          IX3    X3-X4
          SB2    X3
          EQ     ADW1        ENTER WORD
 
 ADWA     DATA   0
 ASN      SPACE  4,10
**        ASN - ASSEMBLE NAME.
*
*         ENTRY  (CP) = CHARACTER POINTER.
*                (X0) = SEPARATOR MASK.
*
*         EXIT   (X6) = NAME RIGHT JUSTIFIED, ZERO FILLED.
*                (X6) = 0 IF FIRST CHARACTER = * *, OR MORE THAN
*                            7 CHARACTERS ASSEMBLED.
*
*         USES   X - 1, 2, 5, 6.
*                A - 1.
*                B - 2.
*
*         CALLS  SNC.
 
 
 ASN      SUBR               ENTRY/EXIT
          SA1    CH          FIRST CHARACTER
          SB2    X1
          LX6    X0,B2
          MI     X6,ASNX     IF SEPARATOR - RETURN
          SX5    B0          CLEAR ASSEMBLY
          BX6    X1
 ASN1     LX5    6           SHIFT ASSEMBLY
          BX5    X6+X5       MERGE NEW CHARACTER
          RJ     SNC         SET NEXT CHARACTER
          SB2    X6
          LX2    X0,B2
          PL     X2,ASN1     IF NOT A SEPARATOR
          BX6    X5
          EQ     ASNX        RETURN
 ATS      SPACE  4,10
**        ATS - ALLOCATE TABLE SPACE.
*
*         ENTRY  (A0) = TABLE NUMBER.
*                (X1) = NUMBER OF WORDS.
*
*         EXIT   (X2) = TABLE FWA.
*                (X3) = TABLE LENGTH.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3.
*
*         CALLS  TOV.
 
 
 ATS5     SA2    FTAB+A0     SET RESPONSE
          SA3    LTAB+A0
 
 ATS      SUBR               ENTRY/EXIT
          SA2    FTAB+A0     CHECK TABLE SPACE
          SA3    LTAB+A0
          IX7    X3+X1       ADVANCE LENGTH
          SA4    A2+B1
          IX6    X2+X7
          SA7    A3
          IX4    X4-X6
          NG     X4,ATS1     IF NO ROOM FOR CHANGE
          BX3    X7
          EQ     ATSX        RETURN
 
*         CHECK AVAILABLE STORAGE.
 
 ATS1     SA2    FTAB+FTABL  CHECK STORAGE
          SA3    FL
          IX6    X2+X1
          IX7    X3-X6
          NG     X7,ATS4     IF NO ROOM FOR INCREASE
          SA6    A2          UPDATE LWA+1 OF ALL TABLES
          SB2    A0+B1
          SB3    FTABL
          BX4    X2
          EQ     B2,B3,ATS5  IF LAST TABLE - RETURN
 
*         MOVE HIGHER TABLE UP.
 
 ATS2     SA2    A2-B1       ADVANCE FWA OF HIGHER TABLES
          IX6    X2+X1
          SA6    A2
          SB2    B2+B1
          NE     B2,B3,ATS2
          IX3    X4-X2       (B2) = WORD COUNT
          SB3    X1          (B3) = MOVE INCREMENT
          ZR     X3,ATS5     IF NO MOVE NEEDED
          SB2    X3
          SA1    X4-1        BEGIN AT LWA
 ATS3     BX6    X1          MOVE TABLE UP
          SA6    A1+B3
          SB2    B2-B1
          SA1    A1-B1
          NZ     B2,ATS3     IF END OF MOVE
          EQ     ATS5        RETURN
 
*         TABLE OVERFLOW.
 
 ATS4     SX6    A0          SAVE (A0)
          SA6    ATSA
          BX6    X1          SAVE (X1)
          SA6    ATSA+1
          RJ     TOV         PROCESS TABLE OVERFLOW
          SA1    ATSA        RESTORE (A0)
          SA0    X1
          SA1    A1+B1       RESTORE (X1)
          EQ     ATS1        RE-COMPUTE WITH NEW MEMORY
 
 
 ATSA     BSSZ   2           (A0) AND (X1) STORAGE
 ENT      SPACE  4,10
**        ENT - ENTER NAME TABLE.
*
*         ENTRY  (X5) = REFERENCE TYPE.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2.
*                B - 2, 3.
*
*         CALLS  ADW.
*
*         MACROS ADDWRD.
 
 
 ENT      SUBR               ENTRY/EXIT
          SA1    DN          RIGHT JUSTIFY DECK NAME
          MX2    -6
          BX6    X1
 ENT1     LX6    -6
          BX7    -X2*X6
          ZR     X7,ENT1     IF NOT A CHARACTER
          SA1    L.TNME
          SA2    F.TNME
          SB2    B1+B1
          SB3    X1
          SA1    X2
          MX2    1
          ZR     B3,ENT3     IF EMPTY TABLE
 ENT2     BX3    -X2*X1      SCAN NAME TABLE
          IX7    X3-X6
          SB3    B3-B2
          ZR     X7,ENTX     IF FOUND - RETURN
          SA1    A1+B2
          NZ     B3,ENT2     IF NOT THE END OF THE TABLE
 ENT3     ADDWRD TNME,X6
          ADDWRD A0,X5
          EQ     ENTX        RETURN
 ESR      SPACE  4,10
**        ESR - ENTER SPECIAL REFERENCE.
*
*         ENTRY  (X5) = REFERENCE TYPE.
*                (X6) = NAME RIGHT JUSTIFIED.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 6.
*                B - 2, 3, 4.
*
*         CALLS  ADW.
*
*         MACROS ADDWRD.
 
 
 ESR      SUBR               ENTRY/EXIT
          MX1    6*3         TRUNCATE NAME TO 7 CHARACTERS
          BX6    -X1*X6
          SA1    L.TNME
          SA2    F.TNME
          SB2    B1+B1
          SB3    X1
          SA1    X2
          SB4    X2
          MX2    1
          ZR     B3,ESR1.1   IF EMPTY TABLE
 ESR1     BX3    -X2*X1      SCAN NAME TABLE
          IX7    X3-X6
          SB3    B3-B2
          ZR     X7,ESR2     IF FOUND
          SA1    A1+B2
          NZ     B3,ESR1     IF THE END OF THE TABLE
 ESR1.1   ADDWRD TNME,X6
          ADDWRD A0,X5
          SA1    A6-B1
          MX2    1
 ESR2     MI     X1,ESRX     IF SYMBOL REFERENCED - EXIT
          BX6    X1+X2       INDICATE REFERENCE
          SA6    A1
          SX3    A1-B4
          SA2    DN
          ADDWRD TREF,X2+X3  ENTER REFERENCE
          EQ     ESRX        RETURN
 PLE      SPACE  4,10
**        PLE - PROCESS LIBRARY ERROR.
*
*         ISSUE DAYFILE MESSAGE *PL ERROR IN DECK*.
*         ABORT JOB.
*
*         USES   X - 1, 6.
*                A - 0, 1, 6.
*
*         CALLS  ABT.
 
 
 PLE      SA1    DN          SET DECK NAME IN MESSAGE
          BX6    X1
          SA6    PLEB
          SA0    PLEA
          EQ     ABT         ABORT JOB
 
 PLEA     DATA   20H PL ERROR IN DECK
 PLEB     DATA   0
 PLS      SPACE  4,20
**        PLS - ISSUE PROGRAM LIBRARY STATISTICS MESSAGES.
*
*         ENTRY  (BLANK) = ACTIVE BLANK STATEMENTS.
*                (CALL) = ACTIVE *CALL STATEMENTS.
*                (CODE) = ACTIVE NON-COMMENT, NON-BLANK STATEMENTS.
*                (COMNT) = ACTIVE * TYPE COMMENT STATEMENTS.
*                (INACT) = INACTIVE STATEMENTS.
*
*         EXIT   ALL DAYFILE MESSAGES ISSUED.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6.
*
*         CALLS  CDD, WOF.
 
 
 PLS      SUBR               ENTRY/EXIT
          SA1    BLANK       CONVERT NUMBER OF BLANK STATEMENTS
          RJ     CDD
          SA6    PLSB+1
          SA1    CALL        CONVERT NUMBER OF *CALL STATEMENTS
          RJ     CDD
          SA6    PLSC+1
          SA1    CODE        CONVERT NUMBER OF LINES OF CODE
          RJ     CDD
          SA6    PLSD+1
          SA1    COMNT       CONVERT NUMBER OF COMMENT STATEMENTS
          RJ     CDD
          SA6    PLSE+1
          SA1    INACT       CONVERT NUMBER OF INACTIVE STATEMENTS
          RJ     CDD
          SA6    PLSF+1
          SA1    BLANK       COMPUTE TOTAL NUMBER OF ACTIVE STATEMENTS
          SA2    CALL
          SA3    CODE
          SA4    COMNT
          IX5    X1+X2
          IX7    X3+X4
          IX1    X5+X7
          RJ     CDD         CONVERT TOTAL ACTIVE STATEMENTS
          SA6    PLSG+1
          SX7    LCFE        FORCE EJECT
          SX6    PLSA        SET SUBTITLE LINE
          SA7    LC
          SA6    ST
          SX7    =C*  *      SET SUB-SUB TITLE LINE
          SX1    PLSB        BLANK STATEMENTS
          SA7    A6+1
          RJ     WOF         WRITE OUTPUT FILE
          SX1    PLSC        *CALL STATEMENTS
          RJ     WOF         WRITE OUTPUT FILE
          SX1    PLSD        LINES OF CODE
          RJ     WOF         WRITE OUTPUT FILE
          SX1    PLSE        * TYPE COMMENTS
          RJ     WOF         WRITE OUTPUT FILE
          SX1    PLSF        INACTIVE STATEMENTS
          RJ     WOF         WRITE OUTPUT FILE
          SX1    PLSG        ACTIVE STATEMENTS
          RJ     WOF         WRITE OUTPUT FILE
          EQ     PLSX        RETURN
 
 PLSA     DATA   C/   PROGRAM LIBRARY STATISTICS./
 PLSB     DATA   10H0
          DATA   C/           BLANK STATEMENTS./
 PLSC     DATA   10H0
          DATA   C/           *CALL STATEMENTS./
 PLSD     DATA   10H0
          DATA   C/           LINES OF CODE./
 PLSE     DATA   10H0
          DATA   C/           * TYPE COMMENT STATEMENTS./
 PLSF     DATA   10H0
          DATA   C/           TOTAL INACTIVE STATEMENTS./
 PLSG     DATA   10H0
          DATA   C/           TOTAL ACTIVE STATEMENTS./
 RMT      SPACE  4,10
**        RMT - READ MODIFIER TABLE.
*
*         ENTRY  (DN) = DECK NAME.
*                (MA) = MODIFICATION TABLE ADDRESS.
*
*         EXIT   (X0) = TERMINATOR CHARACTOR MASK.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6.
*                B - 2, 3.
*
*         CALLS  ENT.
*
*         MACROS MESSAGE, READ, READW.
 
 
 RMT      SUBR               ENTRY/EXIT
          SA1    L.TNME      CLEAR REFERENCE INDICATORS
          SA2    F.TNME
          MX4    1
          SB3    X1
          SA1    X2
          SB2    B1+B1
          ZR     B3,RMT2     IF EMPTY TABLE
 RMT1     BX6    -X4*X1
          SA6    A1
          SB3    B3-B2
          SA1    A1+B2
          NZ     B3,RMT1     IF MORE REFERENCES
 RMT2     READ   P
          READW  P,BUF,17B   READ IDENT TABLE
          MI     X1,RMTX     IF EOF - RETURN
          SA1    BUF
          LX1    12
          SB2    X1-7700B
          NZ     B2,RMT7     IF NO IDENT TABLE
          SA1    BUF+1       SET DECK NAME
          BX6    X1
          SA6    DN
          SA6    RMTA+1
          READW  P,T1,1      READ MODIFIER TABLE LENGTH
          NZ     X1,PLE      IF EOR
          SA1    T1          CHECK TABLE
          LX1    18
          SX6    B0
          SB2    X1-700100B
          SB3    X1-700200B
          NZ     B2,RMT3     IF NOT NORMAL DECK
          SA3    =0LCMDFILE  CHECK FOR *CMDFILE* - *HELP* TEXT
          BX7    X3-X2
          ZR     X7,RMT7     IF *CMDFILE* SKIP ENTIRE DECK
          EQ     RMT4        PROCESS NORMAL DECK
 
*         CHECK FOR A COMMON DECK.
 
 RMT3     NZ     B3,RMT7     IF NOT A COMMON DECK
          SX5    B0          ENTER NAME TABLE
          RJ     ENT
          SA1    T1
          LX1    18
          SX6    B1          SET REFERENCE FLAG
          MX4    4*6
          SA6    RF
          SA6    PP          SET PP
          SA2    DN          GET DECK NAME
          SA3    =0LCOMP
          BX2    X4*X2
          IX7    X2-X3
          ZR     X7,RMT4     IF -COMPXXX-
          SA3    =0LCOMD
          IX7    X2-X3
          SX6    B0
          ZR     X7,RMT4     IF -COMDXXX-
          SA6    PP
 RMT4     LX1    60-18
          SX5    X1
          ZR     X5,RMT6     IF NO MODIFIERS
 RMT5     READW  P,T1,1      READ OUT MODIFIERS
          SX5    X5-1
          NZ     X5,RMT5     IF NOT THE LAST WORD
 RMT6     MESSAGE RMTA,1
          SA2    =36060020B  MASK FOR BL , + - * /
          SX1    B0          RETURN WITH NO EOR
          BX0    X2
          EQ     RMTX        RETURN
 
 RMT7     READW  P,BUF,BUFL  READ TO EOR
          ZR     X1,RMT7     IF NOT AN EOR
          EQ     RMT2        BEGIN NEXT RECORD
 
 RMTA     DATA   10H SCANNING
          DATA   0
 RPF      SPACE  4,10
**        RPF - READ CARD FROM PROGRAM LIBRARY.
*
*         ENTRY  (A0) = ADDRESS OF BUFFER.
*
*         EXIT   (X1) .NE. 0 IF EOR READ.
*                (CDTX) = TEXT OF COMPRESSED CARD.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*
*         MACROS READC.
 
 
 RPF      SUBR               ENTRY/EXIT
 RPF1     READC  P,BUF,BUFL  READ CARD HISTORY
          NZ     X1,RPF      IF EOR - RETURN
          READC  P,CDTX,MXCCL  READ COMPRESSED CARD
          NZ     X1,RPF      IF EOR - RETURN
          EQ     B6,B7,PLE   IF OVERFLOW
          SA1    BUF
          MI     X1,RPF2     IF CARD ACTIVE
          SA1    INACT       COUNT INACTIVE CARD
          SX6    B1
          IX6    X6+X1
          SA6    A1
          EQ     RPF1        LOOP FOR NEXT CARD
 
 RPF2     BX1    X1-X1       SET NOT EOR FLAG
          EQ     RPFX        RETURN
 SNC      SPACE  4,10
**        SNC - SET NEXT CHARACTER.
*
*         ENTRY  (CP) = CHARACTER POINTER.
*
*         EXIT   (X6) = (CH) = CHARACTER.
*                (CP) UPDATED.
*                CHARACTER = * * IF END OF CARD REACHED.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2, 3, 4, 5.
 
 
 SNC3     SX4    X1+         SET POSITION
          MI     B4,SNC4     IF NOT SPACE COUNT
          SX6    1R          SUPPLY * *
          EQ     SNC6        SPACE FILL
 
 SNC4     SX7    X6-1R       CHECK FOR CURRENT CHARACTER BLANK
          ZR     X7,SNC4.1   IF BLANK
          SX7    X6-76B      CHECK ESCAPE CODE
          NZ     X7,SNC6     IF NOT ESCAPE CODE
 SNC4.1   SB5    B2+6
          NE     B5,B3,SNC5  IF NOT AT END OF WORD
          SB5    6           RESET POSITION
          SX4    X4+B1       ADVANCE TO NEXT WORD
          SA2    A2+B1       GET NEXT WORD OF CARD
 SNC5     LX7    X2,B5       POSITION CHARACTER
          BX7    -X3*X7      CHECK FOR SECOND CONSECUTIVE BLANK
          SX2    X7-1R
          ZR     X2,SNC5.1   IF BLANK
          ZR     X7,SNC6     IF *00* FOLLOWS 76B
          SX2    X6-76B
          NZ     X2,SNC6     IF NOT CONVERTING TO UPPER CASE
          SX2    X7-33B
          PL     X2,SNC6     IF NOT LOWER CASE ALPHABETIC CHARACTER
          BX6    X7
 SNC5.1   SB2    B5
          SX1    X4
 SNC6     PX7    X1,B2       PACK POSITION
          SA6    CH          SET CHARACTER
          SA7    A1
 
 SNC      SUBR               ENTRY/EXIT
          SA1    CP          UNPACK POINTER
          SA2    X1+CDTX     LOAD WORD FROM CARD
          MX3    54
          SB3    66
          UX1,B2 X1
          SB4    -B1
          SX4    1R          PRESET * *
 SNC1     SB2    B2+6        ADVANCE CHARACTER INDEX
          NE     B2,B3,SNC2  IF NOT LAST CHARACTER OF WORD
          SB2    6           RESET CHARACTER
          SX1    X1+B1       ADVANCE WORD
          SA2    A2+B1
 SNC2     LX7    X2,B2       SHIFT TO CHARACTER
          BX6    -X3*X7
          NZ     X6,SNC3     IF NOT 00 CHARACTER
          SB4    B4+B1
          NE     B4,B1,SNC1  IF NOT THE LAST SPACE
          BX6    X4
          SA6    CH
          EQ     SNCX        RETURN
 SSR      SPACE  4,10
**        SSR - SORT SPECIAL REFERENCES.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
 
 
 SSR      SUBR               ENTRY/EXIT
          SA1    F.TNME      (A0) = FWA - 2
          SA2    SL
          IX6    X1+X2
          SA3    L.TNME
          IX7    X3-X2
          SA0    X6-2
          SB7    X7          N = LENGTH
          SB6    B7          M = N
 SSR1     SX6    B6          M = M/2
          AX6    2
          LX6    1
          SB6    X6
          SB3    B1+B1       J = 1
          ZR     B6,SSRX     IF M = 0 - RETURN
          SB4    B7-B6       K = N-M
          SB2    B3
 SSR2     SB5    B2+B6       L = I+M
          SA1    A0+B2       A(I)
          SA2    A0+B5       A(L)
          IX6    X2-X1
          PL     X6,SSR3     IF A(L) .GE. A(I)
          SA3    A1+B1       INTERCHANGE A(L) AND A(I)
          SA4    A2+B1
          BX6    X1
          LX7    X2
          SA6    A2
          SA7    A1
          BX6    X3
          BX7    X4
          SA6    A4
          SA7    A3
          SB2    B2-B6       I = I-M
          GT     B2,SSR2     IF I .GT. 0
 SSR3     SB3    B3+2        J = J+1
          SB2    B3
          LE     B3,B4,SSR2  IF J .LE. K
          EQ     SSR1        LOOP
 TOV      SPACE  4,10
**        TOV - TABLE OVERFLOW PROCESSOR.
*
*         ENTRY  (FL) = CURRENT FIELD LENGTH.
*
*         EXIT   (FL) = NEW FIELD LENGTH.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         CALLS   ABT.
*
*         MACROS MEMORY.
 
 
 TOV      SUBR               ENTRY/EXIT
          SA1    FL          INCREMENT FIELD LENGTH
          SX6    X1+MINC
          SA6    A1
          LX6    30          POSITION FOR *MEM* CALL
          SA6    TOVA
          SA1    A6+B1       CHECK MEMORY LIMIT
          IX1    X1-X6
          NG     X1,TOV1     IF LIMIT REACHED.
          MEMORY CM,TOVA,R
          EQ     TOVX        RETURN
 
 
 TOV1     SA0    =C* MEMORY OVERFLOW.*
          EQ     ABT         ABORT
 
 
 TOVA     CON    0           MEMORY CALL WORD
 TOVB     VFD    30/-0,30/0  MAXIMUM MEMORY LIMIT
 WOF      SPACE  4,10
**        WOF - WRITE LINE TO OUTPUT.
*
*         ENTRY  (X1) = FWA LINE.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*
*         CALLS  CDD.
*
*         MACROS WRITEC, WRITEW.
 
 
 WOF      SUBR               ENTRY/EXIT
          SA3    LC          ADVANCE LINE COUNT
          SX6    X3+B1
          SA6    A3
          SA2    LL
          IX2    X6-X2
          NG     X2,WOF1     IF BOTTOM OF PAGE NOT REACHED
          BX6    X1          SAVE REQUEST
          SA6    WOFA
          SA1    PN          ADVANCE PAGE NUMBER
          SX6    4           RESET LINE COUNT
          SX7    X1+B1
          SA6    A3
          SA7    A1
          RJ     CDD         CONVERT PAGE NUMBER
          MX1    60-12
          LX6    4*6         STORE PAGE NUMBER
          BX6    X1*X6
          SA6    PAGE
          SA1    PD
          ZR     X1,WOF0     IF NO FORMAT EFFECTOR
          WRITEW O,A1,1      WRITE FORMAT EFFECTOR
          BX6    X6-X6
          SA6    PD
 WOF0     WRITEW O,TITL,TITLL
          SA1    ST
          WRITEC X2,X1
          SA1    ST+1
          WRITEC X2,X1
          WRITEC X2,(=C*  *)
          SA1    WOFA        RESTORE REQUEST
 WOF1     WRITEC O,X1
          EQ     WOFX        RETURN
 
 WOFA     DATA   0
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCRDC
*CALL     COMCRDW
*CALL     COMCWTC
*CALL     COMCWTW
*CALL     COMCCIO
*CALL     COMCSYS
*CALL     COMCCDD
*CALL     COMCCOD
*CALL     COMCSFN
          SPACE  4,10
          IDENT              FORCE LITERALS
 PRESET   TITLE  KRONREF PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET KRONREF.
*
*         ENTRY  (A0) = FL.
*
*         EXIT   (FL) = FL - 10B.
*
*         USES   X - 1, 3, 4, 6.
*                A - 0, 1, 4, 6.
*                B - 4, 5.
*
*         CALLS  ARG, SFN.
*
*         MACROS CLOCK, DATE, REWIND.
 
 
 PRS      SUBR               ENTRY/EXIT
          SX6    A0-10B
          SA6    FL
          MEMORY CM,TOVB,R   GET CURRENT FL/MAXIMUM FL
          CLOCK  TIME        REQUEST TIME
          DATE   DATE        REQUEST DATE
          SA1    ACTR        SET ARGUMENT COUNT
          SB4    X1
          ZR     B4,PRS1     IF NO ARGUMENTS
          SB5    PRSA
          SA4    ARGR
          RJ     ARG         PROCESS ARGUMENTS
          SA0    =C* ERROR IN KRONREF ARGUMENTS.*
          NZ     X1,ABT      IF ARGUMENT ERRORS
 PRS1     REWIND P,R
          SA1    P
          MX3    42
          BX1    X3*X1
          RJ     SFN         SPACE FILL FILE NAME
          SA6    PLNM
          RJ     IPP         INITALIZE PAGE PARAMETERS
          EQ     PRSX        RETURN
 PRSA     SPACE  4,10
**        PRSA - CONTROL CARD ARGUMENT VALUES.
 
 
 PRSA     BSS    0
 L        ARG    O,O         OUTPUT FILE
 P        ARG    P,P         OPL FILE NAME
 S        ARG    =0LNOSTEXT,LSSA
 G        ARG    =0LTEXT,LSSB USER SUPPLIED TEXT FILE
          ARG                END OF THE TABLE
 IPP      SPACE  4,15
**        IPP - INITIALIZE PAGE PARAMETERS.
*
*         EXIT   (LL) = LINE LIMIT.
*                (PD) = PRINT DENSITY IF NOT TERMINAL OUTPUT FILE.
*                     = 0 IF TERMINAL OUTPUT FILE.
*
*         USES   X - 2, 6.
*                A - 6.
*
*         CALLS  STF.
*
*         MACROS GETPP.
 
 
 IPP      SUBR               ENTRY/EXIT
          GETPP  IPPA,LL,PD
          SX2    O           OUTPUT FILE FET ADDRESS
          RJ     STF         SET TERMINAL FILE
          NZ     X6,IPPX     IF NOT TERMINAL FILE
          SA6    PD
          EQ     IPPX        RETURN
 
 IPPA     BSS    2           *GETPP* RESPONSE BLOCK
 LSS      SPACE  4,10
**        LSS - LOAD SYSTEMS SYMBOLS.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*
*         CALLS  ATS, SFN.
*
*         MACROS ALLOC, OVERLAY, VERSION.
 
 
 LSS      SUBR               ENTRY/EXIT
          SA1    LSSB        CHECK TEXT FROM LOCAL FILE
          ZR     X1,LSS1     IF TEXT FROM SYSTEM
          RJ     SFN         SET TEXT NAME
          SA6    TX          SET SYSTEXT PRESENT
          SA6    TXNM
          OVERLAY LSSB,101B,,MTBS  LOAD TEXT
          JP     LSS2        NO SYSTEM TEXT
 
 LSS1     SA1    LSSA        SET TEXT NAME
          ZR     X1,LSSX     IF S=0
          RJ     SFN
          SA6    TX          SET SYSTEXT PRESENT
          SA6    TXNM
          VERSION LSSC
          OVERLAY LSSA,101B,SYSTEM,MTBS LOAD TEXT
 LSS2     MX0    42
          SA0    =C* ERROR IN SYSTEM TEXT.*
          SA1    MTBS+1      CHECK FIRST WORD OF TEXT
          BX6    X0*X1
          NZ     X6,ABT
          SA1    65B         SET TEMPORARY LENGTH OF TREF
          SA2    FTAB+FTABL
          SX6    X1
          IX7    X2+X6
          SA6    L.TREF
          SA7    A2
          SA1    MTBS+1      ALLOCATE NAME TABLE
          ALLOC  TNME,X1
          SA0    =C* ERROR IN SYSTEM TEXT.*
          ZR     X3,ABT      ABORT IF NO SYMBOLS
          SX6    0           CLEAR REFERENCE LENGTH
          SA6    L.TREF
 
*         SORT SYMBOLS BY VALUE.
 
          SA1    F.TREF      (A0) = FWA - 1
          SB7    X3          N = LENGTH
          SA0    X1+1
          SB6    B7          M = N
 LSS3     SX6    B6          M = M/2
          AX6    2
          LX6    1
          SB6    X6
          SB3    B1+B1       J = 1
          ZR     B6,LSS6     IF M = 0
          SB4    B7-B6       K = N-M
          SB2    B3
 LSS4     SB5    B2+B6       L = I + M
          SA1    A0+B2       A(I)
          SA2    A0+B5       A(L)
          IX6    X2-X1
          PL     X6,LSS5     IF A(L) .GE. A(I)
          SA3    A1-B1       INTERCHANGE A(L) AND A(I)
          SA4    A2-B1
          BX6    X1
          LX7    X2
          SA6    A2
          SA7    A1
          BX6    X3
          BX7    X4
          SA6    A4
          SA7    A3
          SB2    B2-B6       I = I-M
          GT     B2,LSS4     IF I .GT. 0
 LSS5     SB3    B3+2        J = J + 1
          SB2    B3
          LE     B3,B4,LSS4  IF J = K
          EQ     LSS3        LOOP
 
 LSS6     SA1    F.TREF      COPY SYMBOLS
          SA2    F.TNME
          SX7    B7          SET SYSTEM SYMBOLS LENGTH
          SA3    X1+2
          SA4    A3+B1
          SA7    SL
          BX6    X3
          LX7    X4
          SA6    X2
          SA7    A6+B1
          SB2    B1+B1
 LSS7     SA3    A3+B2
          SA4    A4+B2
          BX6    X3
          LX7    X4
          SB7    B7-B2
          SA6    A6+B2
          SA7    A7+B2
          NZ     B7,LSS7     IF MOVE NOT COMPLETE
          EQ     LSSX        RETURN
 
 LSSA     CON    0LNOSTEXT
 LSSB     CON    0
 LSSC     VFD    12/12B,12/0,12/0,24/TXNM+1
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCARG
*CALL     COMCCPM
*CALL     COMCLFM
*CALL     COMCOVL
*CALL     COMCSTF
          SPACE  4,10
*         MEMORY ALLOCATION.
 
 
 BUF      EQU    PRS
 PBUF     EQU    BUF+BUFL    OPL BUFFER
 MTBS     EQU    PBUF+PBUFL  FWA TABLES
 MFL=     EQU    MTBS+MTBSL+200000B  NOMINAL RUNNING FL
          SPACE  4
          END    KRONREF     KRONOS SYSTEM CROSS REFERENCE PROCESSOR