LO72
          IDENT  LO72,FETS,LO72 
*COMMENT  LO72 - COMPASS REFORMATTER. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          ABS 
          SST 
          ENTRY  LO72 
          ENTRY  RFL= 
          SYSCOM B1                DEFINE (B1) = 1
          TITLE  LO72 - COMPRESS OUTPUT FILES.
          TITLE  PROGRAM DOCUMENTATION. 
***       LO72 - LIST OUTPUT 72 COLUMNS.
* 
*         J. K. DOWTY, JR.    70/08/01. 
* 
          SPACE  4
***           LIST OUTPUT 72 (LO72) IS A UTILITY PROGRAM WHICH CAN
*         BE USED TO RE-FORMAT FILES ORIGINALLY INTENDED FOR A
*         LINE PRINTER.  PROPER USE OF THE PARAMETERS ALLOWS THE
*         USER TO REARRANGE EACH OUTPUT LINE AS HE DESIRES, OR
*         THE PROGRAM WILL SELECT DEFAULT VALUES ACCORDING TO 
*         THE TYPE OF SOURCE INPUT.  THE DEFAULT VALUES COMPRESS
*         ALL OUTPUT TO 72 COLUMNS FOR LISTING ON A TELETYPE. 
*             IF THE JOB ORIGINATED FROM A TELETYPE, LO72 WILL
*         ASK THE ORIGINATOR IF HE DESIRES TO CHANGE ANY OF THE 
*         RE-FORMAT PARAMETERS.  IF HE ENTERS *YES* THE PROGRAM 
*         PRINTS THE CURRENT NAME OF THE INPUT FILE ON HIS TTY AND
*         THE USER CAN THEN ENTER THE NEW FILE NAME OR JUST *CR*
*         (CARRIAGE RETURN).  THE *CR* WILL NOT CHANGE ANYTHING AND 
*         THE PROGRAM WILL OUTPUT THE NEXT VALUE.  THIS PROCEDURE 
*         CONTINUES UNTIL ALL THE PARAMETERS HAVE BEEN COVERED. 
*         IF AN *I* PARAMETER IS SPECIFIED, I.E. LO72(I=FNAME), 
*         THEN EACH RECORD OF FILE *FNAME* MUST END WITH A
*         TERMINATOR CHARACTER.  THE FOLLOWING EXAMPLE OF FILE
*         *FNAME* REQUESTS LO72 TO READ A COMPASS TYPE SOURCE FILE
*         *SOURCE*, RE-FORMAT IT TO WRITE A 105 CHARACTER LINE
*         CONTAINING THE "P" ADDRESS (N1), THE OCTAL WORD 
*         REPRESENTATION (N2), AND THE CONTENTS OF EACH COMMAND (N3)
*         TO THE OUTPUT FILE *OUTFILE*.  THE OUTPUT FILE WILL 
*         EVENTUALLY BE LISTED ON A LINE PRINTER(LP), BUT IT IS NOT 
*         TO BE REWOUND AT THIS TIME(NR). 
* 
*         COL. NO.           1         2         3
*                  1         1         1         1
*                  S=SOURCE,O=OUTFILE,T=C,H=105,LP,NR.
*                  N1=7,N2=21,N3=73.
*                  I1=9,I2=16,I3=40.
*                  O1=1,O2=8,O3=29. 
*                  EOF. 
* 
          SPACE  4
***       THE COMMAND.
* 
*         LO72(I,S,L,T,H,NR)
          SPACE  4
***       PARAMETERS. 
* 
*         I        RE-FORMAT PARAMETERS ARE ON FILE *INPUT*.
*         I=FNAME  RE-FORMAT PARAMETERS ARE ON FILE *FNAME*.
*         I=0      RE-FORMAT PARAMETERS ARE ON THE COMMAND OR 
*                  SELECT THE APPROPRIATE DEFAULT VALUES. 
* 
*         S        DATA TO BE RE-FORMATTED IS ON FILE *SCR*.
*         S=FNAME  DATA TO BE RE-FORMATTED IS ON FILE *FNAME*.
* 
*         L        RE-FORMATTED DATA LISTED TO FILE *OUTPUT*. 
*         L=FNAME  RE-FORMATTED DATA LISTED TO FILE *FNAME*.
* 
*         T        FILE TO BE RE-FORMATTED IS OF TYPE B(BATCH). 
*         T=X      FILE TO BE RE-FORMATTED IS OF TYPE X, WHERE X
*                  CAN BE:  M FOR MODIFY SOURCE DATA, 
*                           C FOR COMPASS SOURCE DATA, OR 
*                           B FOR MISCELLANEOUS SOURCE DATA.
*         T=0      FILE TYPE IS NOT GIVEN.
* 
*         H        NUMBER OF CHARACTERS PER OUTPUT LINE IS 72.
*         H=X-X    NUMBER OF CHARACTERS PER OUTPUT LINE IS X-X
*                  (MAXIMUM ALLOWED IS 150 CHARACTERS). 
* 
*         LP       OUTPUT WILL BE FORMATTED FOR THE LINE PRINTER. 
* 
*         NR       OUTPUT FILE WILL NOT BE REWOUND. 
* 
*         NX=Y     SPECIFY NUMBER OF CHARACTERS TO BE MOVED.
*                  X=1 THRU 6; Y = NUMBER OF CHARACTERS.
* 
*         IX=Y     SPECIFY FIRST COLUMN OF DATA TO BE MOVED.
*                  X=1 THRU 6; Y = COLUMN NUMBER. 
* 
*         OX=Y     SPECIFY FIRST COLUMN TO RECEIVE THE DATA.
*                  X=1 THRU 6; Y = COLUMN NUMBER. 
* 
*         IT       IGNORE TERMINAL.  IF SET, THE TERMINAL OPTION TO 
*                  ALTER COMMAND PARAMETERS WILL BE SUPPRESSED. 
* 
*         NOTE: N1+N2+...+N6 MUST BE LESS THAN OR EQUAL TO H. 
* 
          EJECT 
***       PARAMETER DEFAULT VALUES LISTED BY SOURCE FILE TYPES. 
*         B(BATCH)           C(COMPASS)         M(MODIFY) 
* 
*         I=0                I=0                I=0 
*         S=SCR              S=SCR              S=SCR 
*         L=OUTPUT           L=OUTPUT           L=OUTPUT
*         T=B                T=C                T=M 
*         H=72               H=72               H=72
*         NR     NOT SET     NR     NOT SET     NR     NOT SET
*         LP     NOT SET     LP     NOT SET     LP     NOT SET
*         N1=72              N1=7               N1=2
*         N2 THRU N6=0       N2=50              N2=48 
*         I1=1               N3=15              N3=22 
*         I2 THRU I6=0       N4 THRU N6=0       N4 THRU N6=0
*         O1=1               I1=9               I1=6
*         O2 THRU O6=0       I2=41              I2=10 
*                            I3=112             I3=82 
*                            I4 THRU I6=0       I4 THRU I6=0
*                            O1=1               O1=1
*                            O2=8               O2=3
*                            O3=58              O3=51 
*                            O4 THRU O6=0       O4 THRU O6=0
* 
          SPACE  4
***       DAYFILE MESSAGES. 
* 
*         *ARGUMENT ERROR.* = ARGUMENT PROCESSOR *COMCARG* RETURNED AN
*                ERROR STATUS.  CORRECT AND RE-SUBMIT THE JOB.
*         *INPUT FILE ERROR.* = AN ERROR WAS ENCOUNTERED BY *COMCUPC* 
*                (UNPACK COMMAND) WHILE UNPACKING AN INPUT RECORD.
*         *UNRECOGNIZABLE TYPE SPECIFIED.* = THE TYPE SPECIFIED WAS 
*                NOT *B*, *C*, OR *M*.
*         *FILE NAME CONFLICT.* = SOURCE AND OUTPUT FILE NAMES
*                ARE THE SAME.
*         *IX OR OX NOT DEFINED.* = THE *I* OR *O* PARAMETER WAS
*                NOT SPECIFIED FOR A SPECIFIED *N*, AND THERE ARE 
*                NO DEFAULTS. 
*         *INCORRECT PARAMETER.* = THE *S* OR *L* PARAMETER 
*                WERE ENTERED AS ZERO.
*         *H VALUE INCORRECT.* = THE *H* PARAMETER ENTERED WAS
*                ZERO OR GREATER THAN BUFFER LENGTH.
*         *INCORRECT LINE LENGTH.* = ONE OF THE FOLLOWING OUT 
*                OF BOUNDS CONDITIONS EXISTS WITH RESPECT TO
*                *IX*, *NX*, *OX* AND *H*.
*                WHERE  X = 1...6.
*                ( O(X) + N(X) .GT. H )  OR 
*                ( I(X) + N(X) .GT. BUFFER LENGTH ).
  
          TITLE  MACROS AND ASSEMBLY CONSTANTS. 
