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