Retro1.org codex

          IDENT  DOCMENT,FETS
          ABS
          ENTRY  DOCMENT
          ENTRY  MFL=
          SYSCOM B1
          LIST   F
 
 DOCMENT  TITLE  DOCMENT - INTERNAL/EXTERNAL DOCUMENTATION PROGRAM.
*COMMENT  DOCMENT - INTERNAL/EXTERNAL DOCUMENTATION PROGRAM.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       DOCMENT - INTERNAL/EXTERNAL DOCUMENTATION PROGRAM.
*         R.S. HORECK        70/07/06.
          SPACE  4
***       CONTROL CARD CALL.
*
*         DOCMENT(P1,P2,P3,,,PN)
*
*         THE PARAMETERS P(I) MAY INCLUDE THE FOLLOWING (IN ANY ORDER)
*                  AND MUST BE IN ONE OF THE FORMS -
*
*                 * * - (NONE) ASSUME FIRST DEFAULT VALUE.
*                  P - ASSUME ALTERNATE DEFAULT VALUE.
*                 P=X - SUBSTITUTE *X* FOR ANY ASSUMED VALUE OF *P*.
*
*         ANY NUMERIC PARAMETER MAY BE SPECIFIED WITH A POST RADIX
*                TO CLARIFY ITS VALUE. THE RADIX MAY BE *D* OR *B*.
*
*         I - INPUT FILE NAME ON WHICH TO FIND PAGE FOOTING INFORMATION.
*                  THIS MUST BE A SINGLE CARD OF THE FORMAT -
*                  COLUMN(S)       - CONTENTS -
*                     2-45   DOCUMENT TITLE - COLUMN 1 MUST BE BLANK.
*                    46-55   PUBLICATION NUMBER.
*                    56-60   REVISION LEVEL.
*                    61-70   REVISION DATE.
*         S - FILE CONTAINING THE SOURCE CARD IMAGES FROM WHICH TO
*                EXTRACT THE DOCUMENTATION.  THIS FILE IS REWOUND
*                UNLESS THE *NR* PARAMETER IS SPECIFIED.
*         L - FILE ON WHICH DOCUMENTATION IS TO BE WRITTEN.
*         N - NUMBER OF COPIES TO BE PRODUCED.
*         T - DOCUMENTATION TYPE (INT OR EXT)
*         C - CHECK CHARACTER FOR DOCUMENTATION.
*         P - NUMBER OF PRINT LINES / PAGE.
*         NR - DISABLE REWIND ON THE *S* (SOURCE) FILE.
*         NT - NEGATE THE TABLE GENERATOR.
*         TC - LIST TABLE OF CONTENTS.
*
*         DEFAULT PARAMETER SUBSTITUTION VALUES -
*
*                      FIRST   ALTERNATE
*         PARAMETER   DEFAULT   DEFAULT   - COMMENT -
*
*            I          *0*     *INPUT*   PAGE FOOT INFORMATION.
*            S       *COMPILE*  *SOURCE*  SOURCE CARD IMAGES.
*            L        *OUTPUT*  *OUTPUT*  LIST FILE.
*            N           1         1      DECIMAL NUMBER OF COPIES.
*            T         *EXT*     *INT*    DOCUMENTATION TYPE.
*            C          -*-      *03*     CHECK CHAR. (2 OCTAL DIGITS)
*            P          PS        SPS     NUMBER OF PRINT LINES/PAGE.
*                                           PS  = JOB PAGE SIZE.
*                                           SPS = SYSTEM PAGE SIZE.
*            NR       REWIND   NO REWIND  STATUS OF SOURCE FILE REWIND.
*            NT         ON        OFF     STATUS OF TABLE GENERATOR.
*            TC        OFF        ON      STATUS OF TABLE OF CONTENTS.
          SPACE  4,10