****      ASSEMBLY CONSTANTS. 
 IBUFL    EQU    1001B
 OBUFL    EQU    1001B
 IBUFF    EQU    101B 
 NPM      EQU    6                 NUMBER OF MOVES POSSIBLE 
****
          SPACE  4
*         COMMON DECKS. 
  
  
*CALL     COMCMAC 
*CALL     COMSTCM 
          TITLE  FETS, BUFFERS, AND STORAGE AREAS.
****      FETS AND BUFFERS. 
          ORG    103B 
 FETS     BSS    0
  
 S        BSS    0
 SCR      FILEC  IBUF,IBUFL 
  
 O        BSS    0
 OUTPUT   FILEC  OBUF,OBUFL 
  
 XBUF     BSS    150
 XBUFL    EQU    *-XBUF 
  
 YBUF     BSS    150
 YBUFL    EQU    *-YBUF 
  
 FETSL    BSS    0
****
  
**        STORAGE AREA FOR INPUT VALUES.
 N1       CON    1R*
 N2       CON    1R*
 N3       CON    1R*
 N4       CON    1R*
 N5       CON    1R*
 N6       CON    1R*
 I1       DATA   0
 I2       DATA   0
 I3       DATA   0
 I4       DATA   0
 I5       DATA   0
 I6       DATA   0
 O1       DATA   0
 O2       DATA   0
 O3       DATA   0
 O4       DATA   0
 O5       DATA   0
 O6       DATA   0
  
 T        VFD    60D/1LB           TYPE 
 H        VFD    60D/2L72          NUMBER OF CHARS./LINE
 LP       DATA   0                 LINE PRINTER FLAG
 NR       DATA   0                 NO REWIND FLAG(OUTPUT FILE ONLY) 
          TITLE  LO72 - MAIN PROGRAM. 
**        LO72 - MAIN PROGRAM LOOP. 
* 
*         EXIT- OUTPUT STRING BUFFER WRITTEN TO CIO BUFFER. 
* 
*         USES- X - 1, 6. 
*               B - 1, 2. 
*               A - 0, 1. 
  
  
 LO721    READ   S,R
          EQ     LO723
  
 LO722    SA1    H
          WRITES O,YBUF,X1
 LO723    READS  S,XBUF,XBUFL 
          NG     X1,LO724          IF EOF 
          NZ     X1,LO721          IF EOR 
          SA1    XBUF 
          SX6    X1-1R1 
          ZR     X6,PEJ 
          SB2    A0                PROCESS A LINE 
          JP     B2 
  
 LO724    WRITEF O
          SA1    NR 
          NZ     X1,LO725 
          REWIND O
 LO725    MESSAGE (=C* LO72 COMPLETE.*) 
          ENDRUN R
          EJECT 
  
**        PEJ - PAGE EJECT AND SET HEADER LINE. 
* 
*         EXIT   (A0) = ADDRESS OF THE NEXT ROUTINE.
*                PAGE EJECT AND HEADER LINE IN OUTPUT STRING BUFFER.
*         USES   X - 1, 2, 3, 5, 7. 
*                B - 1, 2, 7. 
*                A - 0, 1, 2, 3, 5. 
  
  
 PEJ      RJ     BOB               BLANK OUTPUT BUFFER
          SA5    LP 
          ZR     X5,PEJ0           IF FLAG NOT SET
          MOVE   1,XBUF,YBUF
          EQ     PEJ0.5 
  
 PEJ0     WRITEC O,EJCT 
 PEJ0.5   MOVE   42,XBUF+8,YBUF+X5
          MOVE   20,XBUF+90,YBUF+42 
          MOVE   5,XBUF+115,YBUF+62 
          MOVE   5,XBUF+121,YBUF+67 
          SA1    T
          SB2    X1 
          JP     B2 
  
 PEJ1     SA0    CKS               CHECK SUBTITLE LINE
          EQ     LO722
 PEJ2     SB7    XBUF+10           SET ADDRESS
          RJ     ASC               ASSEMBLE CHARACTERS
          SA2    PEJA              GET FIRST LIST AREA
          SB2    B1+B1
 PEJ3     BX7    X1-X2
          SA3    A2+B1
          ZR     X2,PEJ4           IF CHARACTERS MATCH AREA 
          SA2    A2+B2
          NZ     X7,PEJ3
 PEJ4     SA0    X3                SET THE ADDRESS
          EQ     LO722
  
 PEJ5     SA0    BAT1              SET BATCH ADDRESS
          EQ     LO722
  
 EJCT     CON    0
 PEJA     VFD    24D/4LDECK,36D/0 
          VFD    42D/0,18D/DKS
          CON    10HSTATISTICS,STS
          CON    0,LMO
          TITLE  BATCH SUBROUTINES. 
  
**        BAT1 - SET UP MISC. SOURCE INPUT. 
* 
*         EXIT   (A0) = ADDRESS OF THE NEXT ROUTINE.
*                SUBTITLE LINE IN OUTPUT STRING BUFFER. 
*         USES   X - 5. 
*                B - NONE.
*                A - 0, 5.
  
  
 BAT1     RJ     BOB
          SA5    LP 
          MOVE   43,XBUF+8,YBUF+X5 SET UP SUBTITLE LINE 
          SA0    BAT2 
          MOVE   29,XBUF+70,YBUF+43 
          EQ     LO722
  
 BAT2     RJ     MMS
          EQ     LO722
          TITLE  COMPASS SUBROUTINES. 
  
**        CKS - CHECK SUBTITLE. 
* 
*         EXIT   (A0) = ADDRESS OF THE NEXT ROUTINE.
*                SUBTITLE LINE IN OUTPUT STRING BUFFER. 
*         USES - X - 1, 2, 3, 5, 7. 
*                B - 1, 2, 7. 
*                A - 0, 2, 3, 5.
  
  
 CKS      RJ     BOB
          SA5    LP 
          MOVE   43,XBUF+8,YBUF+X5
          MOVE   29,XBUF+70,YBUF+43 
          SB7    XBUF+8            SET ADDRESS
          RJ     ASC               ASSEMBLE CHARACTERS
          SA2    CKSA              GET SUBTITLE 
          SB2    B1+B1
 CKS1     BX7    X1-X2
          SA3    A2+B1             GET ASSOCIATED ADDRESS 
          ZR     X2,CKS2           IF LAST WORD 
          SA2    A2+B2
          NZ     X7,CKS1           IF SUBTITLES NOT EQUAL 
 CKS2     SA0    X3 
          EQ     LO722
  
 CKSA     VFD    42D/7LSTORAGE,18D/0
          VFD    42D/0,18D/STA
          VFD    48D/8LSYMBOLIC,12D/0 
          VFD    42D/0,18D/REF
 CKSB     VFD    30D/5LERROR,30D/0
          VFD    42D/0,18D/LSL7 
          CON    0,LSL
  
 LSL      SPACE  4
**        LSL - LIST A LINE FROM COMPASS. 
* 
*         EXIT   (A0) = ADDRESS OF NEXT ROUTINE IF END CARD NOT FOUND.
*                A LINE OF COMPASS SOURCE CODE PROCESSED. 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                B - 2, 3, 7. 
*                A - 0, 1, 2, 5.
  
  
 LSL      RJ     MMS
          SB7    XBUF+50
          RJ     ASC               ASSEMBLE OP-CODE 
          SA2    LSLA 
          BX7    X1-X2
          NZ     X7,LO722          IF NOT *END* 
  
