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