***       DOCUMENTATION FOLLOWS THE FOLLOWING RULES.
*
*         EXTERNAL DOCUMENTATION -
*                THREE ASTERISKS STARTING IN COLUMN 1 START DOCUMEN-
*                TATION WHICH CONTINUES UNTIL ALL CONSECUTIVE CARDS
*                WITH COLUMN 1 ASTERISKS HAVE BEEN EXHAUSTED.
*
*         INTERNAL DOCUMENTATION -
*                TWO OR THREE ASTERISKS STARTING IN COLUMN 1 START DOC-
*                UMENTATION WHICH CONTINUES UNTIL ALL CONSECUTIVE CARDS
*                CONTAINING COLUMN 1 ASTERISKS HAVE BEEN EXHAUSTED.
*
*                IN ADDITION, ANY CARD WITH FOUR (4) ASTERISKS STARTING
*                IN COLUMN 1 ACTS AS A TOGGLE FOR DOCUMENTATION. IN THIS
*                MANNER WHEN A CARD IS FOUND TO CONTAIN 4 ASTERISKS
*                STARTING IN COLUMN 1, THAT CARD AND ALL SUCCEEDING
*                CARDS THROUGH ANOTHER LIKE CARD (REGARDLESS OF THE
*                COLUMN 1 CHARACTER) ARE CONSIDERED TO BE PART OF THE
*                DOCUMENTATION.
*
*         DOCUMENTATION FORMAT -
*
*                EACH PAGE OF DOCUMENTATION IS COMPOSED OF 3 ELEMENTS
*
*                1. PAGE HEADER - THIS LINE GIVES THE FIRST 45 CHARAC-
*                            TERS (LEADING BLANKS SUPPRESSED) OF THE
*                            SUBPROGRAM HEADER (I.E. SUBROUTINE,IDENT,
*                            ETC.), THE CURRENT DATE, AND THE DOCUMEN-
*                            TATION TYPE (EXT OR INT).
*                2. DOCUMENTATION TEXT - DOCUMENTATION EXTRACTED FROM
*                            THE SOURCE CARDS (EACH SUBGROUP SEPARATED
*                            BY 4 BLANK LINES).
*                3. PAGE FOOTING - THIS LINE INCLUDES THE 70 CHARACTERS
*                            READ FROM THE *INPUT* FILE AND THE PAGE
*                            NUMBER OF THE FORM *X/Y* WHERE - X IS THE
*                            NUMBER OF THE SUBPROGRAM (CHAPTER) AND Y
*                            IS THE PAGE WITHIN THIS CHAPTER.
*
*         SPECIAL CARD TYPES -
*
*         DOCUMENTATION CARDS CONTAINING *E IN COLUMNS 1 AND 2 CAUSE
*                THE PAGE TO BE EJECTED.
*
*         DOCUMENTATION CARDS CONTAINING *T IN COLUMNS 1 AND 2 ACTIVATE
*                THE TABLE WRITER.
*                  FOR EXAMPLE, THE CARD -
*  *T  EXAMPLE  24/PP PROGRAM NAME+RECALL,18/PARAMETER 1,18/PARAMETER 2
*                  WOULD GENERATE THE FOLLOWING TABLE PICTURE -
*
*T  EXAMPLE  24/PP PROGRAM NAME+RECALL,18/PARAMETER 1,18/PARAMETER 2
*
*                  THE IDENTIFICATION *EXAMPLE* MAY BE OMITTED.
*                  EACH TIME A NEW BLOCK OF *T CARDS IS ENCOUNTERED,
*                  A BIT POSITION HEADER IS LISTED. THIS HEADER IS NOT
*                  LISTED FOR EACH CONSECUTIVE TABLE CARD OR FOR ANY
*                  CARD CONTAINING A NON-BLANK CHARACTER IN COLUMN 3 OF
*                  THE FIRST *T CARD IN A BLOCK.
*                  CARD FORMAT IS THE SAME AS FOR THE COMPASS *VFD*
*                  PSEUDO INSTRUCTION, HOWEVER, NO *VFD* MAY BE PRESENT.
*                  A SLASH */* MUST IMMEDIATELY FOLLOW A BIT COUNT
*                  FIELD, BUT LEADING SPACES ARE IGNORED.
*                  ALL BIT COUNTS FOR FIELD WIDTHS MAY BE SPECIFIED IN
*                  EITHER OCTAL OR DECIMAL. DECIMAL COUNTS ARE ASSUMED
*                  IN THE ABSENCE OF A POST-RADIX (B) OR (D).
*                  MAXIMUM PICTURE WIDTH IS 60 BITS.
*                  A SLASH SEPARATES FIELDS IN THE PICTURE AND THE
*                  BIT POSITION IT OCCUPIES IS INCLUDED IN THE FIELD
*                  TO ITS LEFT. SINGLE BIT FIELDS ARE LISTED WITHOUT
*                  A SLASH FIELD SEPARATOR. ALL TABLE ENTRY
*                  DESCRIPTION CARDS WITHIN A *T BLOCK ARE CONSIDERED
*                  TO HAVE THE SAME TOTAL NUMBER OF BITS.
*                  FIELD LABELS ARE LEFT JUSTIFIED WITHIN THE FIELD
*                  AND WILL BE TRUNCATED IF THE LABEL CONTAINS MORE
*                  CHARACTERS THAN THE BIT COUNT MINUS 1.
*                  IF THE THIRD CHARACTER ON THE CARD IS NON-BLANK, NO
*                  BIT COUNT HEADER WILL BE PLACED ABOVE THE TABLE
*                  ENTRY. SINGLE BIT FIELDS WILL BE LISTED WITH A *+*
*                  BELOW THE FIELD POSITION. THE ONLY EXCEPTION TO THIS
*                  IS THE CASE WHERE ONLY ONE TABLE ENTRY IS LISTED. IN
*                  THIS INSTANCE THE *+* WILL BE LISTED BOTH ABOVE AND
*                  BELOW THE FIELD POSITION.
*
*         ALL LOADER CONTROL CARDS (I.E. OVERLAY,SECTION,ETC.) ARE
*                CONSIDERED SPECIAL AND THEIR IMAGES ARE PLACED ALONG
*                WITH THE PAGE NUMBER AT THE FOOT OF EACH SUBPROGRAM
*                ENCOMPASSED BY THE SCOPE OF THE DIRECTIVE.
*         ALL *END* CARDS ARE CONSIDERED SPECIAL SINCE THEY TERMINATE A
*                CHAPTER.
*         IN COMPASS THE FOLLOWING CARDS ALSO HAVE SPECIAL MEANING -
*                TITLE - THE FIRST TITLE CARD REPLACES THE PAGE HEADER
*                            WITH ITS CONTENTS (IF NON-BLANK).
*                            SUBSEQUENT TITLE CARDS ARE IGNORED.
*                LIST - THE PARAMETERS *X* AND *L* ARE PROCESSED. IF A
*                            *-L* IS ENCOUNTERED ALL DOCUMENTATION IS
*                            SUPRESSED UNTIL A *LIST L* CARD IS ENCOUN-
*                            TERED. IF A *-X* (ASSUMED) IS ENCOUNTERED,
*                            NO DOCUMENTATION WILL BE PROCESSED ON
*                            COMMON TEXT *CTEXT* UNTIL A *LIST X* CARD
*                            IS FOUND.  ONLY A DEFINED NUMBER OF LIST
*                            CARDS MAY BE PROCESSED.  THIS NUMBER IS
*                            DEFINED BY THE TAG *NLCA*.  EACH (LIST *)
*                            CARD ALLOWS AN EXTRA LIST CARD TO BE
*                            PROCESSED ABOVE THE NUMBER *NLCA*.
*                CTEXT,ENDX - BRACKET CARDS SURROUNDING COMMON TEXT -
*                            NO DOCUMENTATION IS LISTED UNLESS A *LIST
*                            X* CARD HAS BEEN ENCOUNTERED.
*                COL - DATA BEYOND THE COMMENT COLUMN IS NOT
*                            EXAMINED FOR KEYWORDS.  IF A *COL*
*                            CARD IS ENCOUNTERED, THE COMMENT
*                            COLUMN IS CHANGED TO THE COLUMN
*                            SPECIFIED ON THE *COL* CARD.
          TITLE  DATA DEFINITION.
*         CONSTANTS.
 
 SBUFL    EQU    201B        LENGTH OF TABLE OF CONTENTS BUFFER
 BFSZ     EQU    3001B       BUFFER SIZE
 NBFS     EQU    2           NUMBER OF BUFFERS
 NCR      EQU    72          NUMBER OF CHARACTERS TO READ FROM A CARD
 NLCA     EQU    24          NUMBER OF LIST CARDS ALLOWED
 FLP      EQU    7           NUMBER OF HEADER FOOTER LINES
 MPGS     EQU    16D         MINIMUM PAGE SIZE
          SPACE  4,10
*CALL     COMCMAC
*CALL     COMCCMD
          SPACE  4,10
          ORG    110B
 
 FETS     BSS    0
 
 
 S        VFD    42/0LCOMPILE,18/3 FETS FOR INPUT AND SOURCE
 
 O        VFD    42/0LOUTPUT,18/3  FETS FOR OUTPUT AND SCRATCH
 
 SCR1     FILEB  BUF,BFSZ
 
 SCR2     FILEB  SBUF,SBUFL
 
 I        BSS    0
 INPUT    FILEB  BUF+BFSZ,BFSZ
 INPX     EQU    *
          ORG    INPUT
          CON    0
          ORG    INPX
 
*         TABLE OF SPECIAL NAMES.
 
 TNM      VFD    60/-0       10 CHAR MASK
          DATA   10HSUBROUTINE
          DATA   10HPRECISION
          VFD    48/-0,12/   8 CHAR MASK
          DATA   8LFUNCTION
          VFD    42/-0,18/   7 CHAR MASK
          DATA   7LPROGRAM
          DATA   7LINTEGER
          DATA   7LFORTRAN
          DATA   7LLOGICAL
          DATA   7LOVERLAY
          DATA   7LSEGMENT
          DATA   7LSECTION
          DATA   7LSEGZERO
          DATA   7LCHNLINK
          VFD    36/-0,24/   6 CHAR MASK
          DATA   6LDOUBLE
          DATA   6LSINGLE
          VFD    30/-0,30/   5 CHAR MASK
          DATA   5LIDENT
          DATA   5LBLOCK
          VFD    24/-0,36/   4 CHAR MASK
          DATA   4LTYPE
          DATA   4LDATA
          DATA   4LREAL
          VFD    12/-0,48/   2 CHAR MASK
          DATA   2LII
          DATA   2LIV
          DATA   2LVI
          VFD    60/         END OF TABLE
          SPACE  4
*         VARIABLES.
 
 NAS      DATA   20          NUMBER OF ASTERISKS NECESSARY IN THE FIRST
 MAS      DATA   3           MINIMUM NUMBER OF ASTERISKS NEEDED FOR DOC
 XFL      DATA   0           LIST X FLAG
                             FOUR COLUMNS TO TURN TOGGLE
 TOG      DATA   0           TOGGLE FOR **** CARDS (INT ONLY) 0=NO,1=YES
 PTYP     CON    0           PROGRAM TYPE (0=*COMPASS*, 1=FORTRAN)
 FCR      DATA   1           FIRST COLUMN TO CHECK ON INPUT CARD
 CCM      DATA   30          COLUMN FOR COMMENTS
 LCT      BSS    1           LINE COUNT
 LLM      BSS    1           MAXIMUM NUMBER OF LINES PER PAGE
 PD       BSS    1           PRINT DENSITY
 
 HDSL1    BSS    1           HEADING SUBLENGTH 1
 HDSL2    BSS    1           HEADING SUBLENGTH 2
 
 
 HDG      BSS    5           HEADING LINE
 HDG1     CON    0           DATE
 HDG2     DATA   10H EXTERNAL
          CON    0           END OF LINE
 
 FOT      DATA   40H CONTROL DATA SYSTEMS DOCUMENTATION.
          DATA   30H
          BSSZ   1           END OF LINE FLAG
 SBF      DATA   10H
          DUP    5,1
          DATA   10H
 PGE      VFD    42/7H  PAGE ,18/
          BSSZ   1           SUBPAGE NUMBER
 
 CHP      BSSZ   1           CHAPTER COUNT
 SPG      BSSZ   1           SUBCHAPTER PAGE COUNT
 EDAS     DATA   3           SAME AS MAS
 IDAS     DATA   20          SAME AS NAS
 FLF      DATA   0           FIRST LINE LISTED FLAG
 PCT      DATA   0           PAGE COUNT FOR PAGE PARITY CHECK
 
*         INPUT PARAMETERS.
 
 N        CON    1L1
 T        CON    0LEXT
 C        CON    0L47B
 P        CON    0           LINES PER PAGE
 NR       CON    0           DISABLE SOURCE FILE REWIND
 NT       CON    0
 TC       CON    0
 NI       CON    0
          TITLE  MAIN PROGRAM.
**        DOCMENT - MAIN PROGRAM.
 
 
 DOCMENT  SB1    1
          RJ     IPP         INITIALIZE PAGE PARAMETERS
          SA1    ACTR        GET ARGUMENT COUNT
          R=     A4,ARGR     FIRST ARGUMENT
          SB4    X1
          SB5    ARGA        ADDRESS OF ARGUMENT TABLE
          RJ     ARG         PROCESS ARGUMENTS
          NZ     X1,DOC7     IF ERROR IN ARGUMENTS
          RJ     CKO         CHECK OPTIONS
          RJ     CTF         CHECK TERMINAL FILE
          RJ     CTP         CALCULATE TITLE PAGE
          REWIND SCR2,R      REWIND SCRATCH FILE
          REWIND SCR1,R      REWIND SCRATCH FILE
          RJ     RIF         READ INPUT FILE
          SA5    S           CHANGE FILE NAME OF INPUT
          BX6    X5
          SA6    I
          SA1    NR
          NZ     X1,DOC0.1   IF NO REWIND OF SOURCE FILE
          REWIND A6,R        REWIND SOURCE FILE
 DOC0.1   READ   I           BEGIN READING SOURCE CODE
 DOC1     READS  I,DCD,NCR   READ INPUT CARD
          NZ     X1,DOC2     IF EOR/EOF
          RJ     PRC         PROCESS SUBPROGRAM
          EQ     DOC1
 
 DOC2     NG     X1,DOC3     IF EOF
          SA5    S
          BX6    X5
          SA6    X2          RESET FILE NAME
          SA1    SBF         CLEAR SUB-FOOT LINE
          BX6    X1
          LX7    X1
          SA6    A1+B1       STORE FIRST BLANK
          SA7    A6+B1       STORE SECOND BLANK
          SA6    A7+B1       STORE THIRD BLANK
          SA7    A6+B1       STORE FOURTH BLANK
          SA6    A7+B1       STORE FIFTH BLANK
          READ   X2          INITIATE READ
          EQ     DOC1        GO TILL EOF
 
 DOC3     SA1    PCT         CHECK PAGE PARITY
          SX6    B1
          BX6    X6*X1
          ZR     X6,DOC4     IF EVEN PAGE COUNT
          WRITEC SCR1,(=2L1 )
 DOC4     WRITER SCR1,R      WRITE EOR ON SCRATCH FILE
          WRITER SCR2,R
          MESSAGE (=C* COPYING OUTPUT.*),1
          RJ     FCN         FORMAT TABLE OF CONTENTS
 
 DOC5     REWIND SCR1,R      REWIND SCRATCH FILE
          SA5    O           CHANGE FILE NAME ON INPUT
          MX7    0
          SA7    I
          READ   I           SET FIRST=IN=OUT
          BX6    X5
          SA6    X2          STORE NEW FILE NAME
          READ   SCR1
          RJ     CPY         COPY THE FILE TO OUTPUT
          SA1    N
          SX6    X1-1        DECREMENT COPY COUNT
          SA6    A1
          NZ     X6,DOC5     IF NOT FINISHED
 DOC6     RETURN SCR1,R
          RETURN SCR2,R
          MESSAGE (=C* DOCUMENTATION COMPLETE.*)
          ENDRUN
 
 DOC7     MESSAGE (=C* ERROR IN DOCMENT ARGUMENTS.*)
          ABORT
 PRC      TITLE  SUBROUTINES.
**        PRC - PROCESS SUBPROGRAM.
*
*         ENTRY  DCD - (DCD+NCR) = FIRST CARD FOLLOWING *END*.
*
*         EXIT   TO PROPER SUBPROGRAM MANAGER.
*
*         USES   A - 0, 2, 7.
*                B - 2, 5.
*                X - 0, 2, 3, 6, 7.
*
*         CALLS  GFW.
 
 
 PRC      PS     0           ENTRY/EXIT
          SX7    B1          RESET FIRST CHARACTER SCAN
          SA7    FCR
          RJ     GFW         GET FIRST WORD
          SB2    -B1         SET PARAMETER COUNT
          SA2    TNM         BASE OF MNEMONIC TABLE
 PRC1     BX0    X2          SET MASK
 PRC2     SA2    A2+B1       GET CHECK WORD
          NG     X2,PRC1     IF MASK WORD
          SB2    B2+B1       BUMP PARAMETER COUNT
          ZR     X2,PRC      IF NOT SPECIAL CARD - END OF TABLE REACHED
          BX3    X0*X1
          IX6    X3-X2       CHECK NAME
          NZ     X6,PRC2     NO MATCH - LOOP
          JP     B2+PRC3     EXIT TO ROUTINE
 
 PRC3     BSS    0           START OF TABLE
          LOC    0
 +        EQ     FTN         *SUBROUTINE*
 
 +        SB5    B5-B1       *PRECISION*
          EQ     SKP
 
 +        SB5    B5-2        *FUNCTION*
          EQ     FTN
 
 +        SB5    B5-3        *PROGRAM*
          EQ     FTN
 
 +        SB5    B5-3        *INTEGER*
          EQ     SKP
 
 +        SB5    B5-3        *FORTRAN*
          EQ     SKP
 
 +        SB5    B5-3        *LOGICAL*
          EQ     SKP
 
 +        SA0    PRC         *OVERLAY*
          EQ     SPC
 
 +        SA0    PRC         *SEGMENT*
          EQ     SPC
 
 +        SA0    PRC         *SECTION*
          EQ     SPC
 
 +        SA0    PRC         *SEGZERO*
          EQ     SPC
 
 +        SA0    PRC         *CHNLINK*
          EQ     SPC
 
 +        SB5    B5-4        *DOUBLE*
          EQ     SKP
 
 +        SB5    B5-4        *SINGLE*
          EQ     SKP
 
 +        SB5    B5-4        *IDENT*
          EQ     CMP
 
 +        SB5    B5-5        *BLOCK*
          EQ     SKP
 
 +        SB5    B5-6        *TYPE*
          EQ     SKP
 
 +        SB5    B5-6        *DATA*
          EQ     BKD
 
 +        SB5    B5-6        *REAL*
          EQ     SKP
 
 +        SB5    B5-8        *II*
          EQ     SKP
 
 +        SB5    B5-8        *IV*
          EQ     SKP
 
 +        SB5    B5-8        *VI*
          EQ     SKP
 
          LOC    *O
 GFW      SPACE  4,20
**        GFW - GET FIRST WORD FROM CARD.
*
*         ENTRY  (FCR) = FIRST CHARACTER ON CARD TO ANALYZE.
*                AT *SKP* FOR SPECIAL CARDS.
*
*         EXIT   (B5) = LOCATION OF NEXT CHARACTER TO READ.
*                (X1) = FIRST 10 CHARACTERS FOLLOWING LEADING BLANKS.
*
*         USES   A - 2.
*                B - 5, 7.
*                X - 1, 2, 3, 4, 5, 6.
 
 
 GFW      PS     0           ENTRY/EXIT
          SA2    FCR         FIRST CHARACTER
          SB5    X2+DCD-1
 
 SKP      BSS    0           ENTRY FOR SKIP
 
 GFW1     SX1    0           CLEAR FLAG WORD
          SX3    1R
          SX4    1R0
          SB7    9
 GFW2     SA2    B5          READ CHARACTER
          SB5    B5+B1
          ZR     X2,GFW      END OF CARD
          IX5    X2-X3
          BX6    X2-X4
          ZR     X5,GFW2     IF BLANK
          ZR     X6,GFW2     IF ZERO
 
 GFW3     BX1    X1+X2
          SA2    B5          READ NEXT CHARACTER
          SB7    B7-B1       DECREMENT LOOP COUNT
          LX1    6
          SB5    B5+B1
          NZ     B7,GFW3     LOOP FOR 10 CHARS
          BX1    X1+X2
          EQ     GFW         EXIT
 FTN      SPACE  4,10
**        FTN - PROCESS FORTRAN SUBPROGRAMS.
*
*         ENTRY  (B5) = ADDRESS OF NEXT CHARACTER TO READ.
*
*         USES   A - 0, 2, 6.
*                B - 2.
*                X - 0, 2, 3, 4, 6.
*
*         CALLS  CNT, CTA, GFW, LST, TTL.
 
 
 FTN      BSS    0           ENTRY
          SX6    B1+         SET PROGRAM TYPE TO FORTRAN
          SA6    PTYP
          RJ     CNT         ADD TO TABLE OF CONTENTS
          RJ     TTL         SET TITLE AND START NEW PAGE
          SX6    7           SET STARTING CHAR FOR GFW
          SA6    FCR
 
 FTN1     READS  I,DCD,NCR   READ NEXT CARD
          NZ     X1,ABT      IF PREMATURE EOR/EOF
          RJ     CTA         COUNT ASTERISKS
          ZR     X1,FTN2     IF NOT A COMMENT
          SA2    MAS         MINIMUM NUMBER OF ASTERISKS TO DOCUMENT
          IX4    X1-X2
          NG     X4,FTN1     IF NOT ENOUGH
          RJ     LST         GO PROCESS COMMENT CARDS
 FTN2     RJ     GFW         GET FIRST WORD
          SB2    -B1         SET PARAMETER COUNT
          SA2    FTNA        BASE OF SPECIAL NAMES TABLE
 
 FTN3     BX0    X2          SET MASK
 FTN4     SA2    A2+B1       GET CHECK WORD
          NG     X2,FTN3     IF MASK WORD
          SB2    B2+B1       BUMP PARAMETER COUNT
          ZR     X2,FTN1     IF NOT SPECIAL CARD - END OF TABLE
          BX3    X0*X1
          IX6    X3-X2       CHECK NAME
          NZ     X6,FTN4     NO MATCH - LOOP
          JP     B2+FTN5     EXIT TO ROUTINE
 
 FTN5     BSS    0           JUMP TABLE
          LOC    0
 +        SA0    PRC         *END*
          EQ     EDC
 
          LOC    *O
 
 FTNA     VFD    24/-0,36/   4 CHAR MASK
          DATA   4LEND
          VFD    60/         END OF TABLE
 CMP      SPACE  4,10
**        CMP - PROCESS COMPASS SUBPROGRAM.
*
*         ENTRY  (B5) = ADDRESS OF NEXT CHARACTER TO READ.
*
*         USES   A - 0, 2, 5, 6, 7.
*                B - 2, 5.
*                X - 0, 2, 3, 4, 5, 6, 7.
*
*         CALLS  CNT, CTA, GFW, LST, TTL.
 
 
 CMP      BSS    0           ENTRY
          SX6    B0+         SET PROGRAM TYPE TO *COMPASS*
          SA6    PTYP
          RJ     CNT         ADD TO TABLE OF CONTENTS
          RJ     TTL         SET TITLE AND START NEW PAGE
          SX6    11          SET STARTING COLUMN FOR GFW
          SA6    FCR
          SX6    30          SET COLUMN NUMBER
          SA6    CCM
          SA5    CMPA        RESET TITLE IN TABLE
          BX7    X5
          SA7    CMPC
 
 CMP1     READS  I,DCD,NCR   READ NEXT CARD
          NZ     X1,ABT      IF PREMATURE EOR/EOF
          RJ     CTA         COUNT ASTERISKS
          ZR     X1,CMP2     IF NOT COMMENT CARD
          SA2    MAS         MINIMUM NUMBER OF ASTERISKS TO DOCUMENT
          IX4    X1-X2
          NG     X4,CMP1     IF NOT ENOUGH
          RJ     LST         GO PROCESS COMMENT CARDS
 CMP2     RJ     GFW         GET FIRST WORD
          SX6    B5-DCD-10   CHECK WHICH COLUMN KEYWORD STARTED
          SA2    CCM
          IX6    X6-X2
          PL     X6,CMP1     IF STARTED AFTER COMMENT COLUMN
          SB2    -B1         SET PARAMETER COUNT
          SA2    CMPB        BASE OF SPECIAL NAMES TABLE
 
 CMP3     BX0    X2          SET MASK
 CMP4     SA2    A2+B1       READ CHECK WORD
          NG     X2,CMP3     IF MASK
          SB2    B2+B1       BUMP PARAMETER COUNT
          ZR     X2,CMP1     IF NOT SPECIAL WORD - END OF TABLE
          BX3    X0*X1
          IX6    X3-X2       CHECK NAME
          NZ     X6,CMP4     NO MATCH - LOOP
          JP     B2+CMP5     EXIT TO ROUTINE
 
 CMP5     BSS    0           START OF JUMP TABLE
          LOC    0
 +        SB5    B5-2        *SEGMENT*
          EQ     NDK
 
 +        SB5    B5-4        *CTEXT*
          EQ     CTX
 
 +        SB5    B5-4        *IDENT*
          EQ     NDK
 
 +        SB5    B5-5        *ENDX*
          EQ     EDX
 
 +        SB5    B5-4        *LIST*
          EQ     LSC
 
+         SB5    B5-6        *COL*
          EQ     COL         PROCESS *COL* CARD
 
 +        SA0    PRC         *END*
          EQ     EDC
 
 +        SA0    CMP1        *LCC*
          EQ     LCC
 
 CMP6     SB5    B5-4        *TITLE*
          EQ     TIT
 
          LOC    *O
 
 CMPA     DATA   6LTITLE
 CMPB     VFD    48/-0,12/   8 CHAR MASK
          DATA   8LSEGMENT
          VFD    36/-0,24/   6 CHAR MASK
          DATA   6LCTEXT
          DATA   6LIDENT
          VFD    30/-0,30/   5 CHAR MASK
          DATA   5LENDX
          DATA   5LLIST
          VFD    24/-0,36/   4 CHAR MASK
          DATA   4LCOL
          DATA   4LEND
          DATA   4LLCC
          VFD    36/-0,24/   6 CHAR MASK FOR *TITLE* - MUST BE LAST
 
 CMPC     DATA   6LTITLE
          VFD    60/         END OF TABLE
 NDK      SPACE  4,10
**        NDK - PROCESS NEW DECK *IDENT* OR *SEGMENT*.
*
*         ENTRY  (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*                (X1) = FIRST 10 CHARACTERS OF SPECIAL CARD.
*                (A0) = EXIT ADDRESS.
*
*         USES   A - 1, 7.
*                X - 0, 1, 7.
*
*         CALLS  LSL, STB.
 
 
 NDK      SA1    FLF         CHECK TO SEE IF AT TOP OF PAGE
          ZR     X1,CMP1     IF NO OUTPUT YET
          SA1    LCT
          BX0    X1
          RJ     STB
          RJ     LSL
          MX7    0           CLEAR FIRST LINE LISTED FLAG
          SA7    FLF
          EQ     CMP1        RETURN
 SPC      SPACE  4,20
**        SPC - PROCESS SPECIAL CARDS.
*
*         ENTRY  (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*                (X1) = FIRST 10 CHARACTERS OF SPECIAL CARD.
*                (A0) = EXIT ADDRESS.
*
*         EXIT   IMAGE OF SPECIAL CARD IS PLACED IN SUB-FOOT LINE.
*
*         USES   A - 2, 7.
*                B - 2, 6, 7.
*                X - 2, 7.
 
 
 SPC      BX7    X1
          SA2    B5          READ NEXT CHARACTER
          SA7    SBF+1       STORE FIRST WORD
          SB6    4           SET WORD COUNT
          SB7    9           SET CHARACTER COUNT
          BX7    X2
          EQ     SPC2        GO PACK WORD
 
 SPC1     SB7    10          SET CHARACTER COUNT
          SA7    A7+B1       STORE NEXT WORD
          SB6    B6-B1       DECREMENT WORD COUNT
          MX7    0           CLEAR ENCODE WORD
          ZR     B6,SPC3     IF END OF SUB-FOOT LINE
 SPC2     SA2    A2+B1       READ NEXT CHARACTER
          LX7    6
          SB7    B7-B1       DECREMENT CHARACTER COUNT
          BX7    X2+X7
          NZ     B7,SPC2     LOOP FOR 10 CHARACTERS
          EQ     SPC1        STORE WORD
 
 SPC3     SB2    A0          SET EXIT ADDRESS
          JP     B2          EXIT
 CNT      SPACE  4,10
**        CNT - SET TABLE OF CONTENTS.
*
*         ENTRY  (B5) = ADDRESS OF NEXT CHARACTER TO READ.
*
*         EXIT   SUBCHAPTER AND PAGE COUNTS UPDATED.
*
*         USES   A - 2, 3, 4, 6, 7.
*                B - 6, 7.
*                X - 0, 2, 3, 4, 5, 6, 7.
 
 
 CNT5     SA2    A2          DECREMENT SUB-CHAPTER COUNT
          SX6    X2-1
          SA6    A2
 
 CNT      PS     0           ENTRY/EXIT
          SA2    CHP         CHAPTER COUNT
          MX7    0
          SX6    X2+B1
          SA7    SPG         RESET SUB-CHAPTER PAGE COUNT
          SA6    A2          RESET CHAPTER COUNT
          SA3    B5-B1       DUMMY READ
          SX2    1R
          SB7    54
          SB6    -1R,
          SX5    1R(
 
 CNT1     SA3    A3+B1       READ NEXT CHARACTER
          BX4    X3-X2
          ZR     X4,CNT1     IF BLANK
          ZR     X3,CNT4     IF END OF LINE
 
 CNT2     IX6    X3-X5
          SX4    X3+B6
          ZR     X6,CNT3     IF TERMINATOR
          ZR     X4,CNT3
          BX7    X7+X3
          SB7    B7-6
          SA3    A3+B1       READ NEXT CHARACTER
          LX7    6
          NZ     B7,CNT2     LOOP FOR 10 CHARACTERS
 CNT3     LX7    X7,B7
 CNT4     ZR     X7,CNT5     IF NO NAME FOUND
          SA7    CNTB
          SA4    CHP         GET SUBCHAPTER COUNT
          SX6    X4
          MX0    42
          BX7    X0*X7
          BX6    X6+X7
          WRITEO SCR2
          MESSAGE CNTA,1
          EQ     CNT         EXIT
 
 CNTA     DATA   10H READING
 CNTB     DATA   0
          DATA   0
 CNTC     CON    0
 FCN      SPACE  4,10
**        FCN - FORMAT TABLE OF CONTENTS.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3.
*                X - ALL.
*
*         CALLS  CVT, SFN, SRT.
 
 
 FCN4     WRITER SCR2,R
 FCN      PS     0           ENTRY/EXIT
          REWIND SCR2,R
          SA5    SCR2
          MX7    0
          SA7    I
          READ   I           RESET FIRST=IN=OUT
          BX6    X5
          SA6    X2
          SA1    TC          CHECK FOR LIST OF TABLE OF CONTENTS
          ZR     X1,FCN4     EXIT
          READ   I,R
          REWIND SCR2,R
          SA1    LLM
          SX1    X1-61
          NG     X1,FCN0     IF NOT MORE THAN 60 LINES PER PAGE
          SX6    1RT
          LX6    60-6
          WRITEO SCR2
 FCN0     WRITEW SCR2,FCNB,LFCB
          SA1    PCT         BUMP PAGE COUNT FOR PAGE PARITY
          SX6    X1+B1
          SA6    A1
          SX7    4
          SA7    LCT
          RJ     SRT         SORT DECK NAME TABLE
          SA5    I+2         IN
          SA4    A5+B1       OUT
          IX6    X5-X4       CALCULATE THE NUMBER OF ROWS TO PRINT
          SX0    X4
          SX6    X6+3
          AX6    2           DIVIDE BY 4
          SX7    -B1
          SA6    FCNA+1      NUMBER OF ROWS
          SA7    A6+B1       CURRENT ROW
          SA6    A6-B1       INCREMENT
 FCN1     SA1    FCNA+1      DECREMENT ROW COUNT
          SX6    X1-1
          ZR     X1,FCN4     IF END OF TABLE
          SA2    A1+B1       ADVANCE INCREMENT
          SA6    A1
          SX7    X2+B1
          SA7    A2
          SA1    I+3         OUT
          IX0    X7+X1       SAVE ENTRY ADDRESS
          SA6    DCD-1       INITIALIZE STORE ADDRESS
 FCN2     SA3    X0          READ ENTRY
          MX4    42
          BX1    X4*X3       GET SUBPROGRAM NAME
          SB3    X3
          RJ     SFN         FILL NAME WITH SPACES
          LX6    60-18       RIGHT JUSTIFY NAME
          SX1    B3
          SA6    A6+B1       STORE IN PRINT LINE
          RJ     CVT
          LX6    X7,B7
          LX6    6*4
          SA6    A6+B1       STORE NUMBER
          SA1    FCNA        LENGTH OF ROW
          IX0    X0+X1       BUMP TO NEXT ENTRY
          IX6    X0-X5
          NG     X6,FCN2     LOOP TO END OF LINE
          MX7    0
          SA7    A6+B1
          SA2    LCT
          SA3    LLM
          SX6    X2+B1       BUMP LINE COUNT
          SA6    A2
          IX7    X6-X3       CHECK FOR END OF PAGE
          NG     X7,FCN3
          WRITEW SCR2,FCNB,LFCB
          SA1    PCT         BUMP PAGE COUNT
          SX6    X1+B1
          SA6    A1
          SX7    4
          SA7    LCT
 FCN3     WRITEC SCR2,DCD
          EQ     FCN1        CONTINUE FOR ALL ROWS
 
 FCNA     BSS    3           TEMPORARY STORAGE
 FCNB     DATA   H*1  LIST OF SUB-PROGRAMS AND CORRESPONDING CHAPTERS*
          DATA   C* PROCESSED BY DOCMENT.*
          DATA   2L0
 LFCB     EQU    *-FCNB
 SRT      SPACE  4,10
**        SRT - SORT DECK NAME TABLE.
*
*         USES   A - 0, 1, 2, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                X - 1, 2, 4, 5, 6, 7.
 
 
 SRT      PS     0           ENTRY/EXIT
          SA1    I+2         LWA+1 TABLE
          SA2    A1+B1
          IX5    X1-X2       LENGTH = (B7) = N
          SA0    X2-1
          SB7    X5
          SB6    X5
 
 SRT1     SX6    B6          N = N/2
          AX6    1
          SB6    X6
          SB3    B1          J = 1
          ZR     B6,SRT      RETURN IF M = 0
          SB4    B7-B6       N = N-M
          SB2    B3          I = J
 
 SRT2     SB5    B2+B6       L = I+M
          SA1    A0+B2       A(I)
          SA2    A0+B5       A(L)
          IX4    X2-X1
          PL     X4,SRT3     IF A(L) > A(I)
          BX6    X1          INTERCHANGE A(L) AND A(I)
          LX7    X2
          SA6    A2
          SA7    A1
          SB2    B2-B6       I = I-M
          GT     B2,SRT2     IF I > 0
 
 SRT3     SB3    B3+B1       J = J+1
          SB2    B3          I = J
          LE     B3,B4,SRT2  IF J @ K
          EQ     SRT1
 LCC      SPACE  4,10
**        LCC - PROCESS *LCC* CARDS.
*
*         ENTRY  (A0) = EXIT ADDRESS.
*                (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
*         USES   A - 2, 6.
*                B - 2.
*                X - 2, 6.
*
*         CALLS  GFW.
 
 
 LCC      SA2    FCR         GET FIRST CHARACTER ADDRESS
          SX6    B5-DCD
          SX6    X6-6        SET FIRST CHARACTER FOR GFW
          SB2    X2          SAVE ADDRESS OF OLD FIRST CHARACTER
          SA6    A2
          RJ     GFW         GET FIRST WORD SET UP FOR SPC
          SX6    B2          RESTORE FCR
          SA6    FCR
          EQ     SPC         PROCESS AS SPECIAL CARD
 TTL      SPACE  4,10
**        TTL - SET TITLE OF NEW SUBPROGRAM.
*
*         USES   A - 2, 3, 7.
*                B - 6, 7.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  GFW.
 
 
 TTL      PS     0           ENTRY/EXIT
          RJ     GFW         GET FIRST WORD
          SA3    TTLA
          MX0    12
          LX1    48
          BX6    -X0*X1      GET FIRST 8 CHARACTERS
          BX7    X6+X3
          SA7    HDG         SET FIRST WORD OF HEADING
          SB7    8           SET CHARACTER COUNT
          BX7    X0*X1       GET LAST 2 CHARACTERS
          SB6    4           SET WORD COUNT
          LX7    12
          EQ     TTL2
 
 TTL1     SB7    10
          SA7    A7+B1       STORE NEXT WORD
          SB6    B6-B1
          MX7    0
          ZR     B6,TTL      IF END OF TITLE LINE
 TTL2     SA2    A2+B1       READ NEXT CHARACTER
          LX7    6
          SB7    B7-B1
          BX7    X7+X2
          NZ     B7,TTL2     LOOP FOR 10 CHARACTERS
          EQ     TTL1
 
 TTLA     VFD    12/1H1,48/
 LFL      SPACE  4,10
**        LFL - LIST FIRST LINE.
*
*         USES   A - 1, 6, 7.
*                X - 1, 6, 7.
 
 
 LFL      PS     0           ENTRY/EXIT
          SA1    SPG         SUB-CHAPTER PAGE COUNT
          SX6    X1+B1
          SA6    A1          BUMP PAGE COUNT
          SX7    FLP
          SA7    LCT         RESET LINE COUNT
          WRITEC SCR1,HDG    WRITE HEADING LINE
          WRITEC X2,(=2L0 )  2 BLANK LINES
          SX7    X2          SET FIRST LINE LISTED FLAG
          SA7    FLF
          EQ     LFL         EXIT
 CTA      SPACE  4,10
**        CTA - COUNT ASTERISKS.
*
*         USES   A - 2, 3, 6.
*                B - 7.
*                X - 1, 2, 3, 6, 7.
 
 
 CTA      PS     0           ENTRY/EXIT
          MX1    0           SET INITIAL COUNT
          SX6    1R
          SA2    C           READ CHECK CHARACTER
          SA3    DCD
          SB7    5
 CTA1     BX7    X3-X2       CHECK FOR ASTERISK
          SB7    B7-B1       DECREMENT LOOP COUNT
          NZ     X7,CTA      IF NOT * EXIT
          SA6    A3          REPLACE IT WITH A BLANK
          SX1    X1+B1
          SA3    A3+B1
          NZ     B7,CTA1     IF MORE CHARACTERS TO PROCESS
          SX1    3           TREAT ***** LIKE *** STATEMENTS
          EQ     CTA         EXIT
 LST      SPACE  4,10
**        LST - LIST DOCUMENTATION.
*
*         ENTRY  (X1) - NUMBER OF ASTERISKS FOUND.
*
*         EXIT   TO *EDC* IF END CARD ENCOUNTERED.
*
*         USES   A - 0, 1, 2, 4, 5, 6, 7.
*                X - ALL.
*
*         CALLS  CTA, GFW, LFL, LSL, STB, TAB.
 
 
 LST      PS     0           ENTRY/EXIT
          SA2    NAS         MINIMUM NUMBER OF ASTERISKS FOR INT DOC
          IX3    X1-X2
          PL     X3,LST5     DO INTERNAL DOCUMENTATION
          SX2    4           CHECK FOR EXTERNAL DOCUMENTATION
          IX3    X1-X2
          PL     X3,LST      IF NOT EXTERNAL
 
 LST1     SA2    FLF         CHECK FIRST LINE FLAG
          NZ     X2,*+2      IF FIRST LINE HAS BEEN LISTED
 +        RJ     LFL         LIST FIRST LINE
          SA1    LCT         CHECK PAGE POSITION
          SX5    X1-FLP      CHECK FOR TOP OF PAGE
          ZR     X5,LST4     IF AT TOP
          SX6    X1+4
          SA6    A1          RESET LINE COUNT
          SA4    LLM         MAXIMUM NUMBER OF LINES ON PAGE
          IX5    X6-X4
          NG     X5,LST3     IF NOT AT BOTTOM OF PAGE
          BX6    X1          RESTORE LINE COUNT
          SA6    A1
 LST1A    SA1    LCT
          BX0    X1
          RJ     STB         SKIP TO BOTTOM OF PAGE
 LST2     RJ     LSL         LIST LAST LINE ON PAGE
          RJ     LFL         LIST FIRST LINE
          EQ     LST4
 
 LST3     WRITEC SCR1,(=2L0 )
          WRITEC SCR1,(=2L0 )
 LST4     SA1    DCD+1       CHECK COLUMN 2 FOR TABLE FLAG
          SX2    X1-1RE      CHECK FOR EJECT
          SX1    X1-1RT
          NZ     X2,LST4A    IF NOT EJECT CARD
          SA2    TOG
          NZ     X2,LST4B    IF INTERNAL TOGGLE IS ON - LIST THE CARD
          SX7    1R          CLEAR *E*
          SA7    DCD+1
          WRITES SCR1,LNE,NCR+2
          SA1    LCT
          SX0    X1+1        SET SPACE COUNT
          RJ     STB
          SA2    LLM
          SX6    X2-1
          SA6    LCT         RESET LINE COUNT
          EQ     LST4D       CONTINUE
 
 LST4A    NZ     X1,LST4B    IF NOT TABLE CARD
          SA2    TOG         CHECK FOR INTERNAL NO ASTERISK
          NZ     X2,LST4B    IF SO
          SA2    NT          CHECK STATUS OF TABLE GENERATOR
          NZ     X2,LST4B    IF OFF
          RJ     TAB         PROCESS TABLE
          EQ     LST4C       PROCESS THE NEXT CARD
 
 LST4B    WRITES SCR1,LNE,NCR+2  WRITE CARD TO DOC FILE
 LST4D    SA1    LCT         BUMP LINE COUNT
          SX6    X1+B1
          SA6    A1
          READS  I,DCD,NCR   READ NEXT CARD
          NZ     X1,ABT      IF PREMATURE EOR/EOF
          RJ     CTA         COUNT ASTERISKS
 
 LST4C    SA2    NAS         CHECK FOR END OF INTERNAL DOCUMENTATION
          IX4    X1-X2
          PL     X4,LST5     IF END
          ZR     X1,LST7     CHECK FOR END OF DOCUMENTATION
          SA5    LCT         CHECK FOR END OF PAGE
          SA4    LLM         LINE LIMIT
          IX5    X5-X4
          NG     X5,LST4     IF NOT AT BOTTOM OF PAGE
          EQ     LST2
 
 LST5     SA1    TOG         CHECK TOGGLE
          NZ     X1,LST6     IF ON
          SA2    MAS         SAVE MINIMUM EXT * COUNT
          MX7    0
          BX6    X2
          SA7    A2          SET MINIMUM AST TO 0
          SA6    A1          SET TOGGLE
          EQ     LST1        GO LIST CARD
 
 LST6     MX7    0           RESET TOGGLE
          BX6    X1
          SA7    A1
          SA6    MAS         RESET MINIMUM FOR EXT DOC
          EQ     LST1        GO LIST CARD
 
 LST7     SA1    TOG         CHECK MODE
          ZR     X1,LST      IF EXTERNAL
          RJ     GFW
          MX0    24          CHECK FOR END CARD
          SA2    =4LEND
          BX6    X0*X1
          BX6    X6-X2
          SA0    PRC         SET EXIT FOR END
          ZR     X6,EDC      IF *END* CARD
          SA5    LCT
          SA4    LLM         CHECK FOR END OF PAGE
          IX5    X5-X4
          NG     X5,LST4     IF NOT AT BOTTOM OF PAGE
          EQ     LST2
 LSL      SPACE  4,10
**        LSL - LIST LAST LINE.
*
*         USES   A - 1, 6, 7.
*                X - 0, 1, 5, 6, 7.
*
*         CALLS  CVT.
 
 
 LSL      PS     0           ENTRY/EXIT
          WRITEC SCR1,(=2L  )
          SA1    CHP         CHAPTER COUNT
          RJ     CVT         CONVERT THE CHAPTER COUNT TO DECIMAL DISP
          LX7    X7,B7
          MX0    60-18
          SA1    PGE
          BX7    -X0*X7
          BX6    X0*X1
          BX7    X6+X7
          SA7    A1
          SA1    SPG
          RJ     CVT
          MX0    42
          BX7    X0*X7       CLEAR LOW 18 BITS
          SX5    1R/
          BX7    X5+X7
          LX7    54
          SA7    A7+B1       SET SUBCHAPTER PAGE COUNT
          WRITEC SCR1,FOT    WRITE PAGE FOOTING
          WRITEC SCR1,(=2L  )
          WRITEC SCR1,SBF    WRITE PAGE SUB-FOOT
          SA1    PCT         BUMP PAGE COUNT
          SX6    X1+B1
          SA6    A1
          EQ     LSL         EXIT
 TAB      SPACE  4,20
**        TAB - PROCESS TABLE GENERATION.
*                J.C. BOHNHOFF - 70/7/4.
*
*         ENTRY  (A1) = ADDRESS OF *T* CHARACTER IN CARD.
*
*         EXIT   TABLES GENERATED AND LISTED.
*                GENERATION TERMINATED AT END OF *T* BLOCK.
*
*         USES   A - 1, 2, 6, 7.
*                B - 7.
*                X - 1, 2, 4, 6, 7.
*
*         CALLS  ASD, ASF, CTA, DXB, LFL, LSL, LTB, STL.
 
 
 TAB      PS     0           ENTRY/EXIT
          SA1    A1+B1       READ SECOND CHARACTER TO CHECK FOR HEADER
                             *OFF*
          SX6    1R,
          MX7    0
          SA6    DCD+NCR     TERMINATE CARD STRING BUFFER
          SA7    A6+1
          SX6    X1-1R
          SA6    PBP         SET *PRINT BIT POSITIONS* FLAG
 
 TAB0     SX6    1R-
          SB7    71
 TAB0A    SA6    AST+B7
          SB7    B7-1
          NZ     B7,TAB0A
          RJ     STL         SET TABLE LABEL
          SX7    0           CLEAR TOTAL BIT COUNT
          SX6    TCL         AND SET POINTER TO BEGINNING OF CONTENT
                             LINE BUFFER
          SA7    TBC
          SA6    TCLP
 
 TAB1     RJ     ASD         ASSEMBLE DIGIT FIELD
          ZR     X1,TAB3     IF END OF CARD
          RJ     DXB         CONVERT DIGIT FIELD TO BINARY
          NZ     X4,TAB2     IF DIGIT FIELD ERROR
          SX7    X6-61       CHECK LEGALITY OF FIELD
          PL     X7,TAB2
          RJ     ASF         ASSEMBLE TABLE FIELD
          EQ     TAB1        CONTINUE FORMING TABLE
 
 TAB2     WRITES SCR1,LNE,NCR+2 LIST THE BAD CARD NORMALLY
          SA1    LCT         ADVANCE LINE COUNT
          SX7    X1+B1
          SA7    A1
          SA2    LLM         CHECK FOR END OF PAGE
          IX6    X7-X2
          NG     X6,TAB4     IF NOT AT BOTTOM OF PAGE
          RJ     LSL         LIST LAST LINE ON PAGE
          RJ     LFL         LIST FIRST LINE
          EQ     TAB4
 
 TAB3     RJ     LTB         LIST TABLE ENTRY
 
 TAB4     READS  I,DCD,NCR   READ NEXT CARD
          NZ     X1,ABT      IF PREMATURE EOR/EOF
          RJ     CTA         COUNT ASTERISKS
          ZR     X1,TAB      **RETURN - IF NOT COMMENT CARD
          SA2    DCD+1       CHECK FOR CONTINUATION OF TABLE BLOCK
          SX4    X2-1RT
          NZ     X4,TAB      **RETURN IF NOT *T CARD
          SA1    A2+B1       READ NEXT CHARACTER FOR *STL*
          EQ     TAB0        GO PROCESS THE CARD
 STL      SPACE  4,20
**        STL - SET TABLE LABEL IF ANY.
*                J.C. BOHNHOFF - 70/07/11.
*
*         ENTRY  (A1) = ADDRESS+1 OF *T* CHARACTER.
*
*         EXIT   (A1) = ADDRESS OF LAST CHARACTER OF LABEL OR ADDRESS
*                OF FIRST CHARACTER BEFORE DIGIT FIELD IF NO LABEL.
*
*         USES   A - 1, 2, 6, 7.
*                X - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  ASF, MVE.
 
 
 STL1     SX4    1R          SPACE
          SA2    A1          PRESET (A2)
          SX5    X4+B1       COMMA
 
 STL1A    SA2    A2+1        SEARCH FOR END OF TAG
          ZR     X2,STL      IF END OF CARD
          IX3    X4-X2       COMPARE SPACE
          BX7    X5-X2       COMPARE COMMA
          ZR     X7,STL1B    IF COMMA
          NZ     X3,STL1A    IF NOT SPACE
          BX7    X5
          SA7    A2          REPLACE SPACE WITH COMMA
 
 STL1B    SX7    TCF+1       SET PARAMS FOR ASF
          MX6    0           CLEAR RESIDUE FROM TOTAL BIT COUNT
          SA6    TBC
          SX6    9
          SA7    TCLP
          RJ     ASF         ASSEMBLE LABEL INTO LIST LINE
 
 STL      PS
          SX1    9           CLEAR BEGINNING OF CONTENT LINE
          SX2    BLN
          SX3    TCF
          RJ     =XMVE=
 
 STL2     SA1    A1+1        CHECK NEXT CHARACTER
          SX3    X1-1R
          ZR     X1,STL      IF END OF CARD
          ZR     X3,STL2     IF ANOTHER BLANK
          SX3    X1-1RZ-1
          SA1    A1-1        BACKSPACE
          NG     X3,STL1     IF ALPHA
          EQ     STL         **RETURN - NO LABEL
 ASD      SPACE  4,20
**        ASD - ASSEMBLE DIGIT FIELD.
*                J.C. BOHNHOFF - 70/7/4.
*
*         ENTRY  (A1)= ADDRESS OF CHARACTER PRECEDING A SUPPOSED
*                DIGIT FIELD.
*                DCD MUST BE ZERO TERMINATED.
*
*         EXIT   (X5) = LEFT JUSTIFIED DISPLAY CODED DIGIT FIELD.
*                (B7) = NONZERO.
*                (X1) = 0 IF END OF CARD ENCOUNTERED BEFORE DIGIT FIELD.
*                LEADING SPACES ARE IGNORED AND ASSEMBLY TERMINATES
*                WHEN A */* IS ENCOUNTERED.
*
*         USES   A - 1.
*                B - 2, 3, 7.
*                X - 1, 3, 4, 5.
 
 
 ASD1     ZR     X1,ASD      IF END OF CARD ENCOUNTERED
          SX3    X1-1R       CHECK FOR LEADING SPACE
          NZ     X3,ASD1A    IF FIRST NON-BLANK CHARACTER
          SA1    A1+1        READ NEXT CHARACTER
          EQ     ASD1        LOOP TILL END OF CARD OR FIRST NON-BLANK
 
 ASD1A    SX3    X1-1R0      CHECK FOR LEADING NUMERIC
          SX5    -1          FORCE DXB ERROR IF NOT NUMERIC
          NG     X3,ASD      IF ALPHA
          SX3    X3-10
          NG     X3,ASD2     IF NOT SPECIAL CHARACTER
          SX3    X1-1R,      CHECK FOR COMMA AS FIRST CHARACTER
          NZ     X3,ASD      IF NOT COMMA
          SX1    0           FLAG END-OF-CARD
          EQ     ASD         **RETURN
 
 ASD2     SX3    X1-1R/      CHECK FOR FIELD SEPERATOR
          ZR     X1,ASD      **RETURN - IF EOC
          ZR     X3,ASD3     IF SEPERATOR
          LX4    6           SHIFT ASSEMBLY
          BX4    X4+X1       INSERT NEXT CHARACTER
          SB3    B3-B2       ADVANCE BIT COUNT
          SA1    A1+B1       READ NEXT CHARACTER
          EQ     ASD2
 
 ASD3     LX5    X4,B3       LEFT JUSTIFY THE DIGITS
          SB7    1
 
 ASD      PS                 ENTRY/EXIT
          SB2    6
          SB3    60          INITIALIZE ASSEMBLY BIT COUNT
          MX4    0           CLEAR ASSEMBLY REGISTER
          SA1    A1+B1       READ FIRST CHARACTER TO BE CONSIDERED
          EQ     ASD1        GO ASSEMBLE
 ASF      SPACE  4,20