**        PROCESS -STORAGE USED-, ETC.
* 
          SA0    LSL2 
          EQ     LO722
  
 LSL2     RJ     BOB
          SB7    XBUF+40
          RJ     ASC
          SA2    CKSA 
          BX6    X1-X2
          NZ     X6,LSL3           IF NOT -STORAGE USED- LINE 
          MOVE   17,XBUF+80,2      SAVE -XXXXXXXXX SYMBOLS- 
          SA5    LP 
          MOVE   9,XBUF+27,YBUF+X5 -STORAGE USED- 
          MOVE   13,XBUF+39,YBUF+10 
          MOVE   22,XBUF+58,YBUF+23 -STATEMENTS-
          MOVE   27,XBUF+99,YBUF+45 -INVENTED SYMBOLS-
          EQ     LO722
  
 LSL3     SB7    XBUF+51
          RJ     ASC
          ZR     X1,LMO 
          MX0    30 
          BX1    X0*X1             MASK THE *S* IN *ERRORS* 
          SA2    CKSB 
          BX6    X1-X2
          ZR     X6,LSL5           IF THERE WERE ASSEMBLY ERRORS
          SA5    LP 
          MOVE   15,XBUF+38,YBUF+X5 -ASSEMBLY-
          MOVE   18,XBUF+59,YBUF+16 -SECONDS- 
          MOVE   21,XBUF+80,YBUF+34 -REFERENCES-
          MOVE   17,2,YBUF+55       -SYMBOLS- 
          MOVE   8,XBUF+29,2
          EQ     LO722
  
 LSL5     SA5    LP 
          MOVE   55,XBUF+40,YBUF+X5 -ERRORS IN- 
          EQ     LO722
  
**        PROCESS ERROR DIRECTORY 
* 
 LSL7     SA1    XBUF+21
          SX1    X1-1R
          ZR     X1,LMO 
          RJ     BOB
          SA5    LP 
          MOVE   13,XBUF+14,YBUF+X5 -TYPE ERROR-
          MOVE   59,XBUF+40,YBUF+14 DESCRIPTION OF ERROR
          SA0    LSL8 
          EQ     LO722
  
 LSL8     SB7    XBUF+21
          RJ     ASC
          SA2    CKSB 
          BX6    X1-X2
          ZR     X6,LSL7           IF *ERROR* 
          RJ     BOB
          SA5    LP 
          MOVE   18,XBUF+21,YBUF+X5 
          MX0    1
          LX0    6
          SB2    XBUF+44
          SB3    YBUF+18
 LSL9     MOVE   6,B2,B3           MOVE THE PAGE NUMBERS
          LX0    6
          SB2    B2+10
          SB3    B3+6 
          PL     X0,LSL9
          EQ     LO722
  
 LSLA     VFD    18D/3LEND,42D/0
  
 STA      SPACE  4
**        STA - LIST STORAGE ALLOCATION 
* 
*         EXIT   STORAGE ALLOCATION CODE PROCESSED. 
*         USES   X - 1, 5, 6. 
*                B - NONE.
*                A - 1, 5.
  
  
 STA      RJ     BOB
          SA5    LP 
          SA1    XBUF+26           CHECK LINE TYPE
          SX6    X1-1R
          ZR     X6,STA1           IF NOT ALLOCATION
          MOVE   72,XBUF+18,YBUF+X5 
          EQ     LO722
  
 STA1     MOVE   72,XBUF+38,YBUF+X5 
          EQ     LO722
  
 REF      SPACE  4
