Retro1.org codex

          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