**        ASF - ASSEMBLE TABLE FIELD INTO LINE.
*                J.C. BOHNHOFF - 70/7/4.
*
*         ENTRY  (A1)= ADDRESS OF CHARACTER PRECEDING A SUPPOSED
*                NAME FIELD.
*                (X6) = NUMBER OF BITS IN FIELD.
*
*         EXIT   FIELD ASSEMBLED INTO TABLE LINE BUFFER.
*
*         USES   A - 1, 3, 4, 7.
*                X - 1, 3, 4, 5, 6, 7.
 
 
 ASF      PS                 ENTRY/EXIT
          SA3    TBC         TOTAL BIT COUNT
          SA4    TCLP        TABLE CONTENT LINE POINTER
          IX7    X3+X6       ADVANCE TOTAL BIT COUNT
          SA7    A3
          SX5    X6-1        DECREMENT NUMBER OF BITS IN FIELD
          NG     X5,ASF6     IF NEGATIVE BIT COUNT
          NZ     X5,ASF1     IF NOT SINGLE BIT FIELD
          SX5    X4-TCL+AST+1
          SX7    1R+
          SA7    X5
          SA1    A1+B1
          BX7    X1
          EQ     ASF5
 
 ASF1     SA1    A1+B1       READ NAME CHARACTER
          SX6    X6-1        DECREMENT BIT COUNT
          BX7    X1
          ZR     X1,ASF4     IF END OF CARD
          SX3    X1-1R,      CHECK FOR COMMA SEPERATOR
          ZR     X3,ASF4     IF COMMA
          ZR     X6,ASF1A    IF TIME TO INSERT FIELD SEPERATOR
          SA7    X4          STORE CHARACTER IN FIELD
          SX4    X4+B1       ADVANCE CHARACTER POINTER
          EQ     ASF1        CONTINUE
 
 ASF1A    SA1    A1+1        SEARCH FOR END OF NAME FIELD
          SX3    X1-1R,
          ZR     X1,ASF2     IF END OF STATEMENT
          NZ     X3,ASF1A    CONTINUE IF NOT END
 ASF2     SX7    1R/         STORE FIELD SEPERATOR
          SA7    X4
          SX4    X4+B1       ADVANCE CHARACTER POINTER
 ASF3     BX7    X4          RESTORE CHARACTER POINTER
          SA7    A4
          EQ     ASF         **RETURN
 
 ASF4     SX7    1R          PROPAGATE SPACES UNTIL FIELD EXHAUSTED
          ZR     X6,ASF2     IF TIME TO INSERT FIELD SEPERATOR
          SA7    X4          STORE CHARACTER IN FIELD
          SX6    X6-1        DECREMENT BIT COUNT
          SX4    X4+B1       ADVANCE CHARACTER POINTER
          EQ     ASF4        CONTINUE
 
 ASF5     SA7    X4          STORE SINGLE CHARACTER
          SX4    X4+1        ADVANCE CHARACTER POINTER
 ASF6     SA1    A1+1        SCAN TILL END OF FIELD
          SX3    X1-1R,
          ZR     X1,ASF3     IF END OF STATEMENT
          ZR     X3,ASF3     IF TERMINATOR
          EQ     ASF6        LOOP TILL TERMINATOR
 
 TBC      BSSZ   1           HOLDS TOTAL BIT COUNT FOR ONE TABLE CARD
 TCLP     VFD    60/TCL      TABLE CONTENT LINE POINTER
 LTB      SPACE  4,20