**        REF - LIST CROSS REFERENCE TABLE. 
* 
*         EXIT   CROSS REFERENCE TABLE CODE PROCESSED.
*         USES   X - 1, 5, 6, 7.
*                B - 1, 2, 3, 4.
*                A - 1, 5, 7. 
  
  
 REF      RJ     BOB
          SA1    6                 CHECK FOR EXTRA PAGE/LINE
          SX6    X1-1R
          ZR     X6,REF2           IF NONE SAVED
          SA1    XBUF+22
          SX6    X1-1R
          ZR     X6,REF1           IF NOT NEW SYMBOL LINE 
          MOVE   8,2,YBUF+16
          SA1    H
          WRITES O,YBUF,X1
          EQ     REF2 
  
 REF1     MOVE   8,2,XBUF+15
 REF2     MOVE   8,XBUF+29,2       BLANK OUT THE SAVE AREA
          SA1    XBUF+67
          SX6    X1-1R= 
          NZ     X6,REF3           IF NOT QUALIFIER LINE
          SA5    LP 
          MOVE   24,XBUF,YBUF+X5
          MOVE   48,XBUF+49,YBUF+24 
          EQ     LO722
  
 REF3     SA5    LP 
          MOVE   16,XBUF+8,YBUF+X5
          SB2    XBUF+40
          SB3    7                 SET COUNTER
          SB4    YBUF+16
 REF4     SA1    B2+9 
          SX6    X1-1R
          ZR     X6,REF5           IF NOT DEFINITION
          SX7    1R 
          SA7    B2+5              BLANK OUT THE */*
          SA7    A7+B1             AND LINE NUMBER. 
          SA7    A7+B1
 REF5     ZR     B3,REF6           IF SEVEN PAGE/LINES LISTED 
          MOVE   8,B2,B4
          SB2    B2+10             INCREMENT XBUF ADDRESS 
          SB3    B3-B1
          SB4    B4+8              INCREMENT YBUF ADDRESS 
          EQ     REF4 
  
 REF6     SA1    XBUF+114 
          SX6    X1-1R
          ZR     X6,LO722          IF NO EIGHTH PAGE/LINE 
          MOVE   8,B2,2            SAVE EIGHTH PAGE/LINE
          EQ     LO722
          TITLE  MODIFY SUBROUTINES.
  
**        LMO - PROCESS MODIFICATIONS 
* 
*         EXIT   A LINE OF MODIFY SOURCE CODE PROCESSED.
*         USES   X - 5. 
*                B - 2. 
*                A - 5. 
  
  
 LMO      SB2    XBUF+10
 LMO1     RJ     BOB
          SA5    LP 
          MOVE   72,B2,YBUF+X5
          EQ     LO722
  
 DKS      SPACE  4
**        DKS - PROCESS DECK STATUS 
* 
*         EXIT   DECK STATUS CODE; MODIFIER NAMES CODE; OR ACTIVE,
*                INACTIVE, AND INSERTED CARD(S) CODE PROCESSED. 
*         USES   X - 1, 2, 5, 6, 7. 
*                B - 2, 7.
*                A - 0, 1, 2, 5, 6. 
  
  
 DKS      SA0    DKS1 
          SB2    XBUF+13
          EQ     LMO1 
  
**        CHECK FOR MODIFIERS 
* 
 DKS1     SA1    XBUF+10
          SX1    X1-1R
          ZR     X1,LMO            IF NOT *MODIFIERS.* LINE 
          SA0    DKS2 
          SA1    DKS
          MX2    42 
          LX2    30 
          BX1    X1*X2             MASK OUT DKS1 ADDRESS
          SX2    DKS2              GET DKS2 ADDRESS 
          LX2    30 
          BX6    X1+X2             INSERT DKS2 ADDRESS
          SA6    A1                RE-STORE THE INSTRUCTION 
          SB2    XBUF+2 
          EQ     LMO1 
  
**        CHECK FOR MODIFIER NAMES, ACTIVE CARDS, OR MAIN SECTION.
* 
 DKS2     SA1    XBUF+5 
          SA2    XBUF+6 
          SX1    X1-1R
          NZ     X1,BAT2           IF IT IS *A* LINE
          SX2    X1-1R
          NZ     X1,BAT2           IF IT IS *D* LINE
          RJ     BOB
          SB7    XBUF+21
          RJ     ASC
          SA2    DKSA              GET *ACTIVE* 
          BX7    X1-X2
          NZ     X7,DKS3           IF IT IS MODIFIER NAMES(S) 
          SA5    LP 
          MOVE   23,XBUF+14,YBUF+X5 -ACTIVE CARD(S)-
          MOVE   25,XBUF+44,YBUF+23 -INACTIVE CARD(S)-
          MOVE   24,XBUF+74,YBUF+48 -INSERTED CARD(S)-
          EQ     LO722
  
**        PROCESS MODIFIER NAME(S)
* 
 DKS3     SA1    XBUF+11
          SX1    X1-1R
          ZR     X1,LMO            IF NO FIRST NAME 
          SA5    LP 
          MOVE   41,XBUF+10,YBUF+X5 
          SA1    H
          WRITES O,YBUF,X1
          SA1    XBUF+51
          SX1    X1-1R
          ZR     X1,LO723          IF NO FIFTH NAME 
          RJ     BOB
          SA5    LP 
          MOVE   41,XBUF+50,YBUF+X5 
          EQ     LO722
  
 DKSA     VFD    36D/6LACTIVE,24D/0 
  
 STS      SPACE  4
**        STS - PROCESS STATISTICS
* 
*         EXIT   STATISTICS CODE PROCESSED. 
*         USES   X - 1, 5.
*                B - NONE.
*                A - 1, 5.
  
  
 STS      SA1    XBUF+81
          SX1    X1-1R
          ZR     X1,LMO 
          RJ     BOB
          SA5    LP 
          MOVE   60,XBUF+10,YBUF+X5 
          SA1    H
          WRITES O,YBUF,X1
          RJ     BOB
          SA5    LP 
          MOVE   60,XBUF+70,YBUF+X5 
          EQ     LO722
  
          TITLE  GENERAL SUBROUTINES. 
**        BOB - BLANK OUTPUT BUFFER 
*         ENTRY- (B1) = 1.
*         USES-  X - 0. 
*                B - 3, 4.
*                A - NONE.
*         EXIT   THE OUTPUT STRING BUFFER CONTAINS SPACE CODE 
*                IN ALL 150 WORDS.
* 
  
  
 BOB      SUBR                     ENTRY/EXIT 
          MX0    1
          SB3    YBUF              SET ADDRESS
          SB4    15                SET INCREMENT
 BOB1     LX0    6
          MOVE   15,SPACES,B3      BLANK OUT YBUF 
          SB3    B3+B4
          PL     X0,BOB1           IF NOT 10 TIMES
          EQ     BOBX              RETURN 
  
 SPACES   VFD    60D/1R 
          DUP    14 
          VFD    60D/1R 
          ENDD
  
 MMS      SPACE  4
**        MMS - MOVE MAIN SECTIONS
*         ENTRY- (B1) = 1.
*         USES-  X - 1, 2, 3. 
*                B - 2, 3.
*                A - 1, 2, 3. 
*         EXIT   THE OUTPUT STRING BUFFER CONTAINS THE CODE SPECIFIED 
*                BY THE PARAMETERS IN THE PROGRAM.
* 
  
  
 MMS      SUBR                     ENTRY/EXIT 
          RJ     BOB
          SB2    B0 
          SB3    NPM               SET LOOP COUNTER 
 MMS2     SA1    B2+N1             GET NO. OF CHARACTERS
          ZR     X1,MMS3
          SA2    B2+I1             GET INPUT ADDRESS
          SA3    B2+O1             GET OUTPUT ADDRESS 
          MOVE   X1,X2,X3 
 MMS3     SB2    B2+B1             INCREMENT THE ADDRESS
          SB3    B3-B1
          NZ     B3,MMS2           IF NOT NPM TIMES THRU
          EQ     MMSX              RETURN 
  
 ASC      SPACE  4
**        ASC    ASSEMBLE CHARACTERS
*         ENTRY- (B7) = ADDRESS OF FIRST CHARACTER. 
*                (B1) = 1.
*         USES:  X - 1. 
*                B - 4, 5, 6. 
*                A - 2. 
*         EXIT-  (X1) = THE CHARACTERS, LEFT JUSTIFIED, WITH
*                       TRAILING ZEROS. 
* 
*         ASSEMBLES UP TO TEN CHARACTERS INTO (X1) UNLESS A LEFT
*         PAREN, A COMMA, A PERIOD, OR A BLANK IS ENCOUNTERED 
*         FIRST.
* 
  
  
 ASC      SUBR                     ENTRY/EXIT 
          SB5    60                SET SHIFT COUNTER
          SB6    6
          BX1    X1-X1
 ASC1     LX1    6
          SA2    B7                GET A CHARACTER
          SB5    B5-B6             DECREMENT THE SHIFT COUNTER
          SB4    X2-1R
          ZR     B4,ASC2           IF A BLANK 
          SB4    X2-1R( 
          ZR     B4,ASC2           IF A LEFT PAREN
          SB4    X2-1R, 
          ZR     B4,ASC2           IF A COMMA 
          SB4    X2-1R. 
          ZR     B4,ASC2           IF A PERIOD
          BX1    X1+X2             ADD IN THE CHARACTER 
          NG     X1,ASCX
          SB7    B7+B1             INCREMENT THE ADDRESS
          NZ     B5,ASC1           IF NOT 10 CHARACTERS 
 ASC2     ZR     B5,ASCX
          LX1    B5,X1             LEFT JUSTIFY 
          EQ     ASCX              RETURN 
          SPACE  4
*         COMMON DECKS. 
  
*CALL     COMCCIO 
*CALL     COMCMVE 
*CALL     COMCRDC 
*CALL     COMCRDS 
*CALL     COMCRDW 
*CALL     COMCWTC 
*CALL     COMCWTS 
*CALL     COMCWTW 
*CALL     COMCSYS 
  
 BUFFERS  SPACE  4
****      BUFFERS 
* 
          USE    // 
 IBUF     EQU    *
 OBUF     EQU    IBUF+IBUFL 
 RFL=     EQU    OBUF+OBUFL  DEFAULT FIELD LENGTH 
          USE    *
****
          TITLE  PRESET SUBROUTINES.
  
          ORG    IBUF 
          SEG 
 PRS      SPACE  4
**        PRESET SUBROUTINES. 
* 
*         THIS AREA IS OVERLAID BY THE I/O BUFFERS. 
* 
*         USES   X - ALL. 
*                B - ALL. 
*                A - ALL. 
  
  
 I        BSS    0
 TEMP1    FILEC  I+15D,IBUFF
  
 OUT      BSS    0
 TEMP2    FILEC  I+16D+IBUFF,IBUFF
  
          ORG    I
          VFD    60D/1
          ORG    OUT
          VFD    60D/5
          ORG    I+17D+IBUFF+IBUFF
  
**        CHECK THE JOB ORIGIN CODE.
* 
 LO72     SB1    1                 (B1) = 1 
 PRS      MX0    48 
          SA1    JOPR        GET JOB ORIGIN CODE (BITS 24-35) 
          AX1    24                RIGHT ADJUST BYTE 2
          BX2    -X0*X1            GET JOB ORIGIN CODE
          SX6    X2-TXOT
          SA6    TTO               SET TTY ORIGIN FLAG
 PRS1     SA1    ACTR              GET ARGUMENT COUNT 
          SB4    X1 
          ZR     B4,PRS2           IF NO ARGUMENTS
          SB5    COPT              SET ARGUMENT TABLE ADDRESS 
          SA4    ARGR              GET FIRST ARGUMENT 
          RJ     ARG
          NZ     X1,PRSB           IF ERROR FOUND 
 PRS2     SB2    NPM
          SB3    B0 
  
**        VERIFY IF TYPE OF SOURCE FILE IS LEGAL
* 
          SA1    T                 CHECK TYPE 
          ZR     X1,PRS12 
          LX1    6                 RIGHT JUSTIFY
          SX2    X1-1RB 
          NZ     X2,PRS3           IF TYPE NOT = B
          SB4    BN1
          EQ     PRS8 
  
 PRS3     SX2    X1-1RM 
          NZ     X2,PRS4           IF TYPE NOT = M
          SB4    MN1
          EQ     PRS8 
  
 PRS4     SX2    X1-1RC 
          NZ     X2,PRS5           IF TYPE NOT = C
          SB4    CN1
          EQ     PRS8 
  
 PRS5     SA1    TTO
          ZR     X1,PRS12    IF TERMINAL AVAILABLE
 PRS6     MESSAGE (=C*UNRECOGNIZABLE TYPE SPECIFIED.*)
 PRS7     ABORT  R
 PRS8     SA1    B3+N1
          SB5    X1-1R* 
          ZR     B5,PRS10    IF *N* VALUE WAS NOT GIVEN 
  
*         INSERT *IX* AND *OX* DEFAULTS IF NOT SPECIFIED WHEN 
*         *NX* IS CHANGED.
  
          SA3    B4+B3
          SA3    A3+NPM      GET *IX* DEFAULT VALUE 
          SA2    A1+NPM 
          NZ     X2,PRS8.3   IF *IX* SPECIFIED
          NZ     X3,PRS8.2   IF *IX* DEFAULT DEFINED
 PRS8.1   MESSAGE (=C* IX OR OX NOT DEFINED.*)
          EQ     PRS7        ABORT
  
 PRS8.2   BX6    X3          SET *IX* DEFAULT VALUE 
          SA6    A2 
 PRS8.3   SA2    A2+NPM      GET *OX* VALUE 
          NZ     X2,PRS9     IF *OX* SPECIFIED
          SA3    A3+NPM 
          ZR     X3,PRS8.1   IF NO *OX* DEFAULT 
          BX6    X3          SET *OX* DEFAULT VALUE 
          SA6    A2 
 PRS9     SB3    B3+B1
          SB2    B2-B1
          NZ     B2,PRS8
          EQ     PRS12
  
**        INSERT DEFAULT VALUES FOR EACH TYPE IF NEEDED.
* 
 PRS10    SX4    A1 
          SB5    3
          SB6    B4 
 PRS11    SA2    B3+B6             GET PROPER DEFAULT VALUE 
          BX6    X2 
          SA6    X4                STORE THE VALUE
          SX4    X4+NPM            INCREMENT ADDRESS
          SB6    B6+NPM 
          SB5    B5-B1             DECREMENT COUNTER
          NZ     B5,PRS11 
          EQ     PRS9 
  
 PRS12    SA1    TTO
          NZ     X1,PRS13    IF TERMINAL NOT AVAILABLE
          SA1    I                 GET FILE NAME
          RJ     SFP               SET FET PARAMETERS 
          SA2    =5LINPUT 
          MX0    42 
          BX6    X0*X1
          SA6    CKID              SAVE ORIGINAL FILE NAME
          BX3    -X0*X1 
          BX6    X2+X3
          SA6    A1                INSERT *INPUT* INTO FET
          SA1    O                 GET FILE NAME
          BX6    X0*X1
          SA6    CKIG              SAVE ORIGINAL FILE NAME
          BX6    -X0*X1 
          SA6    A1                ZREO OUT FILE NAME 
          SA1    OUT
          RJ     SFP               SET FET PARAMETERS 
          SA2    =6LOUTPUT
          SX6    A1 
          BX6    X2+X6             ADD FET ADDRESS TO FILE NAME 
          SA6    B1+B1             INSERT OUTPUT FET ADDRESS AT RA+2
          BX6    X1+X2
          SA6    A1                SET FILE NAME OUTPUT FOR TTY 
          EQ     CKI
 PRS13    SA1    I
          MX0    42 
          BX2    X0*X1             MASK OFF FILE NAME 
          ZR     X2,PRS14          IF NO FILE NAME
  
**        READ THE INPUT FILE.
* 
 RIF      RJ     SFP               SET FET PARAMETERS 
          SX0    B1+B1             FIRST ADDRESS
 RIF1     READ   I,R
          READH  I,XBUF,XBUFL      READ INPUT FILE
          NG     X1,RIF3           IF -EOF- 
          NZ     X1,RIF1           IF -EOR- 
          SB7    X0 
          SA5    XBUF              GET FIRST WORD 
          RJ     UPC               UNPACK INPUT FILE
          SX0    B6+B7
          ZR     X6,RIF1           IF NO UNPACK ERROR 
          MESSAGE (=C*INPUT FILE ERROR.*) 
          EQ     PRS7 
  
**        PROCESS ARGUMENTS FROM INPUT FILE 
* 
 RIF3     SB4    X0-2              SET ARGUMENT COUNT 
          SA4    ARGR              GET FIRST ARGUMENT 
          SB5    COPT              GET ARGUMENT TABLE ADDR. 
          RJ     ARG               PROCESS ARGUMENTS
          NZ     X1,PRSB           IF ERROR FOUND 
  
**        CHECK FOR OUTPUT FILE NAME " SOURCE FILE NAME 
* 
 PRS14    SA1    S                 GET *SCR* FILE NAME
          SA2    O                 GET *OUTPUT* FILE NAME 
          MX0    42D
          BX1    X0*X1
          ZR     X1,PRSC     IF SOURCE FILE NAME NOT GIVEN
          BX2    X0*X2
          ZR     X2,PRSC     IF OUTPUT FILE NAME NOT GIVEN
          BX3    X1-X2
          NZ     X3,PRS15 
          MESSAGE (=C*FILE NAME CONFLICT.*) 
          EQ     PRS7 
  
**        SET NX VALUES AS BINARY NUMBERS 
* 
 PRS15    SB7    B0 
          SA5    H
          RJ     DXB
          ZR     X7,PRSD     IF OUTPUT LINE LENGTH NOT GIVEN
          SA7    A5 
          SX7    X7-XBUFL-1 
          PL     X7,PRSD     IF OUTPUT LENGTH .GT. XBUFL
          SB6    NPM-1       SET COUNTER + ADDRESS INCREMENT
 PRS16    SA5    B6+N1             GET NX VALUE 
          ZR     X5,PRS17 
          RJ     DXB
          SA7    A5                RE-STORE AS BINARY NUMBER
  
**        SET IX VALUES AS XBUF ADDRESSES 
* 
          SA5    A5+NPM            GET IX VALUE 
          RJ     DXB
          SX7    X7-1 
          SX2    XBUFL       GET INPUT LINE LENGTH
          SA3    B6+N1       ADD *NX* + *IX* VALUES 
          IX6    X7+X3
          IX6    X2-X6
          NG     X6,PRSE     IF *IX* + *NX* .GT. INPUT BUFFER LENGTH
          SX7    X7+XBUF
          SA7    A5                RE-STORE AS AN ADDRESS 
  
**        SET OX VALUES AS YBUF ADDRESSES 
* 
          SA5    A5+NPM            GET OX VALUE 
          RJ     DXB
          SX7    X7-1 
          SA2    H           GET OUTPUT LINE LENGTH 
          SA3    B6+N1       ADD *OX* + *NX* VALUES 
          IX6    X7+X3
          IX6    X2-X6
          NG     X6,PRSE     IF *OX* + *NX* .GT. OUTPUT LENGTH
          SX7    X7+YBUF
          SA7    A5                RE-STORE AS AN ADDRESS 
 PRS17    SB6    B6-B1
          PL     B6,PRS16          IF NOT *NPM* TIMES THRU
  
**        CONVERT T TO AN ADDRESS FOR *PEJ* ROUTINE 
* 
 PRS19    SB2    B0 
          MX0    42                SET ADDRESS MASK 
          SA2    T                 GET TYPE 
          MX1    6                 SET CHARACTER MASK 
 PRS20    SA3    B2+PRSA           GET FIRST CHARACTER AND ADDRESS
          ZR     X3,PRS6           IF END OF TABLE
          BX4    X1*X3             GET THE CHARACTER
          IX4    X2-X4
          ZR     X4,PRS21          IF A MATCH 
          SB2    B2+B1
          EQ     PRS20
 PRS21    BX6    -X0*X3 
          SA6    T                 SET ADDRESS INTO *TYPE* LOCATION 
  
**        RESET FET PARAMETERS
* 
          SA1    O
          RJ     SFP               SET FET PARAMETERS 
          SA1    NR 
          NZ     X1,PRS11.2  IF NO REWIND 
          REWIND O,R
 PRS11.2  SA1    S
          RJ     SFP               SET FET PARAMETERS 
          REWIND S,R
  
**        ADD LINE PRINTER FLAG TO FIRST YBUF ADDRESS 
* 
          SB3    B0 
          SX2    YBUF 
 PRS22    SA1    B3+O1             GET OUTPUT ADDRESSES 
          SA0    BAT2              SET DEFAULT ADDRESS
          IX3    X1-X2
          ZR     X3,PRS23          IF ADDRESSES THE SAME
          SB3    B3+B1
          SB5    B3-NPM 
          ZR     B5,LO721          IF NPM TIMES 
          EQ     PRS22
  
 PRS23    SA2    LP 
          IX6    X1+X2             ADD LINE PRINTER FLAG TO FIRST ADDR
          SA6    A1 
          EQ     LO721             RETURN 
  
  
 PRSA     VFD    6/1LB,54D/PEJ5 
          VFD    6/1LC,54D/PEJ1 
          VFD    6/1LM,54D/PEJ2 
          CON    0
  
  
 PRSB     MESSAGE (=C* ARGUMENT ERROR.*)
          EQ     PRS7 
  
 PRSC     MESSAGE (=C* INCORRECT PARAMETER.*) 
          EQ     PRS7 
  
 PRSD     MESSAGE (=C* H VALUE INCORRECT.*) 
          EQ     PRS7        ABORT
  
 PRSE     MESSAGE (=C* INCORRECT LINE LENGTH.*) 
          EQ     PRS7        ABORT
  
 COPT     BSS    0
 S        ARG    =0LSCR,S 
 I        ARG    =0LINPUT,I 
 L        ARG    =0LOUTPUT,O
 T        ARG    T,T
 H        ARG    H,H
 N1       ARG    BN1,N1 
 I1       ARG    BI1,I1 
 O1       ARG    BO1,O1 
 N2       ARG    BN2,N2 
 I2       ARG    BI2,I2 
 O2       ARG    BO2,O2 
 N3       ARG    BN3,N3 
 I3       ARG    BI3,I3 
 O3       ARG    BO3,O3 
 N4       ARG    BN4,N4 
 I4       ARG    BI4,I4 
 O4       ARG    BO4,O4 
 N5       ARG    BN5,N5 
 I5       ARG    BI5,I5 
 O5       ARG    BO5,O5 
 N6       ARG    BN6,N6 
 I6       ARG    BI6,I6 
 O6       ARG    BO6,O6 
 LP       ARG    -DFLP,LP 
 NR       ARG    -*,NR
 IT       ARG    -*,TTO 
          ARG 
  
 DFLP     CON    1           DEFAULT PRINTER OPTION 
 TTO      CON    0           TERMINAL AVAILABLE OPTION
          TITLE  TERMINAL I/O ROUTINE.
  
**        CKI - CHECK INPUT FROM TTY. 
* 
*         ENTRY - ORIGIN CODE (JOPR) CHECKED AND FOUND TO BE TELEX. 
* 
*         EXIT - ALL RE-FORMAT PARAMETERS CHECKED BY THE TERMINAL USER. 
* 
*         USES   X - ALL. 
*                B - ALL. 
*                A - ALL. 
  
  
 CKI      WRITEC OUT,CKIA 
  
          WRITEC OUT,CKIA1
 CKI0     READ   I
          READC  I,XBUF,8D
  
**        CHECK IF ANY ARGUMENT CHANGES ARE NEEDED
* 
          NZ     X1,CKI26          IF *CR*
          SA1    XBUF              GET THE INPUT WORD 
          RJ     SFN
          SA2    CKIB 
          BX3    X6-X2
          ZR     X3,CKI1           IF *YES* 
          SA2    A2+B1
          BX3    X2-X1
          ZR     X3,CKI26          IF *NO*
          SX6    CKI0 
          SA6    SOBC              SET ERROR ADDRESS
          EQ     SOB4 
  
**        CHANGE INPUT FILE NAME(I) 
* 
 CKI1     MX0    42 
          SA1    CKID              GET INPUT FILE NAME
          RJ     SFN               SPACE FILL NAME
          BX6    X0*X6
          SA5    CKIC2             GET MESSAGE WORD 
          BX6    X5+X6
          SA6    A5                STORE INTO MESSAGE 
          WRITEC OUT,CKIC 
          WRITEC OUT,CKIC1
 CKI2     READ   I
          READC  I,XBUF,8D
          NZ     X1,CKI3           IF *CR*
          SB3    CKI2              SET ERROR ADDRESS
          SA1    XBUF              GET THE INPUT WORD 
          RJ     SOB               STRIP OFF BLANKS 
          SA6    CKID              TEMPORARILY STORE INPUT FILE NAME
  
**        CHANGE SOURCE FILE NAME(S)
* 
 CKI3     SA5    S                 GET *SCR* FILE NAME
          BX1    X0*X5
          RJ     SFN
          BX6    X0*X6
          SA5    CKIE1             GET MESSAGE WORD 
          BX6    X5+X6
          SA6    A5                STORE INTO MESSAGE 
          WRITEC OUT,CKIE 
 CKI4     READ   I
          READC  I,XBUF,8D
          NZ     X1,CKI5           IF *CR*
          SB3    CKI4              SET ERROR ADDRESS
          SA1    XBUF              GET THE INPUT WORD 
          RJ     SOB               STRIP OFF BLANKS 
          BX1    -X0*X5 
          BX6    X6+X1
          SA6    S                 STORE *SCR* FILE NAME
  
**        CHANGE OUTPUT FILE NAME(O)
* 
 CKI5     SA1    CKIG              GET OUTPUT FILE NAME 
          RJ     SFN
          BX6    X0*X6
          SA5    CKIF1             GET MESSAGE WORD 
          BX6    X5+X6
          SA6    A5                STORE INTO MESSAGE 
          WRITEC OUT,CKIF 
 CKI6     READ   I
          READC  I,XBUF,8D
          NZ     X1,CKI7           IF *CR*
          SB3    CKI6              SET ERROR ADDRESS
          SA1    XBUF              GET THE INPUT WORD 
          RJ     SOB               STRIP OFF BLANKS 
          BX1    -X0*X5 
          BX6    X6+X1
          SA6    CKIG              TEMPORARILY STORE OUTPUT FILE NAME 
  
**        CHANGE TYPE OF SOURCE FILE(T) 
* 
 CKI7     SA1    T
          NZ     X1,CKI8           IF TYPE NOT EMPTY
          SA2    CKIJ 
          EQ     CKI12
  
 CKI8     LX1    6                 RIGHT JUSTIFY
          SX2    X1-1RB 
          NZ     X2,CKI9           IF TYPE NOT BATCH
          SA2    CKIK 
          EQ     CKI12
  
 CKI9     SX2    X1-1RM 
          NZ     X2,CKI10          IF TYPE NOT MODIFY 
          SA2    CKIL 
          EQ     CKI12
  
 CKI10    SX2    X1-1RC 
          NZ     X2,CKI12.1  IF TYPE NOT COMPASS
          SA2    CKIM 
 CKI12    BX6    X2 
          SA6    CKIH1             STORE INTO MESSAGE 
          BX7    X7-X7       SET END-OF-LINE
          SA7    A6+B1
 CKI12.1  WRITEC OUT,CKIH 
 CKI13    READ   I
          READC  I,XBUF,8D
          NZ     X1,CKI15          IF *CR*
          MX0    6
          SA1    XBUF              GET THE INPUT WORD 
          BX6    X0*X1             PICK OFF FIRST CHARACTER 
          BX1    X6 
          LX1    6                 RIGHT JUSTIFY
          SX2    X1-1RB 
          ZR     X2,CKI14          IF TYPE = B
          SX2    X1-1RM 
          ZR     X2,CKI14          IF TYPE = M
          SX2    X1-1RC 
          ZR     X2,CKI14          IF TYPE = C
          SX6    CKI13
          SA6    SOBC              SET ERROR ADDRESS
          EQ     SOB4 
 CKI14    SA6    T                 STORE NEW TYPE 
  
**        CHANGE LENGTH OF OUTPUT LINE(H) 
* 
 CKI15    SA1    H                 GET NO. OF CHARACTERS/LINE 
          NZ     X1,CKI16 
          SA1    =1L0 
 CKI16    MX0    6
          SA3    =1L
          SB2    B1+B1
 CKI17    LX1    6
          BX2    X0*X1
          NZ     X2,CKI18          IF THERE IS A CHAR.
          BX1    X1+X3             ADD A SPACE
 CKI18    SB2    B2-B1
          NZ     B2,CKI17 
          LX1    48                SHIFT INTO BYTE 0
          SA2    CKIN1
          MX0    18 
          BX2    -X0*X2      ALLOW RESET OF *H* CODED VALUE 
          BX6    X1+X2
          SA6    A2                STORE INTO MESSAGE 
          WRITEC OUT,CKIN 
 CKI19    READ   I
          READC  I,XBUF,8D
          NZ     X1,CKI20          IF *CR*
          SB3    CKI19             SET ERROR ADDRESS
          SA1    XBUF              GET THE INPUT WORD 
          RJ     SOB               STRIP OFF BLANKS 
          SA6    H                 STORE NEW NO. OF CHARS.
          BX5    X6 
          RJ     DXB         CONVERT *H* TO DECIMAL VALUE 
          ZR     X7,CKI19.1  IF ZERO LENGTH SPECIFIED 
          SX7    X7-XBUFL-1 
          NG     X7,CKI20    IF OUTPUT LENGTH .LT. XBUFL
 CKI19.1  WRITEC OUT,CKIU 
          EQ     CKI19       ALLOW RE-ENTRY OF *H* VALUE
  
**        CHANGE NX, IX, AND OX VALUES
  
 CKI20    WRITEC OUT,CKIO 
          WRITEC OUT,CKIO1
          WRITEC OUT,CKIO2
          SB3    CKIP 
          SA1    B3-B1       GET COPY OF CKIP 
          BX6    X1 
          SA6    B3          RESTORE CKIP 
          MX5    6
          LX5    30 
          BX0    X0-X0
 CKI21    SB6    CKIQ 
          MX2    54 
          SX7    B1 
          SA3    CKIP 
          LX3    12 
          IX6    X3+X7             INCREMENT X
          LX6    48 
          SA6    A3 
          SA1    X0+N1             GET NX VALUES
          SB2    3
          SX4    55B
 CKI22    NZ     X1,CKI23          IF NX IS SET 
          SX1    1R0
 CKI23    LX1    6
          BX3    -X2*X1 
          NZ     X3,CKI23          IF THERE IS A CHAR.
          IX1    X1+X4             ADD IN A BLANK 
          BX3    X5*X1
          ZR     X3,CKI23          IF NOT TO BIT 30 
          BX6    X1+X6
          SA6    B6                STORE INTO MESSAGE 
          SB6    B6+B1             INCREMENT CKIQ ADDRESS 
          SB2    B2-B1             DECREMENT COUNTER
          SA1    A1+NPM            GET NEXT VALUES (IX + OX)
          SA3    B1+CKIP           GET SECOND WORD
          BX6    X3 
          NZ     B2,CKI22 
          SX0    X0+B1
          WRITEC OUT,CKIQ 
          SX4    X0-NPM 
          NZ     X4,CKI21          IF NOT NPM TIMES 
          WRITEC OUT,CKIR 
          WRITEC OUT,CKIR1
          WRITEC OUT,CKIR2
          WRITEC OUT,CKIR3
          WRITEC OUT,CKIR4
          WRITEC OUT,CKIR5
          MX0    18 
          SA0    B0                INITIALIZE ARGUMENT COUNTER
          SA5    YBUF              SET ADDRESS FOR NEW VALUES 
  
**        READ NEW NX, IX, AND OX VALUES
  
 CKI24    READ   I
          READC  I,XBUF,8D
          NZ     X1,CKI25          IF *CR*
          SB3    CKI24             SET ERROR ADDRESS
          SA1    XBUF              GET THE INPUT WORD 
          RJ     SOB               STRIP OFF BLANKS 
          SX5    54B               SET EQUAL SIGN 
          BX7    -X0*X6 
          MX1    12 
          BX6    X1*X6
          IX6    X6+X5             COMPLETE FIRST WORD
          LX7    18                LEFT JUSTIFY THE SECOND WORD 
          SA6    A5                SET FIRST HALF OF ARGUMENT 
          SA0    A0+B1             INCREMENT ARGUMENT COUNTER 
          SA5    A5+B1             INCREMENT ADDRESS
          SA7    A5                SET SECOND HALF OF ARGUMENT
          SA0    A0+B1             INCREMENT ARGUMENT COUNTER 
          SA5    A5+B1             INCREMENT ADDRESS
          EQ     CKI24
 CKI25    SB4    A0                SET ARGUMENT COUNT 
          ZR     B4,CKI26          IF NO ARGUMENTS
          SB5    COPT              SET ARGUMENT TABLE ADDRESS 
          SA4    YBUF              GET FIRST ARGUMENT 
          RJ     ARG               PROCESS ARGUMENTS
          ZR     X1,CKI26          IF NO ARGUMENT ERRORS
          WRITEC OUT,CKIT 
          MX0    18 
          SA0    B0                INITIALIZE ARGUMENT COUNTER
          SA5    YBUF              SET ADDRESS FOR NEW VALUES 
          EQ     CKI24
  
 CKI26    SB6    NPM-1       SET COUNTER + ADDRESS INCREMENT
          MX0    54                SINGLE CHAR. MASK. 
 CKI27    SA5    B6+N1             GET NX 
          ZR     X5,CKI28          IF NX=0
          RJ     DXB               CONVERT DISPLAY CODE TO BINARY 
          SA7    SNX         SAVE *NX* VALUE
          SA5    A5+NPM      CONVERT *IX* VALUE 
          RJ     DXB
          SA4    SNX         ADD *NX* + *IX* VALUES 
          IX4    X4+X7
          SX4    X4-XBUFL-2  COMPARE SUM WITH BUFFER LENGTH 
          PL     X4,CKI32    IF *NX* + *IX* .GT. XBUFL + 1
          SA5    A5+NPM      CONVERT *OX* CODED VALUE 
          RJ     DXB
          SA7    SOX         SAVE *OX* VALUE
          SA5    H           CONVERT *H* CODED VALUE
          RJ     DXB
          NZ     X4,CKI19.1  IF INCORRECT *H* PARAMETER 
          ZR     X7,CKI19.1  IF *H* VALUE = 0 
          SX6    X6-XBUFL-1  COMPARE *H* WITH BUFFER LENGTH 
          PL     X6,CKI19.1  IF *H* VALUE .GT. XBUFL
          SA3    A7          ADD *OX* + *NX* VALUES 
          SA4    A4 
          IX4    X3+X4       COMPARE SUM WITH OUTPUT LENGTH 
          SX7    X7+B1
          IX4    X7-X4
          NG     X4,CKI32    IF *NX* + *OX* .GT. (*H* + 1)
 CKI28    ZR     B6,CKI33    IF FIELD PARAMETER VALIDATION COMPLETE 
          SB6    B6-B1
          EQ     CKI27
  
 CKI32    WRITEC OUT,CKIS 
          WRITEC OUT,CKIS1
          EQ     CKI15
  
 CKI33    SA1    CKIG 
          SA2    O
          MX0    42 
          BX2    -X0*X2 
          BX6    X1+X2
          SA6    A2                SET COMBINED NAME AND STATUS 
          SA1    CKID 
          ZR     X1,PRS14          IF NO INPUT FILE NAME
          SA2    I
          BX2    -X0*X2 
          BX6    X1+X2
          SA6    A2                SET COMBINED NAME AND STATUS 
          BX1    X6 
          EQ     RIF               READ INPUT FILE
  
****      MESSAGES OUTPUT TO TTY BY *CKI*.
* 
 CKIA     DIS    5,DO YOU WANT TO CHANGE ANY CONTROL ARGUMENT VALUES- 
          CON    0
 CKIA1    DATA   10HENTER: YES
          VFD    36/6L OR NO,24/0 
 CKIB     DATA   3HYES
          VFD    60D/2LNO 
 CKIC     DIS    2,ARGUMENT 
          VFD    36/6LVALUE ,24/0 
 CKIC1    DIS    2,INPUT FILE NAME: 
 CKIC2    VFD    42/0,18/3H "CB"
          CON    0
 CKID     CON    0                 INPUT FILE NAME STORAGE
 CKIE     DIS    2,SOURCE FILE NAME:  
 CKIE1    VFD    42/0,18/3H "CB"
          CON    0
 CKIF     DIS    2,OUTPUT FILE NAME:  
 CKIF1    VFD    42/0,18/3H "CB"
          CON    0
 CKIG     CON    0                 OUTPUT FILE NAME STORAGE 
 CKIH     DIS    2,SOURCE FILE TYPE:  
 CKIH1    DATA   C*NOT IDENTIFIABLE"CB"*
 CKIJ     DATA   C*NONE"CB"*
 CKIK     DATA   C*BATCH "CB"*
 CKIL     DATA   C*MODIFY"CB"*
 CKIM     DATA   C*COMPASS "CB"*
 CKIN     DIS    2,OUTPUT LINE LENGTH:  
 CKIN1    VFD    18D/0,42D/7L CHARS.
          DATA   C*"CB"*
 CKIO     DIS    3,   NO. OF  MOVED FROM  MOVED T 
          VFD    12/2LO ,48/0 
 CKIO1    DIS    3,   CHARS.    COLUMN     COLUMN 
          CON    0
 CKIO2    DIS    2,(X) (NX)      (IX) 
          VFD    48/8L    (OX),12/0 
          CON    0
          VFD    30D/5L 0.  ,30D/0
 CKIP     VFD    30D/5L 0.  ,30D/0
          VFD    30D/5L     ,30D/0
 CKIQ     CON    0
          CON    0
          CON    0
          CON    0
 CKIR     DATA   C*ENTER CHANGES IN THE FOLLOWING FORMAT: * 
 CKIR1    DATA   10HNX=AA*CR* 
          CON    0
 CKIR2    DATA   10HIX=BB*CR* 
          CON    0
 CKIR3    DATA   10HOX=CC*CR* 
          CON    0
 CKIR4    VFD    24/4LETC.,36/0 
 CKIR5    DATA   C/TO CONTINUE, ENTER *CR* ONLY. "CB"/
 CKIS     DIS    5,ERROR- OUTPUT LINE LENGTH (H) IS TOO SMALL OR TOTA 
          VFD    12/2LL ,48/0 
 CKIS1    DIS    5,NUMBER OF CHARACTERS TO BE MOVED (NX) IS TOO LARGE 
          VFD    12/2L. ,48/0 
 CKIT     DIS    5,ARGUMENT ERROR. RE-ENTER ALL NX, IX, AND OX PARAME 
          VFD    36/6LTERS. ,24/0 
 CKIU     DATA   C* LENGTH INCORRECT. CORRECT AND RE-ENTER.*
          CON    0
****
          SPACE  4
  
**        SFP - SET FET PARAMETERS
*         ENTRY- (B1) = 1.
*                (A1) = ADDRESS OF FILE NAME. 
*                (X1) = FILE NAME.
*         USES-  X - 2, 6.
*                B - NONE.
*                A - 2, 6.
* 
*         SETS A 1 IN BIT ZERO OF WORD 1 IF NEEDED AND RESETS 
*         IN = OUT = FIRST. 
* 
  
  
 SFP      SUBR                     ENTRY/EXIT 
          BX6    X1 
          LX6    59 
          NG     X6,SFP1           IF BIT ZERO SET
          SX2    B1 
          LX6    1
          IX6    X6+X2             SET BIT ZERO 
          BX1    X6 
          SA6    A1 
 SFP1     SA2    A1+B1             GET FIRST
          BX6    X2 
          SA6    A2+B1             SET IN = FIRST 
          SA6    A6+B1             SET OUT = FIRST
          EQ     SFPX              RETURN 
          SPACE  4
  
**        SOB - STRIP OFF BLANKS
*         ENTRY- (X1) = DISPLAY CODE WITH TRAILING BLANKS POSSIBLE. 
*                (B1) = 1.
*                (B3) = RETURN ADDRSS IF ERROR ENCOUNTERED. 
*         USES-  X - 1, 2, 3, 6.
*                B - 3, 4, 5, 6, 7. 
*                A - 1, 6.
*         EXIT-  (X6) = SAME DISPLAY CODE EXCEPT ZERO FILLED. 
* 
  
  
 SOB      SUBR                     ENTRY/EXIT 
          SX6    B3 
          SA6    SOBC              SAVE ERROR ADDRESS 
          SB4    6
          SB5    54D               SHIFT COUNTER
          MX2    54D               SINGLE CHARACTER MASK
          BX6    X6-X6
          BX1    X2*X1
 SOB1     LX1    6
          BX3    -X2*X1            GET A CHARACTER
          ZR     X3,SOB3           IF NO MORE CHARACTERS
          SB6    B5-6 
          ZR     B6,SOB6           IF INPUT TOO LONG
          SB7    X3-1R+ 
          NG     B7,SOB2           IF NOT SPECIAL CHARACTER 
          SB7    X3-1R
          ZR     B7,SOB1           IF SPACE CHARACTER 
          SB7    X3-1R= 
          NZ     B7,SOB4           IF NOT EQUALS(=) CHARACTER 
          SB7    B5-42D 
          NZ     B7,SOB4           IF NOT THE THIRD CHARACTER 
 SOB2     SB5    B5-B4
          BX6    X3+X6             BUILD UP LEGAL INPUT 
          LX6    6
          EQ     SOB1              LOOP 
 SOB3     LX6    B5,X6             LEFT JUSTIFY 
          NZ     X6,SOBX           RETURN IF INPUT GOOD 
 SOB4     WRITEC OUT,SOBA 
 SOB5     SA1    SOBC 
          SB3    X1                RESET ERROR ADDRESS
          JP     B3                RETURN TO READ AGAIN 
 SOB6     WRITEC OUT,SOBB 
          EQ     SOB5 
 SOBA     DIS    3,INPUT ERROR. RE-ENTER SAME PAR 
          VFD    48/8LAMETER. ,12/0 
          DATA   2BS48
 SOBB     DIS    4,PARAMETER TOO LONG. CORRECT AND RE-ENTER 
          VFD    12/2L. ,12/0,12/2,24/0 
 SOBC     CON    0
          SPACE  4
  
**        DEFAULT VALUES FOR BATCH. 
  
 BN1      VFD    60D/2L72 
 BN2      DATA   0
 BN3      DATA   0
 BN4      DATA   0
 BN5      DATA   0
 BN6      DATA   0
 BI1      VFD    60D/1L1
 BI2      DATA   0
 BI3      DATA   0
 BI4      DATA   0
 BI5      DATA   0
 BI6      DATA   0
 BO1      VFD    60D/1L1
 BO2      DATA   0
 BO3      DATA   0
 BO4      DATA   0
 BO5      DATA   0
 BO6      DATA   0
  
**        DEFAULT VALUES FOR COMPASS. 
  
 CN1      VFD    60D/1L7
 CN2      VFD    60D/2L50 
 CN3      VFD    60D/2L15 
 CN4      DATA   0
 CN5      DATA   0
 CN6      DATA   0
 CI1      VFD    60D/1L9
 CI2      VFD    60D/2L41 
 CI3      VFD    60D/3L112
 CI4      DATA   0
 CI5      DATA   0
 CI6      DATA   0
 CO1      VFD    60D/1L1
 CO2      VFD    60D/1L8
 CO3      VFD    60D/2L58 
 CO4      DATA   0
 CO5      DATA   0
 CO6      DATA   0
  
**        DEFAULT VALUES FOR MODIFY.
  
 MN1      VFD    60D/1L2
 MN2      VFD    60D/2L48 
 MN3      VFD    60D/2L22 
 MN4      DATA   0
 MN5      DATA   0
 MN6      DATA   0
 MI1      VFD    60D/1L6
 MI2      VFD    60D/2L10 
 MI3      VFD    60D/2L82 
 MI4      DATA   0
 MI5      DATA   0
 MI6      DATA   0
 MO1      VFD    60D/1L1
 MO2      VFD    60D/1L3
 MO3      VFD    60D/2L51 
 MO4      DATA   0
 MO5      DATA   0
 MO6      DATA   0
 SNX      DATA   0           *NX* VALUE 
 SOX      DATA   0           *OX* VALUE 
  
          SPACE  4,10 
**        COMMON DECKS. 
  
  
*CALL     COMCARG 
*CALL     COMCDXB 
*CALL     COMCRDH 
*CALL     COMCSFN 
*CALL     COMCUPC 
  
          END 
