DOCMENT 
          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 