**        LTB - LIST A TABLE ENTRY.
*                J.C. BOHNHOFF - 70/7/4.
*
*         ENTRY  (TCL) = CONTENT LINE TO BE LISTED.
*                (TCLP) = ADDRESS OF LIMIT OF *TCL*.
*                (TBC) = TOTAL BIT COUNT FOR THIS TABLE ENTRY.
*                (PBP) = 0 IF BIT POSITION HEADER LINES TO BE LISTED.
*
*         EXIT   TABLE ENTRY LISTED.
*                (PBP) .NE. 0 IF ZERO ON ENTRY.
*
*         USES   A - 1, 3, 4, 5, 7.
*                B - 6, 7.
*                X - 0, 1, 2, 3, 4, 5, 7.
*
*         CALLS  LFL, LSL, MVE, STB, WTS.
 
 
 LTB      PS                 ENTRY/EXIT
          SA4    LCT         LINE COUNT
          SX1    10          SET BLANKS AT BEGINNING OF LINE
          MX7    0
          SX2    BLN
          BX0    X4          SAVE LINE COUNT
          SX3    TPF
          SA7    ATF         CLEAR *ASTERS ONLY* FLAG
          RJ     =XMVE=
          SA1    PBP         *PRINT BIT POSITIONS* FLAG
          SA5    TBC         TOTAL BIT COUNT FOR THIS TABLE ENTRY
          NG     X1,LTBA     IF SOME PART OF THE HEADER IS NOT TO BE
                             LISTED THIS TIME
          ZR     X1,LTBB     IF FULL BIT POSITION HEADER TO BE LISTED
                             THIS BLOCK
 LTBA     MX7    60
          BX7    X1-X7
          ZR     X7,LTB1     IF ALL HEADER IS OFF
          SA7    ATF
 
 LTBB     MX7    60          TOGGLE THE FLAG
          SA7    A1
          SA3    LLM         LINE LIMIT
          NO
          SX7    X0+5
          IX3    X7-X3
          NG     X3,LTB0     IF IT WILL FIT
          RJ     STB         SKIP TO BOTTOM OF PAGE
          RJ     LSL         LIST LAST LINE ON PAGE
          RJ     LFL         LIST FIRST LINE ON PAGE
          SA1    LCT         RESTORE REGISTERS
          SA5    TBC
          BX0    X1
 
 LTB0     SA1    ATF
          NZ     X1,LTB0A    IF ASTER LINE ONLY TO BE LISTED
 LTBC     SX2    BP1L
          BX1    X5          SET WORD COUNT FOR MVE
          IX2    X2-X5
          SX3    TPL         SET DESTINATION FOR MVE - (TABLE PRNT LINE)
          RJ     =XMVE=      MOVE LINE INTO LIST BUFFER
          SB7    X5+10       SET WORD COUNT FOR WRITE
          SX2    SCR1        SET ADDRESS OF FET
          SB6    TPF
          RJ     =XWTS=      WRITE THE FIRST BIT POSITION HEADER LINE
          SX0    X0+B1       BUMP LINE COUNT
          SX2    BP2L        SET UP FOR WRITE OF 2ND HEADER LINE
          BX1    X5
          SX3    TPL
          IX2    X2-X5
          RJ     =XMVE=      MOVE SECOND LINE INTO BUFFER
          SX2    SCR1
          SB6    TPF
          SB7    X5+10
          RJ     =XWTS=      WRITE SECOND BIT POSITION HEADER LINE
          SX0    X0+1        BUMP LINE COUNT
 
 LTB0A    SX2    AST         MOVE ASTERISK LINE
          SX3    TPL-1
          SX1    X5+1
          RJ     =XMVE=
          WRITES SCR1,TPF,X5+10 WRITE ASTERISK LINE TO DEFINE TOP OF ENT
          SX0    X0+B1       BUMP LINE COUNT
          EQ     LTB2
 
 LTB1     SA3    LLM         LINE LIMIT
          SX7    X0+2        SEE IF ENTRY WILL FIT ON PAGE
          NO
          IX3    X7-X3
          NG     X3,LTB2     IF IT WILL FIT
          RJ     STB         SKIP TO BOTTOM OF PAGE
          RJ     LSL         LIST LAST LINE
          RJ     LFL         LIST FIRST LINE
          SA1    LCT         RESTORE REGISTERS
          SA5    TBC
          BX0    X1
          EQ     LTBC        WRITE NEW HEADER
 
 LTB2     WRITES SCR1,TCF,X5+10 WRITE TABLE CONTENT LINE
          SX0    X0+B1       BUMP LINE COUNT
          SX1    X5+B1
          SX2    AST         MOVE ASTERISKS
          SX3    TPL-1
          RJ     =XMVE=
          WRITES SCR1,TPF,X5+10 WRITE ASTERISK LINE TO DEFINE BTTM OF EN
          SX7    X0+1
          SA7    LCT         RESTORE BUMPED LINE COUNT
          EQ     LTB         **RETURN
 
 PBP      BSSZ   1           PRINT BIT POSITIONS FLAG
 ATF      BSSZ   1           ASTERISK ONLY FLAG
 STB      SPACE  4,10
