IDENT COPYC,FETS
ABS
ENTRY COPYSBF
ENTRY COPYCF
ENTRY SCOPY
ENTRY COPYCR
ENTRY NPC=
ENTRY RFL=
ENTRY SSM=
SYSCOM B1 DEFINE (B1) = 1
*COMMENT COPYC - CODED FILE COPIES.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE COPYC - CODED FILE COPIES.
SPACE 4
*** COPYC - CODED FILE COPIES.
* G. R. MANSFIELD. 70/11/25.
SPACE 4
*** DAYFILE MESSAGES.
*
* * COPY COMPLETE.* = INFORMATIVE MESSAGE INDICATING COPY
* COUNT WAS EXHAUSTED BEFORE EOI REACHED.
*
* * EOI ENCOUNTERED.* = INFORMATIVE MESSAGE INDICATING END
* OF INFORMATION WAS ENCOUNTED BEFORE THE COPY COUNT WAS
* EXHAUSTED.
*
* *INCORRECT CHARACTER NUMBER.* = INCORRECT FIRST/LAST
* CHARACTER NUMBER SPECIFIED.
*
* *INCORRECT COUNT.* = OPTIONAL RECORD/FILE COUNT INCORRECT
* FORMAT.
*
* * NO LINE TERMINATOR AT EOR(S).* = NO LINE TERMINATOR WAS
* FOUND FOR THE LAST LINE OF A RECORD(S) (RECORD NOT Z-TYPE
* DATA). THE LINE TERMINATOR IS ADDED, AND THE JOB IS ABORTED
* IF THE *NA* PARAMETER IS NOT SPECIFIED.
*
* * NNNN LINE(S) TRUNCATED.* = INFORMATIVE MESSAGE INDICATING
* NNNN LINES WERE TRUNCATED DURING COPYING.
*
* *TOO MANY PARAMETERS.* = MORE THAN SIX PARAMETERS WERE
* SPECIFIED ON A *COPYCF* OR *COPYCR* CALL, OR MORE THAN
* ELEVEN ON AN *SCOPY* CALL.
*
* *INCORRECT LINE NUMBER SPECIFICATION.* = INCORRECT
* FIRST/LAST LINE NUMBER SPECIFIED.
*
* *INCORRECT REWIND SPECIFICATION.* = REWIND PARAMETER
* NOT *R* OR OMITTED.
*
* *INCORRECT STRUCTURE SPECIFICATION.* = STRUCTURE
* PARAMETER NOT *NS* OR OMITTED.
*
* *INCORRECT CHARACTER SET SPECIFICATION.* = CHARACTER
* SET PARAMETER NOT *D* OR OMITTED.
SPACE 4
**** ASSEMBLY CONSTANTS.
LINL EQU 500D WORKING BUFFER LENGTH (6-BIT CHARACTERS)
BUFL EQU LINL+1 WORKING BUFFER LENGTH + 1
IBUFL EQU 2001B IFILE BUFFER LENGTH
OBUFL EQU 2001B OFILE BUFFER LENGTH
****
* SPECIAL ENTRY POINTS.
NPC= EQU 0 FORCE OPERATING SYSTEM PARAMETER FORMAT
SSM= EQU 0 SUPPRESS DUMPS OF FIELD LENGTH
*CALL COMCMAC
TITLE COMMON DATA
DATA SPACE 4
ORG 120B
FETS BSS 0
I BSS 0
INPUT RFILEC IBUF,IBUFL,(FET=8)
O BSS 0
OUTPUT RFILEC OBUF,OBUFL,(FET=8)
CT CON 1 COUNT
SK CON 0 SKIP FLAG
FC CON 0 FIRST CHARACTER
LC CON 136 LAST CHARACTER
LTC CON 0 COUNT OF LINES TRUNCATED
NA CON 0 NO-ABORT FLAG
NZ CON 0 NON Z-TYPE DATA FLAG
FL CON 0 FIRST LINE NUMBER
LL CON -1 LAST LINE NUMBER
NS CON 0 STRUCTURE REPORTING FLAG
AS CON 0 ASCII8 FLAG
AF CON 0 ASCII8 WITH FORMAT EFFECTORS FLAG
LN CON 0 LINE NUMBER ERROR MESSAGE FLAG
SC CON 0 *SCOPY* FLAG
FCNT CON 0 FILE COUNT
RCNT CON 0 RECORD COUNT
TITLE MAIN PROGRAMS.
COPYCF SPACE 4,25
*** COPYCF (IFILE,OFILE,N,FCHAR,LCHAR,NA)
*
*
* COPYCF COPIES FILES FROM MEDIUM TO MEDIUM IN CODED MODE.
* FILES ARE TREATED AS 6-BIT CHARACTER DATA WITH A MAXIMUM
* LINE LENGTH DEFINED BY THE CONSTANT *LINL* (500) .
*
* IFILE INPUT FILE NAME.
* OFILE OUTPUT FILE NAME.
* N NUMBER OF FILES TO COPY.
* FCHAR FIRST CHARACTER TO COPY.
* LCHAR LAST CHARACTER TO COPY.
* NA DO NOT ABORT IF RECORD NOT Z-TYPE DATA.
*
* IF IFILE = OFILE, FILES ON IFILE ARE SKIPPED.
*
* ASSUMED PARAMETERS.
* IFILE = *INPUT*
* OFILE = *OUTPUT*
* N = 1
* FCHAR = 1
* LCHAR = 136
* NA NOT SPECIFIED.
COPYCF BSS 0 ENTRY
SB1 1 (B1) = 1
RJ PRS PRESET PROGRAM
RJ SCC SET CHARACTER COUNTS
NZ B7,ERR3 IF TOO MANY ARGUMENTS
SX0 0 INITIALIZE LINE TRANSFER COUNT
CCF1 READ I BEGIN READ
RECALL O
READS I,BUF,-BUFL
RJ CPR COPY RECORD
NG X1,ITM IF EOI
ZR X1,CCF1 LOOP TO EOF
SA2 CT DECREMENT COUNT
SX6 X2-1
SA6 A2
NZ X6,CCF1 LOOP FOR ALL FILES
EQ ITM TERMINATE PROGRAM
COPYCR SPACE 4,25
*** COPYCR (IFILE,OFILE,N,FCHAR,LCHAR,NA)
*
*
* COPYCR COPIES RECORDS FROM MEDIUM TO MEDIUM IN CODED MODE.
* FILES ARE TREATED AS 6-BIT CHARACTER DATA WITH A MAXIMUM
* LINE LENGTH DEFINED BY THE CONSTANT *LINL* (500) .
*
* IFILE INPUT FILE NAME.
* OFILE OUTPUT FILE NAME.
* N NUMBER OF RECORDS TO COPY.
* FCHAR FIRST CHARACTER TO COPY.
* LCHAR LAST CHARACTER TO COPY.
* NA DO NOT ABORT IF RECORD NOT Z-TYPE DATA.
*
* IF IFILE = OFILE, RECORDS ON IFILE ARE SKIPPED.
*
* ASSUMED PARAMETERS.
* IFILE = *INPUT*
* OFILE = *OUTPUT*
* N = 1
* FCHAR = 1
* LCHAR = 136
* NA NOT SPECIFIED.
COPYCR BSS 0 ENTRY
SB1 1 (B1) = 1
RJ PRS PRESET PROGRAM
RJ SCC SET CHARACTER COUNTS
NZ B7,ERR3 IF TOO MANY ARGUMENTS
SX0 0 INITIALIZE LINE TRANSFER COUNT
CCR1 READ I BEGIN READ
RECALL O
READS I,BUF,-BUFL
RJ CPR COPY RECORD
NG X1,ITM IF EOI
SA2 CT DECREMENT COUNT
SX6 X2-1
SA6 A2
NZ X6,CCR1 LOOP FOR ALL RECORDS
EQ ITM TERMINATE PROGRAM
COPYSBF SPACE 4,20
*** COPYSBF (IFILE,OFILE,N,NA)
*
*
* COPYSBF COPIES FILES FROM MEDIUM TO MEDIUM IN BINARY MODE,
* SHIFTING EACH LINE IMAGE 1 CHARACTER TO THE RIGHT AND ADDING
* A LEADING SPACE. A PAGE EJECT IS WRITTEN AT THE BEGINNING
* OF EACH RECORD.
*
* IFILE INPUT FILE NAME.
* OFILE OUTPUT FILE NAME.
* N NUMBER OF FILES TO COPY.
* NA DO NOT ABORT IF RECORD NOT Z-TYPE DATA.
*
* ASSUMED PARAMETERS.
* IFILE = *INPUT*
* OFILE = *OUTPUT*
* N = 1
* NA NOT SPECIFIED.
COPYSBF BSS 0 ENTRY
SB1 1 (B1) = 1
RJ PRS PRESET PROGRAM
RJ CNA CHECK FOR *NO ABORT* PARAMETER
NZ B7,ERR3 IF TOO MANY PARAMETERS
SX6 -1 SET CHARACTER -1
SA6 FC
SX7 LINL SET MAXIMUM LINE LENGTH
SA7 LC
SA1 I SET BINARY OPERATION
SA2 O
SX3 2
BX6 X1+X3
BX7 X2+X3
SA6 A1
SA7 A2
SX0 0 INITIALIZE LINE TRANSFER COUNT
CSF1 READ I BEGIN READ
RECALL O
READS I,BUF,-BUFL
NZ X1,CSF3 IF EOR, EOF, OR EOI
SA2 SK
NZ X2,CSF2 IF SKIP SET
SB7 BUF+BUFL LWA+1 OF BUFFER
NE B6,B7,CSF1.1 IF BUFFER NOT FULL
SA1 LTC INCREMENT TRUNCATION COUNT
SX3 B1
IX7 X1+X3
SA7 A1 UPDATE COUNT
SB6 B6-B1 DECREMENT CHARACTER COUNT
CSF1.1 SX6 1R1 SET PAGE EJECT
SB5 B6-BUF+1 GET NUMBER OF CHARACTERS IN BUFFER
SA6 BUF-1
WRITES O,BUF-1,B5 OUTPUT LINE
SX6 1R CLEAR EJECT
SA6 BUF-1
SX1 B1
IX0 X0+X1 SHOW LINE WRITTEN OUT ALREADY
CSF2 READS I,BUF,-BUFL COPY REMAINDER OF RECORD
CSF3 RJ CPR
NG X1,ITM IF EOI
ZR X1,CSF1 LOOP TO EOF
SA2 CT DECREMENT COUNT
SX6 X2-1
SA6 A2
NZ X6,CSF1 LOOP FOR ALL FILES
EQ ITM TERMINATE PROGRAM
SCOPY SPACE 4,25
*** SCOPY(IFILE,OFILE,N,FCAR,LCAR,NA,R,FCS,FLINE,LLINE,NS)
*
*
* *SCOPY* (STRUCTURE COPY) IS SIMILAR TO *COPYCF*, WITH EXTRA
* PARAMETERS. THE FIRST SIX PARAMETERS ARE EXPLAINED IN THE
* *COPYCF* HEADER. THE EXTRA PARAMETERS ARE AS FOLLOWS.
*
* R REWIND BOTH INPUT AND OUTPUT FILES.
* FCS FILE CHARACTER SET -
* D, BLANK, OR OMITTED = 6/12 DISPLAY CODE.
* FLINE LINE NUMBER OF FIRST LINE TO COPY.
* LLINE LINE NUMBER OF LAST LINE TO COPY.
* NS NO STRUCTURE REPORTING.
*
* DEFAULT VALUES (IF PARAMETER OMITTED) -
*
* N -1 (COPY TO EOI).
* LCHAR 500 (250 6/12 CHARACTERS).
* R DO NOT REWIND FILES.
* FCS 6/12 DISPLAY CODE.
* FLINE PRESENT POSITION, BOI IF REWIND SPECIFIED.
* LLINE EOI OR END OF FILE COUNT.
* NS REPORT FILE STRUCTURE.
SCOPY BSS 0 ENTRY
SB1 1
SX6 B1 SET *SCOPY* FLAG
SX7 B1 SET STRUCTURE REPORTING
SA6 SC
SA7 NS
SX6 500D SET 250-CHARACTER LINE LENGTH
SX7 -1 SET TO COPY TO EOI
SA6 LC
SA7 CT
RJ PRS PRESET PROGRAM
RJ SCC SET CHARACTER COUNTS
RJ SXP SET EXTRA PARAMETERS
EQ CCF1 PROCESS FILE
TITLE SUBROUTINES.
CPR SPACE 4,20
** CPR - COPY RECORD.
*
* ENTRY (X1) = FIRST BLOCK STATUS.
* (X0) = NUMBER OF LINES COPIED.
* (B6) = ADDRESS PLUS ONE OF LAST CHARACTER IN BUFFER.
*
* EXIT (X1) .LT. 0, IF EOI ENCOUNTERED.
* (X1) .NE. 0, IF EOF ENCOUNTERED.
* (X1) = 0, IF EOR ENCOUNTERED.
*
* USES X - 0, 1, 2, 3, 6, 7.
* B - 5, 7.
* A - 1, 2, 3, 7.
*
* CALLS SLR.
*
* MACROS ABORT, READS, MESSAGE, WRITEF, WRITER, WRITEW.
CPR SUBR ENTRY/EXIT
BX7 X1
SA7 CPRA SAVE READ STATUS
NZ X1,CPR4 IF EOR, EOF, OR EOI
CPR1 SA2 SK
SX3 B1
IX0 X0+X3 SHOW LINE COPIED
NZ X2,CPR3 IF SKIP SET
SB7 BUF+BUFL LWA+1 OF BUFFER
NE B6,B7,CPR1.1 IF BUFFER NOT FULL
SA1 LTC INCREMENT TRUNCATION COUNT
IX7 X1+X3
SA7 A1+ UPDATE COUNT
SB6 B6-B1 DECREMENT CHARACTER COUNT
CPR1.1 SA1 FC
SA3 LC
SB5 X1+BUF ADDRESS OF FIRST CHARACTER TO BE OUTPUT
GE B5,B6,CPR9 IF FIRST CHARACTER TO COPY AFTER EOL
SB5 X3+BUF ADDRESS OF LAST CHARACTER TO BE OUTPUT
LE B5,B6,CPR2 IF LAST CHARACTER TO COPY BEFORE EOL
SX3 B6-BUF RESET LAST CHARACTER
CPR2 IX6 X3-X1 NUMBER OF CHARACTERS TO BE OUTPUT
RJ SLR SELECT LINE RANGE
NG X6,CPR3 IF LINE NOT TO BE PRINTED
WRITES O,X1+BUF,X6
CPR3 SA1 CPRA
NZ X1,CPR4.1 IF LAST READ STATUS WAS EOR/EOF/EOI
READS I,BUF,-BUFL
BX7 X1
SA7 CPRA SAVE READ STATUS
ZR X1,CPR1 LOOP IF NO EOR/EOF
CPR4 SB5 B6-BUF
NZ B5,CPR8 IF UNTERMINATED LINE
CPR4.1 NG X1,CPR6 IF EOF OR EOI
* PROCESS EOR.
SA2 NS CHECK STRUCTURE PARAMETER
ZR X2,CPR4.2 IF STRUCTURE NOT REQUESTED
WRITEW O,CPRB,2
CPR4.2 SA2 SK
NZ X2,CPR5 IF SKIP SET
WRITER O END RECORD
CPR5 SX1 B0 SET EOR STATUS
SA3 RCNT INCREMENT RECORD COUNT
SX7 X3+B1
SA7 A3
EQ CPRX RETURN
* PROCESS EOF AND EOI.
CPR6 SA2 NS
ZR X2,CPR6.1 IF STRUCTURE NOT REQUESTED
WRITEW O,CPRC,2
CPR6.1 SA2 SK
NZ X2,CPR7 IF SKIP SET
WRITEF O
CPR7 SA2 I CHECK FILE STATUS
LX2 59-9
SX1 B1 SET EOF
SA3 FCNT INCREMENT FILE COUNT
SX6 X3+B1
SA6 A3
PL X2,CPRX IF NOT EOI
SX1 -B1 SET EOI STATUS
EQ CPRX RETURN
CPR8 SX7 B1 SET NON Z-TYPE DATA FLAG
SA7 NZ
SA1 NA
NZ X1,CPR1 IF NO-ABORT SPECIFIED
MESSAGE ITMD,0 ISSUE NO LINE TERMINATOR MESSAGE
ABORT
CPR9 WRITEW O,(=1L ),B1 ISSUE NULL LINE
EQ CPR3 CONTINUE RECORD COPY
CPRA CON 0 LAST READ STATUS
CPRB DATA C*--EOR-- *
CPRC DATA C*--EOF-- *
ITM SPACE 4,15
** ITM - ISSUE TERMINATION MESSAGES.
*
* ENTRY (LTC) = NUMBER OF LINES TRUNCATED.
* (X1) = -1 IF EOI ENCOUNTERED.
* = 0 IF EOR ENCOUNTERED.
* = 1 IF EOF ENCOUNTERED.
*
* EXIT APPROPRIATE MESSAGES ISSUED TO DAYFILE.
*
* USES X - 1, 2, 5, 7.
* A - 1, 2, 7.
* B - 2, 5.
*
* CALLS CDD, SNM.
*
* MACROS ENDRUN, MESSAGE.
ITM BSS 0 ENTRY
SX7 X1+ SAVE TERMINATION TYPE
SA7 ITME
SA1 X1+ITMG+1 TERMINATION TYPE
SB5 ITMF
SB2 1R/
RJ SNM SET TERMINATION TYPE INTO MESSAGE
SA1 LTC GET TRUNCATION COUNT
ZR X1,ITM1 IF NO LINES TRUNCATED
RJ CDD CONVERT TO DECIMAL DISPLAY CODE
MX1 1 ENTER COUNT IN MESSAGE
SB2 B2-B1
AX1 B2
BX1 X1*X4
SB2 1RX
SB5 ITMA
RJ SNM
MESSAGE ITMA,3 ISSUE LINES TRUNCATED MESSAGE
ITM1 SA1 NZ
ZR X1,ITM2 IF Z-TYPE DATA
MESSAGE ITMD,0 ISSUE NO LINE TERMINATOR MESSAGE
ITM2 SX1 ITMB * EOI ENCOUNTERED.*
SA2 ITME
NG X2,ITM3 IF EOI ENCOUNTERED
SX1 ITMC * COPY COMPLETE.*
ITM3 MESSAGE X1,0 ISSUE COMPLETION MESSAGE
SA1 FCNT FILE COUNT
RJ CDD CONVERT TO DISPLAY
SB2 B2-B1
MX5 1
AX1 X5,B2
BX1 X1*X4 ZERO FILL
SB5 ITMF
SB2 1R+
RJ SNM SET FILE COUNT INTO MESSAGE
SA1 FCNT
SX1 X1-1
ZR X1,ITM3.1 IF JUST ONE FILE
SA1 =1LS
ITM3.1 SB2 1R#
RJ SNM SET PLURAL INTO MESSAGE
SA1 RCNT RECORD COUNT
RJ CDD CONVERT TO DISPLAY
SB2 B2-B1
AX1 X5,B2
BX1 X1*X4 ZERO FILL
SB2 1R-
RJ SNM SET RECORD COUNT INTO MESSAGE
SA1 RCNT
SX1 X1-1
ZR X1,ITM3.2 IF JUST ONE RECORD
SA1 =1LS
ITM3.2 SB2 1R$
RJ SNM SET PLURAL INTO MESSAGE
BX1 X0 LINE COUNT
RJ CDD CONVERT TO DISPLAY
SB2 B2-B1
AX1 X5,B2
BX1 X1*X4 ZERO FILL
SB2 1R,
RJ SNM SET LINE COUNT INTO MESSAGE
SX1 B1
IX1 X0-X1
ZR X1,ITM3.3 IF JUST ONE LINE
SA1 =1LS
ITM3.3 SB2 1R=
RJ SNM SET PLURAL INTO MESSAGE
MESSAGE ITMF
SA2 SC CHECK CALL
ZR X2,ITM4 IF NOT *SCOPY*
MESSAGE =0,1 CLEAR *MS1W* FOR INTERACTIVE USERS
ITM4 ENDRUN
ITMA DATA C* XXXXXXXXXX LINE(S) TRUNCATED.*
ITMB DATA C* EOI ENCOUNTERED.*
ITMC DATA C* COPY COMPLETE.*
ITMD DATA C* NO LINE TERMINATOR AT EOR(S).*
ITME BSS 1 TERMINATION TYPE
ITMF DATA C* ///. ++++++++++ FILE#; ---------- RECORD$; ,,,,,,,,,
,, LINE=.*
ITMG DATA L*EOI*
DATA L*EOR*
DATA L*EOF*
SLR SPACE 4,15
** SLR - SELECT LINE RANGE.
*
* ENTRY (X1) = OFFSET INTO BUF OF FIRST CHARACTER OF LINE.
* (X6) = NUMBER OF CHARACTERS IN LINE.
*
* EXIT (X1) = UNCHANGED.
* (X6) = UNCHANGED IF LINE TO BE COPIED.
* = -1 IF LINE TO BE SKIPPED.
*
* USES X - 1, 2, 3, 4, 5, 6.
* A - 1, 2, 3, 4, 6.
* B - 6, 7.
*
* CALLS DXB.
SLR SUBR ENTRY/EXIT
SA2 FL CHECK LINE RANGE
SA3 LL
IX2 X2+X3
NG X2,SLRX IF NO LINE RANGE SPECIFIED
SB7 X6 SET CHARACTER COUNT
SA6 SLRB SAVE ENTRY CONDITION
BX6 X1
SA6 A6-B1
SA1 X1+BUF GET FIRST CHARACTER
BX5 X5-X5 CLEAR ASSEMBLY WORD
SB6 60
* PROCESS DISPLAY CODE FILE.
SLR1 SX2 X1-1R0 CHECK CHARACTER
NG X2,SLR2 IF NOT NUMERIC
SX2 X1-1R+
PL X2,SLR2 IF NOT NUMERIC
SB6 B6-6
LX1 X1,B6
BX5 X1+X5 MERGE DIGIT
ZR B6,SLR2 IF TEN DIGITS PROCESSED
SB7 B7-B1
SA1 A1+B1
ZR B7,SLR2 IF END OF LINE
EQ SLR1 CONTINUE PROCESSING
SLR2 ZR X5,SLR3 IF NO DIGITS FOUND
RJ DXB TRANSLATE LINE NUMBER
SA2 SLRB
SA3 FL
SA4 LL
IX5 X6-X3
SA1 SLRA
IX3 X4-X6
NG X5,SLR3 IF LINE NOT IN RANGE
BX6 X2
NG X4,SLRX IF NO END OF RANGE SPECIFIEC
PL X3,SLRX IF IN RANGE
SLR3 SX6 -1
EQ SLRX EXIT
SLRA CON 0 SAVE (X1)
SLRB CON 0 SAVE (X6)
SPACE 4
* COMMON DECKS.
*CALL COMCCDD
*CALL COMCCIO
*CALL COMCDXB
*CALL COMCRDS
*CALL COMCRDW
*CALL COMCSNM
*CALL COMCSYS
*CALL COMCWTS
*CALL COMCWTW
SPACE 4
** BUFFERS.
BUFFERS BSS 0
USE //
SEG
BSS 1
BUF BSS BUFL
IBUF BSS IBUFL
OBUF BSS OBUFL
RFL= BSS 0
PRS TITLE PRESET.
** PRS - PRESET PROGRAM.
*
* EXIT (B7) = REMAINDER ARGUMENT COUNT.
* (A5) = LAST ARGUMENT ADDRESS.
ORG BUF
PRS SUBR ENTRY/EXIT
SX6 IBUF ENTER POINTER TO INPUT BUFFER
SA6 0
SA1 ACTR CHECK ARGUMENT COUNT
MX4 42
SB7 X1
ZR B7,PRSX IF NO ARGUMENTS
* PROCESS IFILE NAME.
SA5 ARGR SET IFILE NAME
SA2 I
BX7 X4*X5
SX3 X2
ZR X7,PRS1 IF BLANK ARGUMENT
IX7 X7+X3
SA7 A2
* PROCESS OFILE NAME.
PRS1 SB7 B7-B1
ZR B7,PRS2 IF 1 ARGUMENT
SA5 A5+B1 SET OFILE NAME
SA2 O
BX7 X4*X5
SB7 B7-B1
ZR X7,PRS2 IF BLANK ARGUMENT
IX7 X7+X3
SA7 A2
* CHECK FILE NAMES.
PRS2 SA1 I CHECK FILE NAMES
SA2 O
IX7 X1-X2
NZ X7,PRS3 IF IFILE .NE. OFILE
SX6 B1 SET SKIP FLAG
SA6 SK
* PROCESS COUNT.
PRS3 ZR B7,PRSX IF NO ADDITIONAL ARGUMENTS
SA5 A5+1
ZR X5,PRS4 IF BLANK ARGUMENT
RJ DXB CONVERT NUMBER
NZ X4,ERR1 IF INCORRECT COUNT
ZR X6,ERR1 IF COUNT = 0
SA6 CT
PRS4 SB7 B7-1
EQ PRSX RETURN
SPACE 4,15
** SCC - SET CHARACTER COUNTS.
*
* ENTRY (A5) = ADDRESS OF LAST ARGUMENT PROCESSED.
* (B7) = REMAINING ARGUMENT COUNT.
*
* EXIT (A5) = ADDRESS-1 OF NEXT ARGUMENT.
* (B7) = REMAINING ARGUMENT COUNT.
* (NA) = 1 IF NO-ABORT SPECIFIED.
*
* USES X - 1, 2, 5, 6.
* A - 1, 2, 5, 6.
* B - 2, 7.
*
* CALLS CNA, DXB.
SCC SUBR ENTRY/EXIT
ZR B7,SCCX IF NO REMAINING ARGUMENTS
SA5 A5+B1 CHECK START CHARACTER
ZR X5,SCC2 IF BLANK
RJ DXB
NZ X4,ERR2 IF INCORRECT COUNT
ZR X6,ERR2 IF FIRST CHARACTER COUNT = ZERO
SB2 X6-BUFL-1
PL B2,ERR2 IF FIRST OUT OF RANGE
SX6 X6-1
SA6 FC
SCC2 SB7 B7-B1
ZR B7,SCC3 IF NO ADDITIONAL COUNTS
SA5 A5+B1 CHECK TERMINAL CHARACTER
ZR X5,SCC2.1 IF BLANK
RJ DXB
NZ X4,ERR2 IF INCORRECT COUNT
SB2 X6-BUFL-1
PL B2,ERR2 IF LAST OUT OF RANGE
SA6 LC
SCC2.1 SB7 B7-B1 DECREMENT ARGUMENT COUNT
SCC3 SA1 FC CHECK CHARACTER LIMITS
SA2 LC
IX6 X2-X1
NG X6,ERR2 IF FIRST .GT. LAST
RJ CNA CHECK FOR *NA* PARAMETER
EQ SCCX RETURN
CNA SPACE 4,10
** CNA - CHECK FOR *NA* PARAMETER (NO ABORT).
*
* ENTRY (A5) = ADDRESS OF LAST ARGUMENT PROCESSED.
* (B7) = REMAINING ARGUMENT COUNT.
*
* EXIT (NA) = 1 IF NO-ABORT SPECIFIED.
* (B7) = REMAINING ARGUMENT COUNT.
*
* USES X - 5, 6.
* A - 5, 6.
* B - 7.
CNA SUBR ENTRY/EXIT
ZR B7,CNAX IF NO REMAINING ARGUMENTS
SA5 A5+B1 CHECK *NA* PARAMETER
SB7 B7-B1
ZR X5,CNAX IF BLANK
SX6 B1
SA6 NA SET *NA* FLAG
EQ CNAX RETURN
SXP SPACE 4,15
** SXP - SET EXTRA PARAMETERS.
*
* ENTRY (A5) = ADDRESS OF LAST ARGUMENT PROCESSED.
* (B7) = ARGUMENT COUNT.
*
* USES X - 0, 1, 2, 4, 5, 6.
* A - 1, 2, 5, 6.
* B - 7.
*
* CALLS CCS, DXB, ERR.
*
* MACROS REWIND.
SXP SUBR ENTRY/EXIT
ZR B7,SXPX IF NO REMAINING ARGUMENTS
* PROCESS REWIND PARAMETER.
SA5 A5+B1
ZR X5,SXP1 IF NULL PARAMETER
AX5 54
SX6 X5-1RR
NZ X6,ERR4 IF INCORRECT PARAMETER
REWIND I
REWIND O
SXP1 SB7 B7-B1
RJ CCS CHECK CHARACTER SET
ZR B7,SXPX IF NO MORE PARAMETERS
* PROCESS LINE NUMBER PARAMETERS.
SA5 A5+B1 GET FIRST LINE NUMBER
ZR X5,SXP2 IF NULL PARAMETER
RJ DXB TRANSLATE PARAMETER
NZ X4,ERR5 IF ERROR DETECTED
SA6 FL
SXP2 SB7 B7-B1
ZR B7,SXPX IF NO MORE PARAMETERS
SA5 A5+B1
ZR X5,SXP3 IF NULL PARAMETER
RJ DXB TRANSLATE PARAMETER
NZ X4,ERR5 IF ERROR DETECTED
SA6 LL
ZR X6,SXP3 IF EOI SPECIFIED
SA1 FL
IX6 X6-X1
NG X6,ERR5 IF FIRST .GT. LAST
SXP3 SB7 B7-B1
ZR B7,SXPX IF NO MORE PARAMETERS
* PROCESS STRUCTURE PARAMETER.
SA5 A5+B1
ZR X5,SXP4 IF NULL PARAMETER
AX5 48
BX6 X6-X6
SX5 X5-2RNS
NZ X5,ERR6 IF NOT *NS*
SA6 NS
SXP4 SB7 B7-B1
NZ B7,ERR3 IF TOO MANY PARAMETERS
EQ SXPX EXIT
CCS SPACE 4,15
** CCS - CHECK CHARACTER SET.
*
* ENTRY (A5) = ADDRESS OF LAST ARGUMENT PROCESSED.
* (B7) = NUMBER OF PARAMETERS LEFT TO PROCESS.
*
* EXIT (A5) = UPDATED.
* (B7) = UPDATED.
*
* USES X - 1, 2, 5.
* A - 5.
* B - 7.
*
* CALLS ERR.
CCS SUBR ENTRY/EXIT
ZR B7,CCSX IF NO REMAINING ARGUMENTS
SA5 A5+B1
SB7 B7-B1
ZR X5,CCSX IF NULL PARAMETER
MX2 48
BX5 X2*X5
LX5 6
SX1 X5-1RD
NZ X1,ERR7 IF NOT 6/12 DISPLAY CODE
EQ CCSX EXIT
ERR SPACE 4
** ERR - PROCESS ERRORS.
ERR1 SX0 ERRA
EQ ERR
ERR2 SX0 ERRB
EQ ERR EXIT
ERR3 SX0 ERRC
EQ ERR EXIT
ERR4 SX0 ERRD
EQ ERR EXIT
ERR5 SX0 ERRE
EQ ERR EXIT
ERR6 SX0 ERRF
EQ ERR EXIT
ERR7 SX0 ERRG
ERR MESSAGE X0
ABORT
ERRA DATA C*INCORRECT COUNT.*
ERRB DATA C*INCORRECT CHARACTER NUMBER.*
ERRC DATA C*TOO MANY PARAMETERS.*
ERRD DATA C*INCORRECT REWIND SPECIFICATION.*
ERRE DATA C*INCORRECT LINE NUMBER SPECIFICATION.*
ERRF DATA C*INCORRECT STRUCTURE SPECIFICATION.*
ERRG DATA C*INCORRECT CHARACTER SET SPECIFICATION.*
SPACE 4
END