**        STB - SKIP TO BOTTOM OF PAGE.
*                J.C. BOHNHOFF - 70/07/11.
*
*         ENTRY  (X0) = CURRENT LINE COUNT.
*
*         EXIT   FORM POSITIONED AT *LINP*.
*
*         USES   A - 2.
*                X - 0, 2, 5, 6.
 
 
 STB      PS
          BX0    -X0
          SA2    LLM
          NO
          IX0    X0+X2
          AX5    X0,B1       /2= NUMBER OF DOUBLE SPACES NEEDED
          LX6    X5,B1
          IX0    X0-X6       NUMBER OF SINGLE SPACES NEEDEAFTER DOUBLES
 
 STB1     ZR     X5,STB2     IF DONE DOUBLE SPACEING
          WRITEC SCR1,(=2L0 )
          SX5    X5-1
          EQ     STB1
 
 STB2     ZR     X0,STB      **RETURN - IF AT BOTTOM
          WRITEC SCR1,(=2L  )
          EQ     STB
 CVT      SPACE  4,10
**        CVT - CONVERT NUMBER FROM OCTAL TO DECIMAL DISPLAY CODE.
*
*         ENTRY  (X1) = LOW 18 BITS OF NUMBER TO BE CONVERTED.
*
*         EXIT   (X7) = LEFT JUSTIFIED DISPLAY CODED NUMBER.
*                (B7) = 6*NUMBER OF DIGITS IN CONVERTED NUMBER.
*
*         USES   A - 2, 3, 4.
*                B - 0, 4, 5, 6, 7.
*                X - 1, 2, 3, 4, 6, 7.
 
 
 CVT1     DX7    X1*X2
          FX1    X1*X2
          LX4    54
          SB4    X1
          FX6    X3*X7       CALCULATE REMAINDER DIGIT
          SB7    B7+B5
          SX6    X6+B6
          IX4    X6+X4
          NZ     B4,CVT1
          BX7    X4          LEFT JUSTIFY NUMBER
          LX7    54
 
 CVT      PS     0           ENTRY/EXIT
          SA2    CVTA
          SA3    A2+B1
          SA4    A3+B1
          PX1    X1
          SB7    B0          SET DIGIT COUNT
          SB5    6
          SB6    -22B
          EQ     CVT1
 
 CVTA     DATA   0.1000000001P48
          DATA   10.0P0
          DATA   1H
 ABT      SPACE  4,10
**        ABT - TERMINATE ON PREMATURE EOR/EOF.
*
*         USES   A - 7.
*                X - 7.
 
 
 ABT      SX7    B1          SET NUMBER OF COPIES TO 1
          SA7    N
          WRITEC SCR1,(=2L  )
          WRITEC SCR1,(=2L  )
          WRITEC SCR1,(=C* PREMATURE EOR/EOF ON SOURCE FILE.*)
          EQ     DOC3        EXIT
 CPY      SPACE  4,10
**        CPY - COPY SCRATCH FILE TO OUTPUT FILE.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 7.
*
*         MACROS READ, READW, RECALL, REWIND, WRITER, WRITEW.
 
 
 CPY      PS     0           ENTRY/EXIT
          SA1    PD
          ZR     X1,CPY0     IF FORMAT EFFECTOR NOT TO BE WRITTEN
          WRITEW I,PD,1      WRITE FORMAT EFFECTOR
          BX6    X6-X6
          SA6    PD
 CPY0     SA1    NI          CHECK FOR NO INPUT FILE
          ZR     X1,CPY3    IF NONE
 CPY1     READW  SCR1,DCD,100B
          NZ     X1,CPY2     IF EOR/EOF
          WRITEW I,DCD,100B  WRITE FROM WORKING BUFFER
          EQ     CPY1        COPY SOME MORE
 
 CPY2     SB7    X1-DCD      GET WORD COUNT OF LAST TRANSFER
          WRITEW I,DCD,B7    TRANSFER LAST FEW WORDS
          READ   SCR1
 CPY3     SA1    TC          CHECK FOR TABLE OF CONTENTS
          ZR     X1,CPY6     IF NO TABLE OF CONTENTS
          REWIND SCR2,R
          READ   SCR2
 CPY4     READW  SCR2,DCD,100B
          NZ     X1,CPY5     IF EOR/EOF
          WRITEW I,DCD,100B  WRITE FROM WORKING BUFFER
          EQ     CPY4        COPY SOME MORE
 
 CPY5     SB7    X1-DCD      GET WORD COUNT OF LAST TRANSFER
          WRITEW I,DCD,B7    TRANSFER LAST FEW WORDS
          RECALL SCR2
 CPY6     READW  SCR1,DCD,100B
          NZ     X1,CPY7     IF EOR/EOF
          WRITEW I,DCD,100B  WRITE FROM WORKING BUFFER
          EQ     CPY6        COPY SOME MORE
 
 CPY7     SB7    X1-DCD      GET WORD COUNT OF LAST TRANSFER
          WRITEW I,DCD,B7    TRANSFER LAST FEW WORDS
          WRITER I,R
          RECALL SCR1
          EQ     CPY         EXIT
 EDC      SPACE  4,10
**        EDC - *END* CARD PROCESSOR.
*
*         ENTRY  (A0) - EXIT ADDRESS.
*
*         USES   A - 2, 4, 5, 6, 7.
*                B - 2.
*                X - 2, 4, 5, 6, 7.
*
*         CALLS  LSL.
 
 
 EDC      SA2    FLF         CHECK TO SEE IF ANYTHING HAS BEEN LISTED
          ZR     X2,EDC3     IF NOT
          SA5    LCT
          SA4    LLM         LINE LIMIT
          IX5    X5-X4
          BX6    X5
          LX6    59-0        CHECK EVEN OR ODD
          ZR     X5,EDC2     IF AT BOTTOM OF PAGE
          NG     X6,EDC1     IF EVEN
          WRITEC SCR1,(=2L  )
          SX5    X5+B1
 EDC1     ZR     X5,EDC2     IF AT BOTTOM OF PAGE
          WRITEC SCR1,(=2L0 )
          SX5    X5+2
          EQ     EDC1        LOOP TO BOTTOM OF PAGE
 
 EDC2     RJ     LSL         LIST LAST LINE
 EDC3     MX7    0
          SA7    FLF         CLEAR FIRST LINE FLAG
          SA7    LSCA        CLEAR LIST CARD STACK
          SA7    FCR         RESET FIRST CHARACTER TO SCAN FROM
          SA7    XFL         CLEAR LIST *X* FLAG
          SA7    TOG         CLEAR TOGGLE
          SA5    EDAS        RESET ASTERISK COUNT FOR DOC TYPE
          SA4    IDAS
          BX6    X5
          LX7    X4
          SA6    MAS
          SA7    NAS
          SB2    A0
          JP     B2          EXIT
 COL      SPACE  4,10
**        COL - PROCESS *COL* CARDS.
*
*         USES   X - 2, 3, 4, 5, 6.
*                A - 2, 6.
*                B - 5, 7.
*
*         CALLS  DXB.
 
 COL      BSS    0           ENTRY
 COL1     SA2    B5          FIND COLUMN NUMBER
          SX3    X2-1R       CHECK FOR SPACE
          SB5    B5+B1
          ZR     X2,CMP1     IF END OF LINE
          ZR     X3,COL1     IF A SPACE
          SB7    54          SET SHIFT COUNT
          SX5    B0+         INITIALIZE ASSEMBLY AREA
 COL2     LX2    B7          SHIFT CHARACTER
          SB7    B7-6        ADJUST SHIFT COUNT
          BX5    X5+X2       ADD TO ASSEMBLED DATA
          SA2    B5          NEXT CHARACTER
          SB5    B5+B1
          ZR     X2,COL3     IF END OF CARD
          SX3    X2-1R
          NZ     X3,COL2     IF NOT SPACE
 COL3     RJ     DXB         CONVERT COLUMN NUMBER
          NZ     X4,CMP1     IF NOT NUMERIC
          SA6    CCM         RESET COMMENT COLUMN
          EQ     CMP1        EXIT
 CTX      SPACE  4,10
**        CTX - PROCESS *CTEXT* CARDS.
*
*         USES   A - 1, 7.
*                X - 1, 7.
 
 
 CTX      SA1    XFL         CHECK LIST *X* FLAG
          NZ     X1,CMP1     EXIT IF ON
          SX7    20          RESET LIST LIMITS
          SA7    MAS
          SA7    NAS
          EQ     CMP1        EXIT
 EDX      SPACE  4,10
**        EDX - PROCESS *ENDX* CARDS.
*
*         USES   A - 1, 4, 5, 6, 7.
*                X - 1, 4, 5, 6, 7.
 
 
 EDX      SA1    XFL         CHECK LIST *X* FLAG
          NZ     X1,CMP1     EXIT IF ON
          SA4    EDAS        RESTORE LIMITS ON ASTERISK COUNTS
          SA5    IDAS
          BX6    X4
          LX7    X5
          SA6    MAS
          SA7    NAS
          EQ     CMP1        EXIT
 BKD      SPACE  4,10
**        BKD - PROCESS BLOCK DATA SUBPROGRAMS.
*
*         ENTRY  (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
*                EXIT TO *CMP1* IF *COMPASS* PROGRAM.
*
*                A - 1, 2, 3, 4, 6.
*                B - 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  CVT.
 
 
 BKD      BSS    0           ENTRY
          SA4    PTYP
          ZR     X4,CMP1     IF *COMPASS* PROGRAM
          SB6    B5          SAVE ADDRESS OF NEXT CHARACTER
          SX2    1R
 BKD1     SA3    B6          CHECK FOR PRESENCE OF NAME
          SB6    B6+B1
          IX6    X3-X2
          ZR     X3,BKD2     IF NO NAME FOUND
          ZR     X6,BKD1     SKIP BLANKS
          EQ     FTN         GO PROCESS AS FORTRAN
 
 BKD2     SA1    BKDA        BLOCK COUNT
          SX6    X1+B1
          SA6    A1
          RJ     CVT         CONVERT BLOCK COUNT
          MX0    42
          SA2    BKDB
          LX7    X7,B7
          BX6    X0*X2
          BX7    -X0*X7      GET NUMBER
          BX7    X6+X7
          MX0    60-6
          SB7    10
          SB6    B5
 
 BKD3     LX7    6           DECODE NAME
          SB7    B7-B1
          BX6    -X0*X7      GET CHARACTER
          SA6    B6
          SB6    B6+B1
          NZ     B7,BKD3     LOOP FOR 10 CHARACTERS
          EQ     FTN         GO PROCESS AS FORTRAN
 
 BKDA     DATA   1           BLOCK DATA SUBROUTINE COUNT
 BKDB     VFD    42/0HNUMBER-,18/
 LSC      SPACE  4,10
**        LSC - PROCESS *LIST* CARD.
*
*         ENTRY  (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
*         USES   A - 2, 4, 5, 6, 7.
*                B - 7.
*                X - 2, 3, 4, 5, 6, 7.
 
 
 LSC      SB7    B1          SET .NOT. *-* FLAG
          SA2    B5          READ NEXT CHARACTER
          SX3    1R
 LSC1     ZR     X2,CMP1     EXIT IF NO LIST PARAMETERS LEFT
          IX6    X2-X3
          BX4    X2
          SA2    A2+B1       READ NEXT CHARACTER
          ZR     X6,LSC1     SKIP BLANKS
          SA5    A2+B1       READ FOLLOWING CHARACTER
          SB7    X4-1R-      CHECK FOR *-*
          ZR     B7,LSC2     IF PRESENT
          SA5    A2
          SX2    X4
 LSC2     SX6    X2-1RL      *L*
          SX7    X2-1RX      *X*
          SX2    X2-1R*      ***
          ZR     X6,LSC4
          ZR     X7,LSC6
          ZR     X2,LSC9
          EQ     LSC8        PUSH LIST OPTION ONTO STACK
 LSC3     IX2    X5-X3       CHECK FOR END
          ZR     X2,CMP1     IF END OF CARD
          SA2    A5+B1
          EQ     LSC1        CONTINUE SEARCH
 
 LSC4     NZ     B7,LSC5     PROCESS *L*
          SX7    20          PROCESS *-L*
          SA7    MAS         RESET LIST LIMITS
          SA7    NAS
          EQ     LSC8        TRY AGAIN
 
 LSC5     SA4    EDAS        RESET LIST LIMITS FOR *L* CARD
          SA2    IDAS
          BX6    X4
          LX7    X2
          SA6    MAS
          SA7    NAS
          EQ     LSC8        TRY AGAIN
 
 LSC6     NZ     B7,LSC7     PROCESS *X*
          SA7    XFL         CLEAR LIST X FLAG
          EQ     LSC8        TRY AGAIN
 LSC7     SX6    1RX
          SA6    XFL         SET LIST X FLAG
 LSC8     SA2    MAS
          SA4    NAS
          LX2    40
          LX4    20
          BX7    X2+X4
          SA4    XFL
          BX7    X7+X4
          SA2    LSCA        LIST OPTIONS TABLE
          SX6    X2+B1
          SA6    A2
          SX4    X6-LSCBL
          PL     X4,LSC10    IF LIST CARD LIMIT REACHED
          SA7    LSCB+X6
          EQ     LSC3        TRY AGAIN
 
 LSC9     SA2    LSCA
          SX6    X2-1
          NG     X6,LSC3     IF NO STACK
          SA6    A2+
          SX4    X6-LSCBL
          PL     X4,LSC3     IF STILL ABOVE LIMIT
          SA4    LSCB+X6
          MX2    20
          BX6    X2*X4       GET MAS
          BX7    -X2*X4      GET NAS
          LX6    20
          LX7    40
          SX7    X7
          SA7    NAS
          SA6    MAS
          SX7    X4
          SA7    XFL
          EQ     LSC3
 
 LSC10    MESSAGE (=C* LIST CARD LIMIT - CARD IGNORED.*)
          EQ     LSC3
 
 
 LSCA     CON    0
 LSCB     CON    0
          BSSZ   NLCA
 LSCBL    EQU    *-LSCB
 TIT      SPACE  4,10
**        TIT - PROCESS TITLE CARD.
*
*         ENTRY  (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
*         USES   A - 1, 2, 7.
*                B - 5, 6, 7.
*                X - 1, 2, 3, 6, 7.
 
 
 TIT      MX7    0           CLEAR TITLE FROM SPECIAL CARD LIST
          SA7    CMPC
          SA2    B5          READ NEXT CHARACTER
          SA1    =5L
          SX3    1R
 TIT1     IX6    X2-X3       CHECK FOR BLANK
          ZR     X2,CMP1     EXIT IF NO TITLE
          SA2    A2+B1       READ NEXT CHARACTER
          ZR     X6,TIT1     SKIP BLANKS
          SX1    2R1
          SB7    8
          SB6    5           SET WORD COUNT
          BX7    X1
          SA2    A2-B1       READ LAST CHARACTER
          SB5    B0
          EQ     TIT3
 
 TIT2     SB7    10
          SA7    B5+HDG      STORE WORD
          SB6    B6-B1       DECREMENT LOOP COUNT
          SB5    B5+B1
          MX7    0
          ZR     B6,CMP1     IF DONE
 TIT3     LX7    6           ENCODE 10 CHARACTERS
          SB7    B7-B1       DECREMENT CHARACTER COUNT
          BX7    X7+X2
          SA2    A2+B1       READ NEXT CHARACTER
          NZ     B7,TIT3     LOOP FOR 10 CHARACTERS
          EQ     TIT2        GET NEXT WORD
          TITLE  COMMON DECKS.
**        COMMON DECKS.
 
*CALL COMCSFN
*CALL COMCMVE
*CALL COMCWTO
*CALL COMCDXB
*CALL COMCRDC
*CALL COMCRDO
*CALL COMCRDH
*CALL COMCRDS
*CALL COMCRDW
*CALL COMCWTC
*CALL COMCWTS
*CALL COMCWTW
*CALL COMCCIO
*CALL COMCSYS
          TITLE  DECODING AREA.
          USE    DECODE      DECODE AREA
 
 TCF      BSS    0           TABLE CONTENT LINE
          DUP    9,1
          DATA   1R
          DATA   1R/
 
 TCL      BSSZ   73
 
 BLN      BSS    0           SOME BLANKS
          DUP    11,1
          DATA   1R
 
 AST      BSS    0           BUNCH OF ASTERISKS
          DUP    72
          DATA   1R-
          ENDD
 
 BP1      BSS    0           BIT POSITION TEMPLATE FOR LINE 1
 NUM      SET    59
          DUP    1000
 TEN      SET    NUM/10
          DUP    9,1
          CON    1R
          IFNE   TEN,0,2
          CON    TEN+1R0
          ELSE   1
          CON    1R
 NUM      SET    NUM-10
          IFLT   NUM,0,1
          STOPDUP
          ENDD
 
 BP1L     BSS    0           DEFINE END OF TEMPLATE
 
 BP2      BSS    0           BIT POSITION TEMPLATE FOR LINE 2
 
 NUM      SET    9
          DUP    60
          VFD    60/NUM+1R0
 NUM      SET    NUM-1
          IFLT   NUM,0,1
 NUM      SET    9
          ENDD
 
 BP2L     BSS    0           DEFINE END OF TEMPLATE
 
 
*         ARGUMENT LIST.
 
 ARGA     BSS    0
 I        ARG    ARGB+5,INPUT
 S        ARG    ARGB,S
 L        ARG    O,O
 N        ARG    N,N
 T        ARG    ARGB+1,T
 C        ARG    ARGB+2,C
 P        ARG    ARGB+3,P
 NR       ARG    ARGB+4,NR
 NT       ARG    ARGB+4,NT
 TC       ARG    ARGB+4,TC
          CON    0           END OF TABLE
 
*         ASSUMED PARAMETER VALUES.
 
 ARGB     CON    0LSOURCE+3
          CON    0LINT
          CON    0L03B
          BSS    1
          CON    0LOFF
          CON    0LINPUT
 
 LNE      DATA   1R          ENCODE AREA FOR PRINT LINE
          DATA   1R
 
 DCD      BSS    0           DECODE AREA FOR CARD IMAGE
 
 TPF      EQU    LNE
 TPL      EQU    LNE+10
 
 ARG      SPACE  4,3
**        ARG - PROCESS ARGUMENTS.
 
 
*CALL COMCARG
 CKO      SPACE  4,10
**        CKO - CHECK OPTIONS SELECTED.
*
*         USES   A - 1, 2, 3, 5, 6, 7.
*                B - 2, 6, 7.
*                X - 1, 2, 3, 5, 6, 7.
*
*         CALLS  DXB.
 
 
 CKO      PS     0           ENTRY/EXIT
          SA1    S           CHECK SOURCE FILE NAME
          ZR     X1,NOF      IF NO SOURCE FILE
          SA1    O           CHECK OUTPUT FILE NAME
          ZR     X1,NOF      NO OUTPUT FILE
          SA5    N
          SB7    N           SET DECIMAL BASE
          RJ     DXB         CONVERT NUMBER
          NZ     X4,DOC7     IF ILLEGAL
          SA6    N
          ZR     X6,NOF      IF NO COPIES REQUESTED
          SA5    C
          SB7    0           SET OCTAL BASE
          RJ     DXB
          NZ     X4,DOC7     IF ILLEGAL
          SX7    X6-64
          ZR     X6,DOC7     IF NO CHARACTER
          PL     X7,DOC7     IF NOT VALID CHARACTER
          SA6    C           SET CHECK CHARACTER
          SA5    P
          SB7    P           SET DECIMAL BASE
          RJ     DXB
          NZ     X4,DOC7     IF PAGE SIZE IS ILLEGAL
          SX7    X6-MPGS
          NG     X7,DOC7     IF .LT. MINIMUM PAGE SIZE
          SA6    LLM         SET PAGE SIZE
          SA1    T           DOCUMENTATION TYPE
          LX1    18
          SX6    3REXT
          BX5    X1-X6
          SX7    3RINT
          BX6    X1-X7
          ZR     X5,CKO1     IF EXTERNAL
          NZ     X6,DOC7     IF ILLEGAL
          SX6    4
          SA6    IDAS
          SX7    2           SET INTERNAL FLAGS
          SA6    NAS
          SA7    MAS
          SA7    EDAS
          SA2    =10H INTERNAL
          BX6    X2
          SA6    RIFD        CHANGE TITLE PAGE
          SA6    HDG2        CHANGE HEADER LINE
 
*         SPLIT FL FOR BUFFERS.
 
 CKO1     SX6    A0          SET AVAILABLE FL
          SB6    BUF
          SA6    I+4         SET LIMIT ON INPUT BUFFER
          SX7    A0-B6       GET REMAINDER OF CORE
          AX7    1           DIVIDE BY 2
          SX7    X7+B6
          SA7    SCR1+4      SET LIMIT ON SCRATCH FILE
          SA7    I+1         SET FIRST ON INPUT FILE
          SA7    A7+B1       IN
          SA7    A7+B1       OUT
          SA1    MAS         SET LIST OPTION STACK
          SA2    NAS
          SA3    XFL
          LX1    40
          LX2    20
          BX6    X1+X2
          BX6    X6+X3
          SA6    LSCB
          EQ     CKO         EXIT
 
*         PROCESS NO OUTPUT ERRORS.
 
 NOF      MESSAGE (=C* NO I/O REQUESTED.*)
          ENDRUN
 
 SIZ      EQU    *-DCD       SIZE OF SET-UP AREA
 
          IFLE   SIZ,NCR,1
          BSSZ   NCR-SIZ+1   ZERO OUT REMAINDER OF DECODE AREA
          USE    *
 CTF      SPACE  4,15
**        CTF - CHECK TERMINAL OUTPUT FILE.
*
*         ENTRY  (O) = PRINT FILE NAME.
*
*         EXIT   (PD) = 0 IF PRINT FILE IS A TERMINAL FILE.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*
*         CALLS  STF.
 
 
 CTF      SUBR               ENTRY/EXIT
          SA1    O           GET CURRENT FILE NAME
          BX6    X1
          SA6    CTFA        USE LOCAL FET FOR *STF*
          SX2    A6
          RJ     STF
          NZ     X6,CTFX     IF NOT A TERMINAL FILE
          SA6    PD
          EQ     CTFX        EXIT
 
 
 CTFA     FILEB  CTFA,4,(FET=6)
 CTP      SPACE  4,15
**        CTP - CALCULATE TITLE PAGE.
*
*         ENTRY  (LLM) = PAGE SIZE.
*
*         EXIT   (HDSL1,HDSL2) = BLANK LINES COUNT FOR TITLE PAGE.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 6, 7.
*                B - 6, 7.
 
 
 CTP      SUBR               ENTRY/EXIT
          SA1    LLM         GET PAGE SIZE
          SB6    B1+B1
          SX6    X1+7
          SA6    LCT         FORCE NEW TITLE
          AX6    B6,X1       DIVIDE SIZE BY 4 FOR BOTTOM LINE COUNT
          IX3    X1-X6
          SX2    3
          IX7    X1/X2
          SX7    X7-3
          SA7    HDSL1       BLANK LINE COUNT FROM TOP TO TITLE
          IX6    X3-X7
          SX6    X6-1-7
          SA6    HDSL2       BLANK LINE COUNT AFTER TITLE
          EQ     CTPX        EXIT
 BUFFERS  SPACE  4
          USE    BUFFERS
 
*         SCRATCH (TABLE OF CONTENTS) BUFFER.
 
          BSSZ   1
 SBUF     BSS    SBUFL       SCRATCH BUFFER
 
 BUF      BSS    0           RESERVE SCRATCH BUFFER
 IPP      SPACE  4,15
**        IPP - INITIALIZE PAGE PARAMETERS.
*
*         EXIT   JOB DEFAULT PAGE PARAMETERS INITIALIZED.
*
*         USES   X - 0, 1, 6.
*                A - 1, 6.
*                B - 2.
*
*         CALLS  CDD.
*
*         MACROS GETPP.
 
 
 IPP      SUBR               ENTRY/EXIT
          GETPP  IPPA,LLM,PD
          SA1    LLM         GET JOB PAGE SIZE
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          MX0    1
          SB2    B2-B1
          AX0    B2
          BX6    X0*X4       REMOVE BLANKS
          SA6    P           STORE DEFAULT JOB PAGE SIZE
          SA1    IPPA+1      GET DEFAULT SYSTEM PAGE SIZE
          MX0    -8
          AX1    12+8
          BX1    -X0*X1
          RJ     CDD
          MX0    1
          SB2    B2-B1
          AX0    B2
          BX6    X0*X4
          SA6    ARGB+3      STORE ALTERNATE DEFAULT
          EQ     IPPX        RETURN
 
 
 IPPA     BSS    2           *GETPP* RESPONSE BLOCK
 RIF      SPACE  4,10
**        RIF - READ INPUT FILE.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                X - ALL.
 
 
 RIF      PS     0           ENTRY/EXIT
          DATE   HDG1
          SA2    I
          ZR     X2,RIF      IF NO INPUT FILE
          SX7    B1          SET COMPLETE BIT
          BX7    X2+X7
          SA7    A2
          READ   I,R
          SA1    X2+2
          SA3    A1+B1
          IX4    X1-X3
          ZR     X4,RIF1     IF NO DATA
          READH  X2,FOT,7    READ INPUT CARD
          SA3    FOT
          SA2    =1L
          MX0    6
          BX7    -X0*X3
          BX7    X2+X7
          SA7    A3
          EQ     RIF1
 
 RIFA     DATA   2L1         TITLE PAGE
 RIFAL    EQU    *-RIFA
 
*         INSERT (HDSL1) BLANK LINES
 
 RIFB     DATA   1H
 RIFC     DATA   48L
 
          DATA   2L
          DATA   1H
          DATA   1H
 RIFD     DATA   C* EXTERNAL DOCUMENTATION*
 RIFBL    EQU    *-RIFB
 
*         INSERT (HDSL2) BLANK LINES
 
 RIFS     DATA   1H
          DATA   H*PUBLICATION NUMBER*
 RIFE     DATA   1H
          DATA   0           END OF LINE
 
          DATA   2L
          DATA   1H
          DATA   H*REVISION LEVEL ...*
 RIFF     DATA   5L
 
          DATA   2L
          DATA   1H
          DATA   H*REVISION DATE ....*
 RIFG     DATA   1H
          DATA   0           END OF LINE
 
 RIFSL    EQU    *-RIFS      LENGTH IN WORDS OF BOTTOM PORTION
 
 
 RIF1     SA1    FOT         MOVE PAGE FOOT INFORMATION TO TITLE PAGE
          SA2    A1+B1
          MX0    30          MASK TO SPLIT PUB NUMBER
          SA3    A2+B1
          SA4    A3+B1
          SA5    A4+B1
          BX6    X1
          LX7    X2
          SA6    RIFC        STORE FIRST WORD OF PACKAGE NAME
          SA7    A6+B1       STORE SECOND WORD
          BX6    X3
          LX7    X4
          SA6    A7+B1       STORE THIRD WORD
          SA7    A6+B1       STORE FOURTH WORD
          BX6    X0*X5       GET LAST FIVE CHARACTERS OF PACKAGE NAME
          BX7    -X0*X5      GET FIRST FIVE CHARACTERS OF PUB NUMBER
          SA6    A7+B1       STORE FIFTH WORD
          LX7    30          SHIFT FIRST 5 CHARS HIGH
          SA1    A5+B1       READ END OF PUB NO. AND REV. LEVEL
          LX1    30
          SA2    A1+B1       GET REVISION DATE
          BX6    -X0*X1      GET LAST 5 CHARS OF PUB NUMBER
          BX7    X6+X7
          BX6    X0*X1       GET REVISION LEVEL ALONE
          SA7    RIFE        STORE PUBLICATION NUMBER
          SA6    RIFF        STORE REVISION LEVEL
          SA3    RIF         MOVE EXIT BEFORE IT IS DESTROYED
          BX7    X2
          LX6    X3
          SA7    RIFG        STORE REVISION DATE
          SA7    NI          SET INPUT FOUND FLAG
          SA6    RIF4
          SA1    PCT         BUMP PAGE COUNT FOR PAGE PARITY
          SX6    X1+B1
          SA6    A1
 
          WRITEW SCR1,RIFA,RIFAL   WRITE PAGE EJECT
 
          SA5    HDSL1       GET COUNT OF BLANK LINES
 RIF2     WRITEC SCR1,(=2L  )
          SX5    X5-1
          NZ     X5,RIF2     IF MORE BLANK LINES TO WRITE
 
          WRITEW SCR1,RIFB,RIFBL   WRITE TITLE
 
          SA5    HDSL2       GET COUNT OF BLANK LINES
 RIF3     WRITEC SCR1,(=2L  )
          SX5    X5-1
          NZ     X5,RIF3     IF MORE BLANK LINES TO WRITE
 
          WRITEW SCR1,RIFS,RIFSL  WRITE BOTTOM OF PAGE
          WRITER SCR1,R
 RIF4     EQ     RIF         EXIT
 
 
*CALL     COMCCPM
*CALL     COMCCDD
*CALL     COMCSTF
 
 
 MFL=     EQU    200000B+BUF+2*BFSZ+10B
 
          USE    *
 END      SPACE  4
          END