IDENT DOCMENT,FETS
ABS
ENTRY DOCMENT
ENTRY MFL=
SYSCOM B1
LIST F
DOCMENT TITLE DOCMENT - INTERNAL/EXTERNAL DOCUMENTATION PROGRAM.
*COMMENT DOCMENT - INTERNAL/EXTERNAL DOCUMENTATION PROGRAM.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,10
*** DOCMENT - INTERNAL/EXTERNAL DOCUMENTATION PROGRAM.
* R.S. HORECK 70/07/06.
SPACE 4
*** CONTROL CARD CALL.
*
* DOCMENT(P1,P2,P3,,,PN)
*
* THE PARAMETERS P(I) MAY INCLUDE THE FOLLOWING (IN ANY ORDER)
* AND MUST BE IN ONE OF THE FORMS -
*
* * * - (NONE) ASSUME FIRST DEFAULT VALUE.
* P - ASSUME ALTERNATE DEFAULT VALUE.
* P=X - SUBSTITUTE *X* FOR ANY ASSUMED VALUE OF *P*.
*
* ANY NUMERIC PARAMETER MAY BE SPECIFIED WITH A POST RADIX
* TO CLARIFY ITS VALUE. THE RADIX MAY BE *D* OR *B*.
*
* I - INPUT FILE NAME ON WHICH TO FIND PAGE FOOTING INFORMATION.
* THIS MUST BE A SINGLE CARD OF THE FORMAT -
* COLUMN(S) - CONTENTS -
* 2-45 DOCUMENT TITLE - COLUMN 1 MUST BE BLANK.
* 46-55 PUBLICATION NUMBER.
* 56-60 REVISION LEVEL.
* 61-70 REVISION DATE.
* S - FILE CONTAINING THE SOURCE CARD IMAGES FROM WHICH TO
* EXTRACT THE DOCUMENTATION. THIS FILE IS REWOUND
* UNLESS THE *NR* PARAMETER IS SPECIFIED.
* L - FILE ON WHICH DOCUMENTATION IS TO BE WRITTEN.
* N - NUMBER OF COPIES TO BE PRODUCED.
* T - DOCUMENTATION TYPE (INT OR EXT)
* C - CHECK CHARACTER FOR DOCUMENTATION.
* P - NUMBER OF PRINT LINES / PAGE.
* NR - DISABLE REWIND ON THE *S* (SOURCE) FILE.
* NT - NEGATE THE TABLE GENERATOR.
* TC - LIST TABLE OF CONTENTS.
*
* DEFAULT PARAMETER SUBSTITUTION VALUES -
*
* FIRST ALTERNATE
* PARAMETER DEFAULT DEFAULT - COMMENT -
*
* I *0* *INPUT* PAGE FOOT INFORMATION.
* S *COMPILE* *SOURCE* SOURCE CARD IMAGES.
* L *OUTPUT* *OUTPUT* LIST FILE.
* N 1 1 DECIMAL NUMBER OF COPIES.
* T *EXT* *INT* DOCUMENTATION TYPE.
* C -*- *03* CHECK CHAR. (2 OCTAL DIGITS)
* P PS SPS NUMBER OF PRINT LINES/PAGE.
* PS = JOB PAGE SIZE.
* SPS = SYSTEM PAGE SIZE.
* NR REWIND NO REWIND STATUS OF SOURCE FILE REWIND.
* NT ON OFF STATUS OF TABLE GENERATOR.
* TC OFF ON STATUS OF TABLE OF CONTENTS.
SPACE 4,10
*** DOCUMENTATION FOLLOWS THE FOLLOWING RULES.
*
* EXTERNAL DOCUMENTATION -
* THREE ASTERISKS STARTING IN COLUMN 1 START DOCUMEN-
* TATION WHICH CONTINUES UNTIL ALL CONSECUTIVE CARDS
* WITH COLUMN 1 ASTERISKS HAVE BEEN EXHAUSTED.
*
* INTERNAL DOCUMENTATION -
* TWO OR THREE ASTERISKS STARTING IN COLUMN 1 START DOC-
* UMENTATION WHICH CONTINUES UNTIL ALL CONSECUTIVE CARDS
* CONTAINING COLUMN 1 ASTERISKS HAVE BEEN EXHAUSTED.
*
* IN ADDITION, ANY CARD WITH FOUR (4) ASTERISKS STARTING
* IN COLUMN 1 ACTS AS A TOGGLE FOR DOCUMENTATION. IN THIS
* MANNER WHEN A CARD IS FOUND TO CONTAIN 4 ASTERISKS
* STARTING IN COLUMN 1, THAT CARD AND ALL SUCCEEDING
* CARDS THROUGH ANOTHER LIKE CARD (REGARDLESS OF THE
* COLUMN 1 CHARACTER) ARE CONSIDERED TO BE PART OF THE
* DOCUMENTATION.
*
* DOCUMENTATION FORMAT -
*
* EACH PAGE OF DOCUMENTATION IS COMPOSED OF 3 ELEMENTS
*
* 1. PAGE HEADER - THIS LINE GIVES THE FIRST 45 CHARAC-
* TERS (LEADING BLANKS SUPPRESSED) OF THE
* SUBPROGRAM HEADER (I.E. SUBROUTINE,IDENT,
* ETC.), THE CURRENT DATE, AND THE DOCUMEN-
* TATION TYPE (EXT OR INT).
* 2. DOCUMENTATION TEXT - DOCUMENTATION EXTRACTED FROM
* THE SOURCE CARDS (EACH SUBGROUP SEPARATED
* BY 4 BLANK LINES).
* 3. PAGE FOOTING - THIS LINE INCLUDES THE 70 CHARACTERS
* READ FROM THE *INPUT* FILE AND THE PAGE
* NUMBER OF THE FORM *X/Y* WHERE - X IS THE
* NUMBER OF THE SUBPROGRAM (CHAPTER) AND Y
* IS THE PAGE WITHIN THIS CHAPTER.
*
* SPECIAL CARD TYPES -
*
* DOCUMENTATION CARDS CONTAINING *E IN COLUMNS 1 AND 2 CAUSE
* THE PAGE TO BE EJECTED.
*
* DOCUMENTATION CARDS CONTAINING *T IN COLUMNS 1 AND 2 ACTIVATE
* THE TABLE WRITER.
* FOR EXAMPLE, THE CARD -
* *T EXAMPLE 24/PP PROGRAM NAME+RECALL,18/PARAMETER 1,18/PARAMETER 2
* WOULD GENERATE THE FOLLOWING TABLE PICTURE -
*
*T EXAMPLE 24/PP PROGRAM NAME+RECALL,18/PARAMETER 1,18/PARAMETER 2
*
* THE IDENTIFICATION *EXAMPLE* MAY BE OMITTED.
* EACH TIME A NEW BLOCK OF *T CARDS IS ENCOUNTERED,
* A BIT POSITION HEADER IS LISTED. THIS HEADER IS NOT
* LISTED FOR EACH CONSECUTIVE TABLE CARD OR FOR ANY
* CARD CONTAINING A NON-BLANK CHARACTER IN COLUMN 3 OF
* THE FIRST *T CARD IN A BLOCK.
* CARD FORMAT IS THE SAME AS FOR THE COMPASS *VFD*
* PSEUDO INSTRUCTION, HOWEVER, NO *VFD* MAY BE PRESENT.
* A SLASH */* MUST IMMEDIATELY FOLLOW A BIT COUNT
* FIELD, BUT LEADING SPACES ARE IGNORED.
* ALL BIT COUNTS FOR FIELD WIDTHS MAY BE SPECIFIED IN
* EITHER OCTAL OR DECIMAL. DECIMAL COUNTS ARE ASSUMED
* IN THE ABSENCE OF A POST-RADIX (B) OR (D).
* MAXIMUM PICTURE WIDTH IS 60 BITS.
* A SLASH SEPARATES FIELDS IN THE PICTURE AND THE
* BIT POSITION IT OCCUPIES IS INCLUDED IN THE FIELD
* TO ITS LEFT. SINGLE BIT FIELDS ARE LISTED WITHOUT
* A SLASH FIELD SEPARATOR. ALL TABLE ENTRY
* DESCRIPTION CARDS WITHIN A *T BLOCK ARE CONSIDERED
* TO HAVE THE SAME TOTAL NUMBER OF BITS.
* FIELD LABELS ARE LEFT JUSTIFIED WITHIN THE FIELD
* AND WILL BE TRUNCATED IF THE LABEL CONTAINS MORE
* CHARACTERS THAN THE BIT COUNT MINUS 1.
* IF THE THIRD CHARACTER ON THE CARD IS NON-BLANK, NO
* BIT COUNT HEADER WILL BE PLACED ABOVE THE TABLE
* ENTRY. SINGLE BIT FIELDS WILL BE LISTED WITH A *+*
* BELOW THE FIELD POSITION. THE ONLY EXCEPTION TO THIS
* IS THE CASE WHERE ONLY ONE TABLE ENTRY IS LISTED. IN
* THIS INSTANCE THE *+* WILL BE LISTED BOTH ABOVE AND
* BELOW THE FIELD POSITION.
*
* ALL LOADER CONTROL CARDS (I.E. OVERLAY,SECTION,ETC.) ARE
* CONSIDERED SPECIAL AND THEIR IMAGES ARE PLACED ALONG
* WITH THE PAGE NUMBER AT THE FOOT OF EACH SUBPROGRAM
* ENCOMPASSED BY THE SCOPE OF THE DIRECTIVE.
* ALL *END* CARDS ARE CONSIDERED SPECIAL SINCE THEY TERMINATE A
* CHAPTER.
* IN COMPASS THE FOLLOWING CARDS ALSO HAVE SPECIAL MEANING -
* TITLE - THE FIRST TITLE CARD REPLACES THE PAGE HEADER
* WITH ITS CONTENTS (IF NON-BLANK).
* SUBSEQUENT TITLE CARDS ARE IGNORED.
* LIST - THE PARAMETERS *X* AND *L* ARE PROCESSED. IF A
* *-L* IS ENCOUNTERED ALL DOCUMENTATION IS
* SUPRESSED UNTIL A *LIST L* CARD IS ENCOUN-
* TERED. IF A *-X* (ASSUMED) IS ENCOUNTERED,
* NO DOCUMENTATION WILL BE PROCESSED ON
* COMMON TEXT *CTEXT* UNTIL A *LIST X* CARD
* IS FOUND. ONLY A DEFINED NUMBER OF LIST
* CARDS MAY BE PROCESSED. THIS NUMBER IS
* DEFINED BY THE TAG *NLCA*. EACH (LIST *)
* CARD ALLOWS AN EXTRA LIST CARD TO BE
* PROCESSED ABOVE THE NUMBER *NLCA*.
* CTEXT,ENDX - BRACKET CARDS SURROUNDING COMMON TEXT -
* NO DOCUMENTATION IS LISTED UNLESS A *LIST
* X* CARD HAS BEEN ENCOUNTERED.
* COL - DATA BEYOND THE COMMENT COLUMN IS NOT
* EXAMINED FOR KEYWORDS. IF A *COL*
* CARD IS ENCOUNTERED, THE COMMENT
* COLUMN IS CHANGED TO THE COLUMN
* SPECIFIED ON THE *COL* CARD.
TITLE DATA DEFINITION.
* CONSTANTS.
SBUFL EQU 201B LENGTH OF TABLE OF CONTENTS BUFFER
BFSZ EQU 3001B BUFFER SIZE
NBFS EQU 2 NUMBER OF BUFFERS
NCR EQU 72 NUMBER OF CHARACTERS TO READ FROM A CARD
NLCA EQU 24 NUMBER OF LIST CARDS ALLOWED
FLP EQU 7 NUMBER OF HEADER FOOTER LINES
MPGS EQU 16D MINIMUM PAGE SIZE
SPACE 4,10
*CALL COMCMAC
*CALL COMCCMD
SPACE 4,10
ORG 110B
FETS BSS 0
S VFD 42/0LCOMPILE,18/3 FETS FOR INPUT AND SOURCE
O VFD 42/0LOUTPUT,18/3 FETS FOR OUTPUT AND SCRATCH
SCR1 FILEB BUF,BFSZ
SCR2 FILEB SBUF,SBUFL
I BSS 0
INPUT FILEB BUF+BFSZ,BFSZ
INPX EQU *
ORG INPUT
CON 0
ORG INPX
* TABLE OF SPECIAL NAMES.
TNM VFD 60/-0 10 CHAR MASK
DATA 10HSUBROUTINE
DATA 10HPRECISION
VFD 48/-0,12/ 8 CHAR MASK
DATA 8LFUNCTION
VFD 42/-0,18/ 7 CHAR MASK
DATA 7LPROGRAM
DATA 7LINTEGER
DATA 7LFORTRAN
DATA 7LLOGICAL
DATA 7LOVERLAY
DATA 7LSEGMENT
DATA 7LSECTION
DATA 7LSEGZERO
DATA 7LCHNLINK
VFD 36/-0,24/ 6 CHAR MASK
DATA 6LDOUBLE
DATA 6LSINGLE
VFD 30/-0,30/ 5 CHAR MASK
DATA 5LIDENT
DATA 5LBLOCK
VFD 24/-0,36/ 4 CHAR MASK
DATA 4LTYPE
DATA 4LDATA
DATA 4LREAL
VFD 12/-0,48/ 2 CHAR MASK
DATA 2LII
DATA 2LIV
DATA 2LVI
VFD 60/ END OF TABLE
SPACE 4
* VARIABLES.
NAS DATA 20 NUMBER OF ASTERISKS NECESSARY IN THE FIRST
MAS DATA 3 MINIMUM NUMBER OF ASTERISKS NEEDED FOR DOC
XFL DATA 0 LIST X FLAG
FOUR COLUMNS TO TURN TOGGLE
TOG DATA 0 TOGGLE FOR **** CARDS (INT ONLY) 0=NO,1=YES
PTYP CON 0 PROGRAM TYPE (0=*COMPASS*, 1=FORTRAN)
FCR DATA 1 FIRST COLUMN TO CHECK ON INPUT CARD
CCM DATA 30 COLUMN FOR COMMENTS
LCT BSS 1 LINE COUNT
LLM BSS 1 MAXIMUM NUMBER OF LINES PER PAGE
PD BSS 1 PRINT DENSITY
HDSL1 BSS 1 HEADING SUBLENGTH 1
HDSL2 BSS 1 HEADING SUBLENGTH 2
HDG BSS 5 HEADING LINE
HDG1 CON 0 DATE
HDG2 DATA 10H EXTERNAL
CON 0 END OF LINE
FOT DATA 40H CONTROL DATA SYSTEMS DOCUMENTATION.
DATA 30H
BSSZ 1 END OF LINE FLAG
SBF DATA 10H
DUP 5,1
DATA 10H
PGE VFD 42/7H PAGE ,18/
BSSZ 1 SUBPAGE NUMBER
CHP BSSZ 1 CHAPTER COUNT
SPG BSSZ 1 SUBCHAPTER PAGE COUNT
EDAS DATA 3 SAME AS MAS
IDAS DATA 20 SAME AS NAS
FLF DATA 0 FIRST LINE LISTED FLAG
PCT DATA 0 PAGE COUNT FOR PAGE PARITY CHECK
* INPUT PARAMETERS.
N CON 1L1
T CON 0LEXT
C CON 0L47B
P CON 0 LINES PER PAGE
NR CON 0 DISABLE SOURCE FILE REWIND
NT CON 0
TC CON 0
NI CON 0
TITLE MAIN PROGRAM.
** DOCMENT - MAIN PROGRAM.
DOCMENT SB1 1
RJ IPP INITIALIZE PAGE PARAMETERS
SA1 ACTR GET ARGUMENT COUNT
R= A4,ARGR FIRST ARGUMENT
SB4 X1
SB5 ARGA ADDRESS OF ARGUMENT TABLE
RJ ARG PROCESS ARGUMENTS
NZ X1,DOC7 IF ERROR IN ARGUMENTS
RJ CKO CHECK OPTIONS
RJ CTF CHECK TERMINAL FILE
RJ CTP CALCULATE TITLE PAGE
REWIND SCR2,R REWIND SCRATCH FILE
REWIND SCR1,R REWIND SCRATCH FILE
RJ RIF READ INPUT FILE
SA5 S CHANGE FILE NAME OF INPUT
BX6 X5
SA6 I
SA1 NR
NZ X1,DOC0.1 IF NO REWIND OF SOURCE FILE
REWIND A6,R REWIND SOURCE FILE
DOC0.1 READ I BEGIN READING SOURCE CODE
DOC1 READS I,DCD,NCR READ INPUT CARD
NZ X1,DOC2 IF EOR/EOF
RJ PRC PROCESS SUBPROGRAM
EQ DOC1
DOC2 NG X1,DOC3 IF EOF
SA5 S
BX6 X5
SA6 X2 RESET FILE NAME
SA1 SBF CLEAR SUB-FOOT LINE
BX6 X1
LX7 X1
SA6 A1+B1 STORE FIRST BLANK
SA7 A6+B1 STORE SECOND BLANK
SA6 A7+B1 STORE THIRD BLANK
SA7 A6+B1 STORE FOURTH BLANK
SA6 A7+B1 STORE FIFTH BLANK
READ X2 INITIATE READ
EQ DOC1 GO TILL EOF
DOC3 SA1 PCT CHECK PAGE PARITY
SX6 B1
BX6 X6*X1
ZR X6,DOC4 IF EVEN PAGE COUNT
WRITEC SCR1,(=2L1 )
DOC4 WRITER SCR1,R WRITE EOR ON SCRATCH FILE
WRITER SCR2,R
MESSAGE (=C* COPYING OUTPUT.*),1
RJ FCN FORMAT TABLE OF CONTENTS
DOC5 REWIND SCR1,R REWIND SCRATCH FILE
SA5 O CHANGE FILE NAME ON INPUT
MX7 0
SA7 I
READ I SET FIRST=IN=OUT
BX6 X5
SA6 X2 STORE NEW FILE NAME
READ SCR1
RJ CPY COPY THE FILE TO OUTPUT
SA1 N
SX6 X1-1 DECREMENT COPY COUNT
SA6 A1
NZ X6,DOC5 IF NOT FINISHED
DOC6 RETURN SCR1,R
RETURN SCR2,R
MESSAGE (=C* DOCUMENTATION COMPLETE.*)
ENDRUN
DOC7 MESSAGE (=C* ERROR IN DOCMENT ARGUMENTS.*)
ABORT
PRC TITLE SUBROUTINES.
** PRC - PROCESS SUBPROGRAM.
*
* ENTRY DCD - (DCD+NCR) = FIRST CARD FOLLOWING *END*.
*
* EXIT TO PROPER SUBPROGRAM MANAGER.
*
* USES A - 0, 2, 7.
* B - 2, 5.
* X - 0, 2, 3, 6, 7.
*
* CALLS GFW.
PRC PS 0 ENTRY/EXIT
SX7 B1 RESET FIRST CHARACTER SCAN
SA7 FCR
RJ GFW GET FIRST WORD
SB2 -B1 SET PARAMETER COUNT
SA2 TNM BASE OF MNEMONIC TABLE
PRC1 BX0 X2 SET MASK
PRC2 SA2 A2+B1 GET CHECK WORD
NG X2,PRC1 IF MASK WORD
SB2 B2+B1 BUMP PARAMETER COUNT
ZR X2,PRC IF NOT SPECIAL CARD - END OF TABLE REACHED
BX3 X0*X1
IX6 X3-X2 CHECK NAME
NZ X6,PRC2 NO MATCH - LOOP
JP B2+PRC3 EXIT TO ROUTINE
PRC3 BSS 0 START OF TABLE
LOC 0
+ EQ FTN *SUBROUTINE*
+ SB5 B5-B1 *PRECISION*
EQ SKP
+ SB5 B5-2 *FUNCTION*
EQ FTN
+ SB5 B5-3 *PROGRAM*
EQ FTN
+ SB5 B5-3 *INTEGER*
EQ SKP
+ SB5 B5-3 *FORTRAN*
EQ SKP
+ SB5 B5-3 *LOGICAL*
EQ SKP
+ SA0 PRC *OVERLAY*
EQ SPC
+ SA0 PRC *SEGMENT*
EQ SPC
+ SA0 PRC *SECTION*
EQ SPC
+ SA0 PRC *SEGZERO*
EQ SPC
+ SA0 PRC *CHNLINK*
EQ SPC
+ SB5 B5-4 *DOUBLE*
EQ SKP
+ SB5 B5-4 *SINGLE*
EQ SKP
+ SB5 B5-4 *IDENT*
EQ CMP
+ SB5 B5-5 *BLOCK*
EQ SKP
+ SB5 B5-6 *TYPE*
EQ SKP
+ SB5 B5-6 *DATA*
EQ BKD
+ SB5 B5-6 *REAL*
EQ SKP
+ SB5 B5-8 *II*
EQ SKP
+ SB5 B5-8 *IV*
EQ SKP
+ SB5 B5-8 *VI*
EQ SKP
LOC *O
GFW SPACE 4,20
** GFW - GET FIRST WORD FROM CARD.
*
* ENTRY (FCR) = FIRST CHARACTER ON CARD TO ANALYZE.
* AT *SKP* FOR SPECIAL CARDS.
*
* EXIT (B5) = LOCATION OF NEXT CHARACTER TO READ.
* (X1) = FIRST 10 CHARACTERS FOLLOWING LEADING BLANKS.
*
* USES A - 2.
* B - 5, 7.
* X - 1, 2, 3, 4, 5, 6.
GFW PS 0 ENTRY/EXIT
SA2 FCR FIRST CHARACTER
SB5 X2+DCD-1
SKP BSS 0 ENTRY FOR SKIP
GFW1 SX1 0 CLEAR FLAG WORD
SX3 1R
SX4 1R0
SB7 9
GFW2 SA2 B5 READ CHARACTER
SB5 B5+B1
ZR X2,GFW END OF CARD
IX5 X2-X3
BX6 X2-X4
ZR X5,GFW2 IF BLANK
ZR X6,GFW2 IF ZERO
GFW3 BX1 X1+X2
SA2 B5 READ NEXT CHARACTER
SB7 B7-B1 DECREMENT LOOP COUNT
LX1 6
SB5 B5+B1
NZ B7,GFW3 LOOP FOR 10 CHARS
BX1 X1+X2
EQ GFW EXIT
FTN SPACE 4,10
** FTN - PROCESS FORTRAN SUBPROGRAMS.
*
* ENTRY (B5) = ADDRESS OF NEXT CHARACTER TO READ.
*
* USES A - 0, 2, 6.
* B - 2.
* X - 0, 2, 3, 4, 6.
*
* CALLS CNT, CTA, GFW, LST, TTL.
FTN BSS 0 ENTRY
SX6 B1+ SET PROGRAM TYPE TO FORTRAN
SA6 PTYP
RJ CNT ADD TO TABLE OF CONTENTS
RJ TTL SET TITLE AND START NEW PAGE
SX6 7 SET STARTING CHAR FOR GFW
SA6 FCR
FTN1 READS I,DCD,NCR READ NEXT CARD
NZ X1,ABT IF PREMATURE EOR/EOF
RJ CTA COUNT ASTERISKS
ZR X1,FTN2 IF NOT A COMMENT
SA2 MAS MINIMUM NUMBER OF ASTERISKS TO DOCUMENT
IX4 X1-X2
NG X4,FTN1 IF NOT ENOUGH
RJ LST GO PROCESS COMMENT CARDS
FTN2 RJ GFW GET FIRST WORD
SB2 -B1 SET PARAMETER COUNT
SA2 FTNA BASE OF SPECIAL NAMES TABLE
FTN3 BX0 X2 SET MASK
FTN4 SA2 A2+B1 GET CHECK WORD
NG X2,FTN3 IF MASK WORD
SB2 B2+B1 BUMP PARAMETER COUNT
ZR X2,FTN1 IF NOT SPECIAL CARD - END OF TABLE
BX3 X0*X1
IX6 X3-X2 CHECK NAME
NZ X6,FTN4 NO MATCH - LOOP
JP B2+FTN5 EXIT TO ROUTINE
FTN5 BSS 0 JUMP TABLE
LOC 0
+ SA0 PRC *END*
EQ EDC
LOC *O
FTNA VFD 24/-0,36/ 4 CHAR MASK
DATA 4LEND
VFD 60/ END OF TABLE
CMP SPACE 4,10
** CMP - PROCESS COMPASS SUBPROGRAM.
*
* ENTRY (B5) = ADDRESS OF NEXT CHARACTER TO READ.
*
* USES A - 0, 2, 5, 6, 7.
* B - 2, 5.
* X - 0, 2, 3, 4, 5, 6, 7.
*
* CALLS CNT, CTA, GFW, LST, TTL.
CMP BSS 0 ENTRY
SX6 B0+ SET PROGRAM TYPE TO *COMPASS*
SA6 PTYP
RJ CNT ADD TO TABLE OF CONTENTS
RJ TTL SET TITLE AND START NEW PAGE
SX6 11 SET STARTING COLUMN FOR GFW
SA6 FCR
SX6 30 SET COLUMN NUMBER
SA6 CCM
SA5 CMPA RESET TITLE IN TABLE
BX7 X5
SA7 CMPC
CMP1 READS I,DCD,NCR READ NEXT CARD
NZ X1,ABT IF PREMATURE EOR/EOF
RJ CTA COUNT ASTERISKS
ZR X1,CMP2 IF NOT COMMENT CARD
SA2 MAS MINIMUM NUMBER OF ASTERISKS TO DOCUMENT
IX4 X1-X2
NG X4,CMP1 IF NOT ENOUGH
RJ LST GO PROCESS COMMENT CARDS
CMP2 RJ GFW GET FIRST WORD
SX6 B5-DCD-10 CHECK WHICH COLUMN KEYWORD STARTED
SA2 CCM
IX6 X6-X2
PL X6,CMP1 IF STARTED AFTER COMMENT COLUMN
SB2 -B1 SET PARAMETER COUNT
SA2 CMPB BASE OF SPECIAL NAMES TABLE
CMP3 BX0 X2 SET MASK
CMP4 SA2 A2+B1 READ CHECK WORD
NG X2,CMP3 IF MASK
SB2 B2+B1 BUMP PARAMETER COUNT
ZR X2,CMP1 IF NOT SPECIAL WORD - END OF TABLE
BX3 X0*X1
IX6 X3-X2 CHECK NAME
NZ X6,CMP4 NO MATCH - LOOP
JP B2+CMP5 EXIT TO ROUTINE
CMP5 BSS 0 START OF JUMP TABLE
LOC 0
+ SB5 B5-2 *SEGMENT*
EQ NDK
+ SB5 B5-4 *CTEXT*
EQ CTX
+ SB5 B5-4 *IDENT*
EQ NDK
+ SB5 B5-5 *ENDX*
EQ EDX
+ SB5 B5-4 *LIST*
EQ LSC
+ SB5 B5-6 *COL*
EQ COL PROCESS *COL* CARD
+ SA0 PRC *END*
EQ EDC
+ SA0 CMP1 *LCC*
EQ LCC
CMP6 SB5 B5-4 *TITLE*
EQ TIT
LOC *O
CMPA DATA 6LTITLE
CMPB VFD 48/-0,12/ 8 CHAR MASK
DATA 8LSEGMENT
VFD 36/-0,24/ 6 CHAR MASK
DATA 6LCTEXT
DATA 6LIDENT
VFD 30/-0,30/ 5 CHAR MASK
DATA 5LENDX
DATA 5LLIST
VFD 24/-0,36/ 4 CHAR MASK
DATA 4LCOL
DATA 4LEND
DATA 4LLCC
VFD 36/-0,24/ 6 CHAR MASK FOR *TITLE* - MUST BE LAST
CMPC DATA 6LTITLE
VFD 60/ END OF TABLE
NDK SPACE 4,10
** NDK - PROCESS NEW DECK *IDENT* OR *SEGMENT*.
*
* ENTRY (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
* (X1) = FIRST 10 CHARACTERS OF SPECIAL CARD.
* (A0) = EXIT ADDRESS.
*
* USES A - 1, 7.
* X - 0, 1, 7.
*
* CALLS LSL, STB.
NDK SA1 FLF CHECK TO SEE IF AT TOP OF PAGE
ZR X1,CMP1 IF NO OUTPUT YET
SA1 LCT
BX0 X1
RJ STB
RJ LSL
MX7 0 CLEAR FIRST LINE LISTED FLAG
SA7 FLF
EQ CMP1 RETURN
SPC SPACE 4,20
** SPC - PROCESS SPECIAL CARDS.
*
* ENTRY (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
* (X1) = FIRST 10 CHARACTERS OF SPECIAL CARD.
* (A0) = EXIT ADDRESS.
*
* EXIT IMAGE OF SPECIAL CARD IS PLACED IN SUB-FOOT LINE.
*
* USES A - 2, 7.
* B - 2, 6, 7.
* X - 2, 7.
SPC BX7 X1
SA2 B5 READ NEXT CHARACTER
SA7 SBF+1 STORE FIRST WORD
SB6 4 SET WORD COUNT
SB7 9 SET CHARACTER COUNT
BX7 X2
EQ SPC2 GO PACK WORD
SPC1 SB7 10 SET CHARACTER COUNT
SA7 A7+B1 STORE NEXT WORD
SB6 B6-B1 DECREMENT WORD COUNT
MX7 0 CLEAR ENCODE WORD
ZR B6,SPC3 IF END OF SUB-FOOT LINE
SPC2 SA2 A2+B1 READ NEXT CHARACTER
LX7 6
SB7 B7-B1 DECREMENT CHARACTER COUNT
BX7 X2+X7
NZ B7,SPC2 LOOP FOR 10 CHARACTERS
EQ SPC1 STORE WORD
SPC3 SB2 A0 SET EXIT ADDRESS
JP B2 EXIT
CNT SPACE 4,10
** CNT - SET TABLE OF CONTENTS.
*
* ENTRY (B5) = ADDRESS OF NEXT CHARACTER TO READ.
*
* EXIT SUBCHAPTER AND PAGE COUNTS UPDATED.
*
* USES A - 2, 3, 4, 6, 7.
* B - 6, 7.
* X - 0, 2, 3, 4, 5, 6, 7.
CNT5 SA2 A2 DECREMENT SUB-CHAPTER COUNT
SX6 X2-1
SA6 A2
CNT PS 0 ENTRY/EXIT
SA2 CHP CHAPTER COUNT
MX7 0
SX6 X2+B1
SA7 SPG RESET SUB-CHAPTER PAGE COUNT
SA6 A2 RESET CHAPTER COUNT
SA3 B5-B1 DUMMY READ
SX2 1R
SB7 54
SB6 -1R,
SX5 1R(
CNT1 SA3 A3+B1 READ NEXT CHARACTER
BX4 X3-X2
ZR X4,CNT1 IF BLANK
ZR X3,CNT4 IF END OF LINE
CNT2 IX6 X3-X5
SX4 X3+B6
ZR X6,CNT3 IF TERMINATOR
ZR X4,CNT3
BX7 X7+X3
SB7 B7-6
SA3 A3+B1 READ NEXT CHARACTER
LX7 6
NZ B7,CNT2 LOOP FOR 10 CHARACTERS
CNT3 LX7 X7,B7
CNT4 ZR X7,CNT5 IF NO NAME FOUND
SA7 CNTB
SA4 CHP GET SUBCHAPTER COUNT
SX6 X4
MX0 42
BX7 X0*X7
BX6 X6+X7
WRITEO SCR2
MESSAGE CNTA,1
EQ CNT EXIT
CNTA DATA 10H READING
CNTB DATA 0
DATA 0
CNTC CON 0
FCN SPACE 4,10
** FCN - FORMAT TABLE OF CONTENTS.
*
* USES A - 1, 2, 3, 4, 5, 6, 7.
* B - 3.
* X - ALL.
*
* CALLS CVT, SFN, SRT.
FCN4 WRITER SCR2,R
FCN PS 0 ENTRY/EXIT
REWIND SCR2,R
SA5 SCR2
MX7 0
SA7 I
READ I RESET FIRST=IN=OUT
BX6 X5
SA6 X2
SA1 TC CHECK FOR LIST OF TABLE OF CONTENTS
ZR X1,FCN4 EXIT
READ I,R
REWIND SCR2,R
SA1 LLM
SX1 X1-61
NG X1,FCN0 IF NOT MORE THAN 60 LINES PER PAGE
SX6 1RT
LX6 60-6
WRITEO SCR2
FCN0 WRITEW SCR2,FCNB,LFCB
SA1 PCT BUMP PAGE COUNT FOR PAGE PARITY
SX6 X1+B1
SA6 A1
SX7 4
SA7 LCT
RJ SRT SORT DECK NAME TABLE
SA5 I+2 IN
SA4 A5+B1 OUT
IX6 X5-X4 CALCULATE THE NUMBER OF ROWS TO PRINT
SX0 X4
SX6 X6+3
AX6 2 DIVIDE BY 4
SX7 -B1
SA6 FCNA+1 NUMBER OF ROWS
SA7 A6+B1 CURRENT ROW
SA6 A6-B1 INCREMENT
FCN1 SA1 FCNA+1 DECREMENT ROW COUNT
SX6 X1-1
ZR X1,FCN4 IF END OF TABLE
SA2 A1+B1 ADVANCE INCREMENT
SA6 A1
SX7 X2+B1
SA7 A2
SA1 I+3 OUT
IX0 X7+X1 SAVE ENTRY ADDRESS
SA6 DCD-1 INITIALIZE STORE ADDRESS
FCN2 SA3 X0 READ ENTRY
MX4 42
BX1 X4*X3 GET SUBPROGRAM NAME
SB3 X3
RJ SFN FILL NAME WITH SPACES
LX6 60-18 RIGHT JUSTIFY NAME
SX1 B3
SA6 A6+B1 STORE IN PRINT LINE
RJ CVT
LX6 X7,B7
LX6 6*4
SA6 A6+B1 STORE NUMBER
SA1 FCNA LENGTH OF ROW
IX0 X0+X1 BUMP TO NEXT ENTRY
IX6 X0-X5
NG X6,FCN2 LOOP TO END OF LINE
MX7 0
SA7 A6+B1
SA2 LCT
SA3 LLM
SX6 X2+B1 BUMP LINE COUNT
SA6 A2
IX7 X6-X3 CHECK FOR END OF PAGE
NG X7,FCN3
WRITEW SCR2,FCNB,LFCB
SA1 PCT BUMP PAGE COUNT
SX6 X1+B1
SA6 A1
SX7 4
SA7 LCT
FCN3 WRITEC SCR2,DCD
EQ FCN1 CONTINUE FOR ALL ROWS
FCNA BSS 3 TEMPORARY STORAGE
FCNB DATA H*1 LIST OF SUB-PROGRAMS AND CORRESPONDING CHAPTERS*
DATA C* PROCESSED BY DOCMENT.*
DATA 2L0
LFCB EQU *-FCNB
SRT SPACE 4,10
** SRT - SORT DECK NAME TABLE.
*
* USES A - 0, 1, 2, 6, 7.
* B - 2, 3, 4, 5, 6, 7.
* X - 1, 2, 4, 5, 6, 7.
SRT PS 0 ENTRY/EXIT
SA1 I+2 LWA+1 TABLE
SA2 A1+B1
IX5 X1-X2 LENGTH = (B7) = N
SA0 X2-1
SB7 X5
SB6 X5
SRT1 SX6 B6 N = N/2
AX6 1
SB6 X6
SB3 B1 J = 1
ZR B6,SRT RETURN IF M = 0
SB4 B7-B6 N = N-M
SB2 B3 I = J
SRT2 SB5 B2+B6 L = I+M
SA1 A0+B2 A(I)
SA2 A0+B5 A(L)
IX4 X2-X1
PL X4,SRT3 IF A(L) > A(I)
BX6 X1 INTERCHANGE A(L) AND A(I)
LX7 X2
SA6 A2
SA7 A1
SB2 B2-B6 I = I-M
GT B2,SRT2 IF I > 0
SRT3 SB3 B3+B1 J = J+1
SB2 B3 I = J
LE B3,B4,SRT2 IF J @ K
EQ SRT1
LCC SPACE 4,10
** LCC - PROCESS *LCC* CARDS.
*
* ENTRY (A0) = EXIT ADDRESS.
* (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
* USES A - 2, 6.
* B - 2.
* X - 2, 6.
*
* CALLS GFW.
LCC SA2 FCR GET FIRST CHARACTER ADDRESS
SX6 B5-DCD
SX6 X6-6 SET FIRST CHARACTER FOR GFW
SB2 X2 SAVE ADDRESS OF OLD FIRST CHARACTER
SA6 A2
RJ GFW GET FIRST WORD SET UP FOR SPC
SX6 B2 RESTORE FCR
SA6 FCR
EQ SPC PROCESS AS SPECIAL CARD
TTL SPACE 4,10
** TTL - SET TITLE OF NEW SUBPROGRAM.
*
* USES A - 2, 3, 7.
* B - 6, 7.
* X - 0, 1, 2, 3, 6, 7.
*
* CALLS GFW.
TTL PS 0 ENTRY/EXIT
RJ GFW GET FIRST WORD
SA3 TTLA
MX0 12
LX1 48
BX6 -X0*X1 GET FIRST 8 CHARACTERS
BX7 X6+X3
SA7 HDG SET FIRST WORD OF HEADING
SB7 8 SET CHARACTER COUNT
BX7 X0*X1 GET LAST 2 CHARACTERS
SB6 4 SET WORD COUNT
LX7 12
EQ TTL2
TTL1 SB7 10
SA7 A7+B1 STORE NEXT WORD
SB6 B6-B1
MX7 0
ZR B6,TTL IF END OF TITLE LINE
TTL2 SA2 A2+B1 READ NEXT CHARACTER
LX7 6
SB7 B7-B1
BX7 X7+X2
NZ B7,TTL2 LOOP FOR 10 CHARACTERS
EQ TTL1
TTLA VFD 12/1H1,48/
LFL SPACE 4,10
** LFL - LIST FIRST LINE.
*
* USES A - 1, 6, 7.
* X - 1, 6, 7.
LFL PS 0 ENTRY/EXIT
SA1 SPG SUB-CHAPTER PAGE COUNT
SX6 X1+B1
SA6 A1 BUMP PAGE COUNT
SX7 FLP
SA7 LCT RESET LINE COUNT
WRITEC SCR1,HDG WRITE HEADING LINE
WRITEC X2,(=2L0 ) 2 BLANK LINES
SX7 X2 SET FIRST LINE LISTED FLAG
SA7 FLF
EQ LFL EXIT
CTA SPACE 4,10
** CTA - COUNT ASTERISKS.
*
* USES A - 2, 3, 6.
* B - 7.
* X - 1, 2, 3, 6, 7.
CTA PS 0 ENTRY/EXIT
MX1 0 SET INITIAL COUNT
SX6 1R
SA2 C READ CHECK CHARACTER
SA3 DCD
SB7 5
CTA1 BX7 X3-X2 CHECK FOR ASTERISK
SB7 B7-B1 DECREMENT LOOP COUNT
NZ X7,CTA IF NOT * EXIT
SA6 A3 REPLACE IT WITH A BLANK
SX1 X1+B1
SA3 A3+B1
NZ B7,CTA1 IF MORE CHARACTERS TO PROCESS
SX1 3 TREAT ***** LIKE *** STATEMENTS
EQ CTA EXIT
LST SPACE 4,10
** LST - LIST DOCUMENTATION.
*
* ENTRY (X1) - NUMBER OF ASTERISKS FOUND.
*
* EXIT TO *EDC* IF END CARD ENCOUNTERED.
*
* USES A - 0, 1, 2, 4, 5, 6, 7.
* X - ALL.
*
* CALLS CTA, GFW, LFL, LSL, STB, TAB.
LST PS 0 ENTRY/EXIT
SA2 NAS MINIMUM NUMBER OF ASTERISKS FOR INT DOC
IX3 X1-X2
PL X3,LST5 DO INTERNAL DOCUMENTATION
SX2 4 CHECK FOR EXTERNAL DOCUMENTATION
IX3 X1-X2
PL X3,LST IF NOT EXTERNAL
LST1 SA2 FLF CHECK FIRST LINE FLAG
NZ X2,*+2 IF FIRST LINE HAS BEEN LISTED
+ RJ LFL LIST FIRST LINE
SA1 LCT CHECK PAGE POSITION
SX5 X1-FLP CHECK FOR TOP OF PAGE
ZR X5,LST4 IF AT TOP
SX6 X1+4
SA6 A1 RESET LINE COUNT
SA4 LLM MAXIMUM NUMBER OF LINES ON PAGE
IX5 X6-X4
NG X5,LST3 IF NOT AT BOTTOM OF PAGE
BX6 X1 RESTORE LINE COUNT
SA6 A1
LST1A SA1 LCT
BX0 X1
RJ STB SKIP TO BOTTOM OF PAGE
LST2 RJ LSL LIST LAST LINE ON PAGE
RJ LFL LIST FIRST LINE
EQ LST4
LST3 WRITEC SCR1,(=2L0 )
WRITEC SCR1,(=2L0 )
LST4 SA1 DCD+1 CHECK COLUMN 2 FOR TABLE FLAG
SX2 X1-1RE CHECK FOR EJECT
SX1 X1-1RT
NZ X2,LST4A IF NOT EJECT CARD
SA2 TOG
NZ X2,LST4B IF INTERNAL TOGGLE IS ON - LIST THE CARD
SX7 1R CLEAR *E*
SA7 DCD+1
WRITES SCR1,LNE,NCR+2
SA1 LCT
SX0 X1+1 SET SPACE COUNT
RJ STB
SA2 LLM
SX6 X2-1
SA6 LCT RESET LINE COUNT
EQ LST4D CONTINUE
LST4A NZ X1,LST4B IF NOT TABLE CARD
SA2 TOG CHECK FOR INTERNAL NO ASTERISK
NZ X2,LST4B IF SO
SA2 NT CHECK STATUS OF TABLE GENERATOR
NZ X2,LST4B IF OFF
RJ TAB PROCESS TABLE
EQ LST4C PROCESS THE NEXT CARD
LST4B WRITES SCR1,LNE,NCR+2 WRITE CARD TO DOC FILE
LST4D SA1 LCT BUMP LINE COUNT
SX6 X1+B1
SA6 A1
READS I,DCD,NCR READ NEXT CARD
NZ X1,ABT IF PREMATURE EOR/EOF
RJ CTA COUNT ASTERISKS
LST4C SA2 NAS CHECK FOR END OF INTERNAL DOCUMENTATION
IX4 X1-X2
PL X4,LST5 IF END
ZR X1,LST7 CHECK FOR END OF DOCUMENTATION
SA5 LCT CHECK FOR END OF PAGE
SA4 LLM LINE LIMIT
IX5 X5-X4
NG X5,LST4 IF NOT AT BOTTOM OF PAGE
EQ LST2
LST5 SA1 TOG CHECK TOGGLE
NZ X1,LST6 IF ON
SA2 MAS SAVE MINIMUM EXT * COUNT
MX7 0
BX6 X2
SA7 A2 SET MINIMUM AST TO 0
SA6 A1 SET TOGGLE
EQ LST1 GO LIST CARD
LST6 MX7 0 RESET TOGGLE
BX6 X1
SA7 A1
SA6 MAS RESET MINIMUM FOR EXT DOC
EQ LST1 GO LIST CARD
LST7 SA1 TOG CHECK MODE
ZR X1,LST IF EXTERNAL
RJ GFW
MX0 24 CHECK FOR END CARD
SA2 =4LEND
BX6 X0*X1
BX6 X6-X2
SA0 PRC SET EXIT FOR END
ZR X6,EDC IF *END* CARD
SA5 LCT
SA4 LLM CHECK FOR END OF PAGE
IX5 X5-X4
NG X5,LST4 IF NOT AT BOTTOM OF PAGE
EQ LST2
LSL SPACE 4,10
** LSL - LIST LAST LINE.
*
* USES A - 1, 6, 7.
* X - 0, 1, 5, 6, 7.
*
* CALLS CVT.
LSL PS 0 ENTRY/EXIT
WRITEC SCR1,(=2L )
SA1 CHP CHAPTER COUNT
RJ CVT CONVERT THE CHAPTER COUNT TO DECIMAL DISP
LX7 X7,B7
MX0 60-18
SA1 PGE
BX7 -X0*X7
BX6 X0*X1
BX7 X6+X7
SA7 A1
SA1 SPG
RJ CVT
MX0 42
BX7 X0*X7 CLEAR LOW 18 BITS
SX5 1R/
BX7 X5+X7
LX7 54
SA7 A7+B1 SET SUBCHAPTER PAGE COUNT
WRITEC SCR1,FOT WRITE PAGE FOOTING
WRITEC SCR1,(=2L )
WRITEC SCR1,SBF WRITE PAGE SUB-FOOT
SA1 PCT BUMP PAGE COUNT
SX6 X1+B1
SA6 A1
EQ LSL EXIT
TAB SPACE 4,20
** TAB - PROCESS TABLE GENERATION.
* J.C. BOHNHOFF - 70/7/4.
*
* ENTRY (A1) = ADDRESS OF *T* CHARACTER IN CARD.
*
* EXIT TABLES GENERATED AND LISTED.
* GENERATION TERMINATED AT END OF *T* BLOCK.
*
* USES A - 1, 2, 6, 7.
* B - 7.
* X - 1, 2, 4, 6, 7.
*
* CALLS ASD, ASF, CTA, DXB, LFL, LSL, LTB, STL.
TAB PS 0 ENTRY/EXIT
SA1 A1+B1 READ SECOND CHARACTER TO CHECK FOR HEADER
*OFF*
SX6 1R,
MX7 0
SA6 DCD+NCR TERMINATE CARD STRING BUFFER
SA7 A6+1
SX6 X1-1R
SA6 PBP SET *PRINT BIT POSITIONS* FLAG
TAB0 SX6 1R-
SB7 71
TAB0A SA6 AST+B7
SB7 B7-1
NZ B7,TAB0A
RJ STL SET TABLE LABEL
SX7 0 CLEAR TOTAL BIT COUNT
SX6 TCL AND SET POINTER TO BEGINNING OF CONTENT
LINE BUFFER
SA7 TBC
SA6 TCLP
TAB1 RJ ASD ASSEMBLE DIGIT FIELD
ZR X1,TAB3 IF END OF CARD
RJ DXB CONVERT DIGIT FIELD TO BINARY
NZ X4,TAB2 IF DIGIT FIELD ERROR
SX7 X6-61 CHECK LEGALITY OF FIELD
PL X7,TAB2
RJ ASF ASSEMBLE TABLE FIELD
EQ TAB1 CONTINUE FORMING TABLE
TAB2 WRITES SCR1,LNE,NCR+2 LIST THE BAD CARD NORMALLY
SA1 LCT ADVANCE LINE COUNT
SX7 X1+B1
SA7 A1
SA2 LLM CHECK FOR END OF PAGE
IX6 X7-X2
NG X6,TAB4 IF NOT AT BOTTOM OF PAGE
RJ LSL LIST LAST LINE ON PAGE
RJ LFL LIST FIRST LINE
EQ TAB4
TAB3 RJ LTB LIST TABLE ENTRY
TAB4 READS I,DCD,NCR READ NEXT CARD
NZ X1,ABT IF PREMATURE EOR/EOF
RJ CTA COUNT ASTERISKS
ZR X1,TAB **RETURN - IF NOT COMMENT CARD
SA2 DCD+1 CHECK FOR CONTINUATION OF TABLE BLOCK
SX4 X2-1RT
NZ X4,TAB **RETURN IF NOT *T CARD
SA1 A2+B1 READ NEXT CHARACTER FOR *STL*
EQ TAB0 GO PROCESS THE CARD
STL SPACE 4,20
** STL - SET TABLE LABEL IF ANY.
* J.C. BOHNHOFF - 70/07/11.
*
* ENTRY (A1) = ADDRESS+1 OF *T* CHARACTER.
*
* EXIT (A1) = ADDRESS OF LAST CHARACTER OF LABEL OR ADDRESS
* OF FIRST CHARACTER BEFORE DIGIT FIELD IF NO LABEL.
*
* USES A - 1, 2, 6, 7.
* X - 1, 2, 3, 4, 5, 6, 7.
*
* CALLS ASF, MVE.
STL1 SX4 1R SPACE
SA2 A1 PRESET (A2)
SX5 X4+B1 COMMA
STL1A SA2 A2+1 SEARCH FOR END OF TAG
ZR X2,STL IF END OF CARD
IX3 X4-X2 COMPARE SPACE
BX7 X5-X2 COMPARE COMMA
ZR X7,STL1B IF COMMA
NZ X3,STL1A IF NOT SPACE
BX7 X5
SA7 A2 REPLACE SPACE WITH COMMA
STL1B SX7 TCF+1 SET PARAMS FOR ASF
MX6 0 CLEAR RESIDUE FROM TOTAL BIT COUNT
SA6 TBC
SX6 9
SA7 TCLP
RJ ASF ASSEMBLE LABEL INTO LIST LINE
STL PS
SX1 9 CLEAR BEGINNING OF CONTENT LINE
SX2 BLN
SX3 TCF
RJ =XMVE=
STL2 SA1 A1+1 CHECK NEXT CHARACTER
SX3 X1-1R
ZR X1,STL IF END OF CARD
ZR X3,STL2 IF ANOTHER BLANK
SX3 X1-1RZ-1
SA1 A1-1 BACKSPACE
NG X3,STL1 IF ALPHA
EQ STL **RETURN - NO LABEL
ASD SPACE 4,20
** ASD - ASSEMBLE DIGIT FIELD.
* J.C. BOHNHOFF - 70/7/4.
*
* ENTRY (A1)= ADDRESS OF CHARACTER PRECEDING A SUPPOSED
* DIGIT FIELD.
* DCD MUST BE ZERO TERMINATED.
*
* EXIT (X5) = LEFT JUSTIFIED DISPLAY CODED DIGIT FIELD.
* (B7) = NONZERO.
* (X1) = 0 IF END OF CARD ENCOUNTERED BEFORE DIGIT FIELD.
* LEADING SPACES ARE IGNORED AND ASSEMBLY TERMINATES
* WHEN A */* IS ENCOUNTERED.
*
* USES A - 1.
* B - 2, 3, 7.
* X - 1, 3, 4, 5.
ASD1 ZR X1,ASD IF END OF CARD ENCOUNTERED
SX3 X1-1R CHECK FOR LEADING SPACE
NZ X3,ASD1A IF FIRST NON-BLANK CHARACTER
SA1 A1+1 READ NEXT CHARACTER
EQ ASD1 LOOP TILL END OF CARD OR FIRST NON-BLANK
ASD1A SX3 X1-1R0 CHECK FOR LEADING NUMERIC
SX5 -1 FORCE DXB ERROR IF NOT NUMERIC
NG X3,ASD IF ALPHA
SX3 X3-10
NG X3,ASD2 IF NOT SPECIAL CHARACTER
SX3 X1-1R, CHECK FOR COMMA AS FIRST CHARACTER
NZ X3,ASD IF NOT COMMA
SX1 0 FLAG END-OF-CARD
EQ ASD **RETURN
ASD2 SX3 X1-1R/ CHECK FOR FIELD SEPERATOR
ZR X1,ASD **RETURN - IF EOC
ZR X3,ASD3 IF SEPERATOR
LX4 6 SHIFT ASSEMBLY
BX4 X4+X1 INSERT NEXT CHARACTER
SB3 B3-B2 ADVANCE BIT COUNT
SA1 A1+B1 READ NEXT CHARACTER
EQ ASD2
ASD3 LX5 X4,B3 LEFT JUSTIFY THE DIGITS
SB7 1
ASD PS ENTRY/EXIT
SB2 6
SB3 60 INITIALIZE ASSEMBLY BIT COUNT
MX4 0 CLEAR ASSEMBLY REGISTER
SA1 A1+B1 READ FIRST CHARACTER TO BE CONSIDERED
EQ ASD1 GO ASSEMBLE
ASF SPACE 4,20
** ASF - ASSEMBLE TABLE FIELD INTO LINE.
* J.C. BOHNHOFF - 70/7/4.
*
* ENTRY (A1)= ADDRESS OF CHARACTER PRECEDING A SUPPOSED
* NAME FIELD.
* (X6) = NUMBER OF BITS IN FIELD.
*
* EXIT FIELD ASSEMBLED INTO TABLE LINE BUFFER.
*
* USES A - 1, 3, 4, 7.
* X - 1, 3, 4, 5, 6, 7.
ASF PS ENTRY/EXIT
SA3 TBC TOTAL BIT COUNT
SA4 TCLP TABLE CONTENT LINE POINTER
IX7 X3+X6 ADVANCE TOTAL BIT COUNT
SA7 A3
SX5 X6-1 DECREMENT NUMBER OF BITS IN FIELD
NG X5,ASF6 IF NEGATIVE BIT COUNT
NZ X5,ASF1 IF NOT SINGLE BIT FIELD
SX5 X4-TCL+AST+1
SX7 1R+
SA7 X5
SA1 A1+B1
BX7 X1
EQ ASF5
ASF1 SA1 A1+B1 READ NAME CHARACTER
SX6 X6-1 DECREMENT BIT COUNT
BX7 X1
ZR X1,ASF4 IF END OF CARD
SX3 X1-1R, CHECK FOR COMMA SEPERATOR
ZR X3,ASF4 IF COMMA
ZR X6,ASF1A IF TIME TO INSERT FIELD SEPERATOR
SA7 X4 STORE CHARACTER IN FIELD
SX4 X4+B1 ADVANCE CHARACTER POINTER
EQ ASF1 CONTINUE
ASF1A SA1 A1+1 SEARCH FOR END OF NAME FIELD
SX3 X1-1R,
ZR X1,ASF2 IF END OF STATEMENT
NZ X3,ASF1A CONTINUE IF NOT END
ASF2 SX7 1R/ STORE FIELD SEPERATOR
SA7 X4
SX4 X4+B1 ADVANCE CHARACTER POINTER
ASF3 BX7 X4 RESTORE CHARACTER POINTER
SA7 A4
EQ ASF **RETURN
ASF4 SX7 1R PROPAGATE SPACES UNTIL FIELD EXHAUSTED
ZR X6,ASF2 IF TIME TO INSERT FIELD SEPERATOR
SA7 X4 STORE CHARACTER IN FIELD
SX6 X6-1 DECREMENT BIT COUNT
SX4 X4+B1 ADVANCE CHARACTER POINTER
EQ ASF4 CONTINUE
ASF5 SA7 X4 STORE SINGLE CHARACTER
SX4 X4+1 ADVANCE CHARACTER POINTER
ASF6 SA1 A1+1 SCAN TILL END OF FIELD
SX3 X1-1R,
ZR X1,ASF3 IF END OF STATEMENT
ZR X3,ASF3 IF TERMINATOR
EQ ASF6 LOOP TILL TERMINATOR
TBC BSSZ 1 HOLDS TOTAL BIT COUNT FOR ONE TABLE CARD
TCLP VFD 60/TCL TABLE CONTENT LINE POINTER
LTB SPACE 4,20
** LTB - LIST A TABLE ENTRY.
* J.C. BOHNHOFF - 70/7/4.
*
* ENTRY (TCL) = CONTENT LINE TO BE LISTED.
* (TCLP) = ADDRESS OF LIMIT OF *TCL*.
* (TBC) = TOTAL BIT COUNT FOR THIS TABLE ENTRY.
* (PBP) = 0 IF BIT POSITION HEADER LINES TO BE LISTED.
*
* EXIT TABLE ENTRY LISTED.
* (PBP) .NE. 0 IF ZERO ON ENTRY.
*
* USES A - 1, 3, 4, 5, 7.
* B - 6, 7.
* X - 0, 1, 2, 3, 4, 5, 7.
*
* CALLS LFL, LSL, MVE, STB, WTS.
LTB PS ENTRY/EXIT
SA4 LCT LINE COUNT
SX1 10 SET BLANKS AT BEGINNING OF LINE
MX7 0
SX2 BLN
BX0 X4 SAVE LINE COUNT
SX3 TPF
SA7 ATF CLEAR *ASTERS ONLY* FLAG
RJ =XMVE=
SA1 PBP *PRINT BIT POSITIONS* FLAG
SA5 TBC TOTAL BIT COUNT FOR THIS TABLE ENTRY
NG X1,LTBA IF SOME PART OF THE HEADER IS NOT TO BE
LISTED THIS TIME
ZR X1,LTBB IF FULL BIT POSITION HEADER TO BE LISTED
THIS BLOCK
LTBA MX7 60
BX7 X1-X7
ZR X7,LTB1 IF ALL HEADER IS OFF
SA7 ATF
LTBB MX7 60 TOGGLE THE FLAG
SA7 A1
SA3 LLM LINE LIMIT
NO
SX7 X0+5
IX3 X7-X3
NG X3,LTB0 IF IT WILL FIT
RJ STB SKIP TO BOTTOM OF PAGE
RJ LSL LIST LAST LINE ON PAGE
RJ LFL LIST FIRST LINE ON PAGE
SA1 LCT RESTORE REGISTERS
SA5 TBC
BX0 X1
LTB0 SA1 ATF
NZ X1,LTB0A IF ASTER LINE ONLY TO BE LISTED
LTBC SX2 BP1L
BX1 X5 SET WORD COUNT FOR MVE
IX2 X2-X5
SX3 TPL SET DESTINATION FOR MVE - (TABLE PRNT LINE)
RJ =XMVE= MOVE LINE INTO LIST BUFFER
SB7 X5+10 SET WORD COUNT FOR WRITE
SX2 SCR1 SET ADDRESS OF FET
SB6 TPF
RJ =XWTS= WRITE THE FIRST BIT POSITION HEADER LINE
SX0 X0+B1 BUMP LINE COUNT
SX2 BP2L SET UP FOR WRITE OF 2ND HEADER LINE
BX1 X5
SX3 TPL
IX2 X2-X5
RJ =XMVE= MOVE SECOND LINE INTO BUFFER
SX2 SCR1
SB6 TPF
SB7 X5+10
RJ =XWTS= WRITE SECOND BIT POSITION HEADER LINE
SX0 X0+1 BUMP LINE COUNT
LTB0A SX2 AST MOVE ASTERISK LINE
SX3 TPL-1
SX1 X5+1
RJ =XMVE=
WRITES SCR1,TPF,X5+10 WRITE ASTERISK LINE TO DEFINE TOP OF ENT
SX0 X0+B1 BUMP LINE COUNT
EQ LTB2
LTB1 SA3 LLM LINE LIMIT
SX7 X0+2 SEE IF ENTRY WILL FIT ON PAGE
NO
IX3 X7-X3
NG X3,LTB2 IF IT WILL FIT
RJ STB SKIP TO BOTTOM OF PAGE
RJ LSL LIST LAST LINE
RJ LFL LIST FIRST LINE
SA1 LCT RESTORE REGISTERS
SA5 TBC
BX0 X1
EQ LTBC WRITE NEW HEADER
LTB2 WRITES SCR1,TCF,X5+10 WRITE TABLE CONTENT LINE
SX0 X0+B1 BUMP LINE COUNT
SX1 X5+B1
SX2 AST MOVE ASTERISKS
SX3 TPL-1
RJ =XMVE=
WRITES SCR1,TPF,X5+10 WRITE ASTERISK LINE TO DEFINE BTTM OF EN
SX7 X0+1
SA7 LCT RESTORE BUMPED LINE COUNT
EQ LTB **RETURN
PBP BSSZ 1 PRINT BIT POSITIONS FLAG
ATF BSSZ 1 ASTERISK ONLY FLAG
STB SPACE 4,10
** STB - SKIP TO BOTTOM OF PAGE.
* J.C. BOHNHOFF - 70/07/11.
*
* ENTRY (X0) = CURRENT LINE COUNT.
*
* EXIT FORM POSITIONED AT *LINP*.
*
* USES A - 2.
* X - 0, 2, 5, 6.
STB PS
BX0 -X0
SA2 LLM
NO
IX0 X0+X2
AX5 X0,B1 /2= NUMBER OF DOUBLE SPACES NEEDED
LX6 X5,B1
IX0 X0-X6 NUMBER OF SINGLE SPACES NEEDEAFTER DOUBLES
STB1 ZR X5,STB2 IF DONE DOUBLE SPACEING
WRITEC SCR1,(=2L0 )
SX5 X5-1
EQ STB1
STB2 ZR X0,STB **RETURN - IF AT BOTTOM
WRITEC SCR1,(=2L )
EQ STB
CVT SPACE 4,10
** CVT - CONVERT NUMBER FROM OCTAL TO DECIMAL DISPLAY CODE.
*
* ENTRY (X1) = LOW 18 BITS OF NUMBER TO BE CONVERTED.
*
* EXIT (X7) = LEFT JUSTIFIED DISPLAY CODED NUMBER.
* (B7) = 6*NUMBER OF DIGITS IN CONVERTED NUMBER.
*
* USES A - 2, 3, 4.
* B - 0, 4, 5, 6, 7.
* X - 1, 2, 3, 4, 6, 7.
CVT1 DX7 X1*X2
FX1 X1*X2
LX4 54
SB4 X1
FX6 X3*X7 CALCULATE REMAINDER DIGIT
SB7 B7+B5
SX6 X6+B6
IX4 X6+X4
NZ B4,CVT1
BX7 X4 LEFT JUSTIFY NUMBER
LX7 54
CVT PS 0 ENTRY/EXIT
SA2 CVTA
SA3 A2+B1
SA4 A3+B1
PX1 X1
SB7 B0 SET DIGIT COUNT
SB5 6
SB6 -22B
EQ CVT1
CVTA DATA 0.1000000001P48
DATA 10.0P0
DATA 1H
ABT SPACE 4,10
** ABT - TERMINATE ON PREMATURE EOR/EOF.
*
* USES A - 7.
* X - 7.
ABT SX7 B1 SET NUMBER OF COPIES TO 1
SA7 N
WRITEC SCR1,(=2L )
WRITEC SCR1,(=2L )
WRITEC SCR1,(=C* PREMATURE EOR/EOF ON SOURCE FILE.*)
EQ DOC3 EXIT
CPY SPACE 4,10
** CPY - COPY SCRATCH FILE TO OUTPUT FILE.
*
* USES X - 1, 6.
* A - 1, 6.
* B - 7.
*
* MACROS READ, READW, RECALL, REWIND, WRITER, WRITEW.
CPY PS 0 ENTRY/EXIT
SA1 PD
ZR X1,CPY0 IF FORMAT EFFECTOR NOT TO BE WRITTEN
WRITEW I,PD,1 WRITE FORMAT EFFECTOR
BX6 X6-X6
SA6 PD
CPY0 SA1 NI CHECK FOR NO INPUT FILE
ZR X1,CPY3 IF NONE
CPY1 READW SCR1,DCD,100B
NZ X1,CPY2 IF EOR/EOF
WRITEW I,DCD,100B WRITE FROM WORKING BUFFER
EQ CPY1 COPY SOME MORE
CPY2 SB7 X1-DCD GET WORD COUNT OF LAST TRANSFER
WRITEW I,DCD,B7 TRANSFER LAST FEW WORDS
READ SCR1
CPY3 SA1 TC CHECK FOR TABLE OF CONTENTS
ZR X1,CPY6 IF NO TABLE OF CONTENTS
REWIND SCR2,R
READ SCR2
CPY4 READW SCR2,DCD,100B
NZ X1,CPY5 IF EOR/EOF
WRITEW I,DCD,100B WRITE FROM WORKING BUFFER
EQ CPY4 COPY SOME MORE
CPY5 SB7 X1-DCD GET WORD COUNT OF LAST TRANSFER
WRITEW I,DCD,B7 TRANSFER LAST FEW WORDS
RECALL SCR2
CPY6 READW SCR1,DCD,100B
NZ X1,CPY7 IF EOR/EOF
WRITEW I,DCD,100B WRITE FROM WORKING BUFFER
EQ CPY6 COPY SOME MORE
CPY7 SB7 X1-DCD GET WORD COUNT OF LAST TRANSFER
WRITEW I,DCD,B7 TRANSFER LAST FEW WORDS
WRITER I,R
RECALL SCR1
EQ CPY EXIT
EDC SPACE 4,10
** EDC - *END* CARD PROCESSOR.
*
* ENTRY (A0) - EXIT ADDRESS.
*
* USES A - 2, 4, 5, 6, 7.
* B - 2.
* X - 2, 4, 5, 6, 7.
*
* CALLS LSL.
EDC SA2 FLF CHECK TO SEE IF ANYTHING HAS BEEN LISTED
ZR X2,EDC3 IF NOT
SA5 LCT
SA4 LLM LINE LIMIT
IX5 X5-X4
BX6 X5
LX6 59-0 CHECK EVEN OR ODD
ZR X5,EDC2 IF AT BOTTOM OF PAGE
NG X6,EDC1 IF EVEN
WRITEC SCR1,(=2L )
SX5 X5+B1
EDC1 ZR X5,EDC2 IF AT BOTTOM OF PAGE
WRITEC SCR1,(=2L0 )
SX5 X5+2
EQ EDC1 LOOP TO BOTTOM OF PAGE
EDC2 RJ LSL LIST LAST LINE
EDC3 MX7 0
SA7 FLF CLEAR FIRST LINE FLAG
SA7 LSCA CLEAR LIST CARD STACK
SA7 FCR RESET FIRST CHARACTER TO SCAN FROM
SA7 XFL CLEAR LIST *X* FLAG
SA7 TOG CLEAR TOGGLE
SA5 EDAS RESET ASTERISK COUNT FOR DOC TYPE
SA4 IDAS
BX6 X5
LX7 X4
SA6 MAS
SA7 NAS
SB2 A0
JP B2 EXIT
COL SPACE 4,10
** COL - PROCESS *COL* CARDS.
*
* USES X - 2, 3, 4, 5, 6.
* A - 2, 6.
* B - 5, 7.
*
* CALLS DXB.
COL BSS 0 ENTRY
COL1 SA2 B5 FIND COLUMN NUMBER
SX3 X2-1R CHECK FOR SPACE
SB5 B5+B1
ZR X2,CMP1 IF END OF LINE
ZR X3,COL1 IF A SPACE
SB7 54 SET SHIFT COUNT
SX5 B0+ INITIALIZE ASSEMBLY AREA
COL2 LX2 B7 SHIFT CHARACTER
SB7 B7-6 ADJUST SHIFT COUNT
BX5 X5+X2 ADD TO ASSEMBLED DATA
SA2 B5 NEXT CHARACTER
SB5 B5+B1
ZR X2,COL3 IF END OF CARD
SX3 X2-1R
NZ X3,COL2 IF NOT SPACE
COL3 RJ DXB CONVERT COLUMN NUMBER
NZ X4,CMP1 IF NOT NUMERIC
SA6 CCM RESET COMMENT COLUMN
EQ CMP1 EXIT
CTX SPACE 4,10
** CTX - PROCESS *CTEXT* CARDS.
*
* USES A - 1, 7.
* X - 1, 7.
CTX SA1 XFL CHECK LIST *X* FLAG
NZ X1,CMP1 EXIT IF ON
SX7 20 RESET LIST LIMITS
SA7 MAS
SA7 NAS
EQ CMP1 EXIT
EDX SPACE 4,10
** EDX - PROCESS *ENDX* CARDS.
*
* USES A - 1, 4, 5, 6, 7.
* X - 1, 4, 5, 6, 7.
EDX SA1 XFL CHECK LIST *X* FLAG
NZ X1,CMP1 EXIT IF ON
SA4 EDAS RESTORE LIMITS ON ASTERISK COUNTS
SA5 IDAS
BX6 X4
LX7 X5
SA6 MAS
SA7 NAS
EQ CMP1 EXIT
BKD SPACE 4,10
** BKD - PROCESS BLOCK DATA SUBPROGRAMS.
*
* ENTRY (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
* EXIT TO *CMP1* IF *COMPASS* PROGRAM.
*
* A - 1, 2, 3, 4, 6.
* B - 6, 7.
* X - 0, 1, 2, 3, 4, 6, 7.
*
* CALLS CVT.
BKD BSS 0 ENTRY
SA4 PTYP
ZR X4,CMP1 IF *COMPASS* PROGRAM
SB6 B5 SAVE ADDRESS OF NEXT CHARACTER
SX2 1R
BKD1 SA3 B6 CHECK FOR PRESENCE OF NAME
SB6 B6+B1
IX6 X3-X2
ZR X3,BKD2 IF NO NAME FOUND
ZR X6,BKD1 SKIP BLANKS
EQ FTN GO PROCESS AS FORTRAN
BKD2 SA1 BKDA BLOCK COUNT
SX6 X1+B1
SA6 A1
RJ CVT CONVERT BLOCK COUNT
MX0 42
SA2 BKDB
LX7 X7,B7
BX6 X0*X2
BX7 -X0*X7 GET NUMBER
BX7 X6+X7
MX0 60-6
SB7 10
SB6 B5
BKD3 LX7 6 DECODE NAME
SB7 B7-B1
BX6 -X0*X7 GET CHARACTER
SA6 B6
SB6 B6+B1
NZ B7,BKD3 LOOP FOR 10 CHARACTERS
EQ FTN GO PROCESS AS FORTRAN
BKDA DATA 1 BLOCK DATA SUBROUTINE COUNT
BKDB VFD 42/0HNUMBER-,18/
LSC SPACE 4,10
** LSC - PROCESS *LIST* CARD.
*
* ENTRY (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
* USES A - 2, 4, 5, 6, 7.
* B - 7.
* X - 2, 3, 4, 5, 6, 7.
LSC SB7 B1 SET .NOT. *-* FLAG
SA2 B5 READ NEXT CHARACTER
SX3 1R
LSC1 ZR X2,CMP1 EXIT IF NO LIST PARAMETERS LEFT
IX6 X2-X3
BX4 X2
SA2 A2+B1 READ NEXT CHARACTER
ZR X6,LSC1 SKIP BLANKS
SA5 A2+B1 READ FOLLOWING CHARACTER
SB7 X4-1R- CHECK FOR *-*
ZR B7,LSC2 IF PRESENT
SA5 A2
SX2 X4
LSC2 SX6 X2-1RL *L*
SX7 X2-1RX *X*
SX2 X2-1R* ***
ZR X6,LSC4
ZR X7,LSC6
ZR X2,LSC9
EQ LSC8 PUSH LIST OPTION ONTO STACK
LSC3 IX2 X5-X3 CHECK FOR END
ZR X2,CMP1 IF END OF CARD
SA2 A5+B1
EQ LSC1 CONTINUE SEARCH
LSC4 NZ B7,LSC5 PROCESS *L*
SX7 20 PROCESS *-L*
SA7 MAS RESET LIST LIMITS
SA7 NAS
EQ LSC8 TRY AGAIN
LSC5 SA4 EDAS RESET LIST LIMITS FOR *L* CARD
SA2 IDAS
BX6 X4
LX7 X2
SA6 MAS
SA7 NAS
EQ LSC8 TRY AGAIN
LSC6 NZ B7,LSC7 PROCESS *X*
SA7 XFL CLEAR LIST X FLAG
EQ LSC8 TRY AGAIN
LSC7 SX6 1RX
SA6 XFL SET LIST X FLAG
LSC8 SA2 MAS
SA4 NAS
LX2 40
LX4 20
BX7 X2+X4
SA4 XFL
BX7 X7+X4
SA2 LSCA LIST OPTIONS TABLE
SX6 X2+B1
SA6 A2
SX4 X6-LSCBL
PL X4,LSC10 IF LIST CARD LIMIT REACHED
SA7 LSCB+X6
EQ LSC3 TRY AGAIN
LSC9 SA2 LSCA
SX6 X2-1
NG X6,LSC3 IF NO STACK
SA6 A2+
SX4 X6-LSCBL
PL X4,LSC3 IF STILL ABOVE LIMIT
SA4 LSCB+X6
MX2 20
BX6 X2*X4 GET MAS
BX7 -X2*X4 GET NAS
LX6 20
LX7 40
SX7 X7
SA7 NAS
SA6 MAS
SX7 X4
SA7 XFL
EQ LSC3
LSC10 MESSAGE (=C* LIST CARD LIMIT - CARD IGNORED.*)
EQ LSC3
LSCA CON 0
LSCB CON 0
BSSZ NLCA
LSCBL EQU *-LSCB
TIT SPACE 4,10
** TIT - PROCESS TITLE CARD.
*
* ENTRY (B5) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
* USES A - 1, 2, 7.
* B - 5, 6, 7.
* X - 1, 2, 3, 6, 7.
TIT MX7 0 CLEAR TITLE FROM SPECIAL CARD LIST
SA7 CMPC
SA2 B5 READ NEXT CHARACTER
SA1 =5L
SX3 1R
TIT1 IX6 X2-X3 CHECK FOR BLANK
ZR X2,CMP1 EXIT IF NO TITLE
SA2 A2+B1 READ NEXT CHARACTER
ZR X6,TIT1 SKIP BLANKS
SX1 2R1
SB7 8
SB6 5 SET WORD COUNT
BX7 X1
SA2 A2-B1 READ LAST CHARACTER
SB5 B0
EQ TIT3
TIT2 SB7 10
SA7 B5+HDG STORE WORD
SB6 B6-B1 DECREMENT LOOP COUNT
SB5 B5+B1
MX7 0
ZR B6,CMP1 IF DONE
TIT3 LX7 6 ENCODE 10 CHARACTERS
SB7 B7-B1 DECREMENT CHARACTER COUNT
BX7 X7+X2
SA2 A2+B1 READ NEXT CHARACTER
NZ B7,TIT3 LOOP FOR 10 CHARACTERS
EQ TIT2 GET NEXT WORD
TITLE COMMON DECKS.
** COMMON DECKS.
*CALL COMCSFN
*CALL COMCMVE
*CALL COMCWTO
*CALL COMCDXB
*CALL COMCRDC
*CALL COMCRDO
*CALL COMCRDH
*CALL COMCRDS
*CALL COMCRDW
*CALL COMCWTC
*CALL COMCWTS
*CALL COMCWTW
*CALL COMCCIO
*CALL COMCSYS
TITLE DECODING AREA.
USE DECODE DECODE AREA
TCF BSS 0 TABLE CONTENT LINE
DUP 9,1
DATA 1R
DATA 1R/
TCL BSSZ 73
BLN BSS 0 SOME BLANKS
DUP 11,1
DATA 1R
AST BSS 0 BUNCH OF ASTERISKS
DUP 72
DATA 1R-
ENDD
BP1 BSS 0 BIT POSITION TEMPLATE FOR LINE 1
NUM SET 59
DUP 1000
TEN SET NUM/10
DUP 9,1
CON 1R
IFNE TEN,0,2
CON TEN+1R0
ELSE 1
CON 1R
NUM SET NUM-10
IFLT NUM,0,1
STOPDUP
ENDD
BP1L BSS 0 DEFINE END OF TEMPLATE
BP2 BSS 0 BIT POSITION TEMPLATE FOR LINE 2
NUM SET 9
DUP 60
VFD 60/NUM+1R0
NUM SET NUM-1
IFLT NUM,0,1
NUM SET 9
ENDD
BP2L BSS 0 DEFINE END OF TEMPLATE
* ARGUMENT LIST.
ARGA BSS 0
I ARG ARGB+5,INPUT
S ARG ARGB,S
L ARG O,O
N ARG N,N
T ARG ARGB+1,T
C ARG ARGB+2,C
P ARG ARGB+3,P
NR ARG ARGB+4,NR
NT ARG ARGB+4,NT
TC ARG ARGB+4,TC
CON 0 END OF TABLE
* ASSUMED PARAMETER VALUES.
ARGB CON 0LSOURCE+3
CON 0LINT
CON 0L03B
BSS 1
CON 0LOFF
CON 0LINPUT
LNE DATA 1R ENCODE AREA FOR PRINT LINE
DATA 1R
DCD BSS 0 DECODE AREA FOR CARD IMAGE
TPF EQU LNE
TPL EQU LNE+10
ARG SPACE 4,3
** ARG - PROCESS ARGUMENTS.
*CALL COMCARG
CKO SPACE 4,10
** CKO - CHECK OPTIONS SELECTED.
*
* USES A - 1, 2, 3, 5, 6, 7.
* B - 2, 6, 7.
* X - 1, 2, 3, 5, 6, 7.
*
* CALLS DXB.
CKO PS 0 ENTRY/EXIT
SA1 S CHECK SOURCE FILE NAME
ZR X1,NOF IF NO SOURCE FILE
SA1 O CHECK OUTPUT FILE NAME
ZR X1,NOF NO OUTPUT FILE
SA5 N
SB7 N SET DECIMAL BASE
RJ DXB CONVERT NUMBER
NZ X4,DOC7 IF ILLEGAL
SA6 N
ZR X6,NOF IF NO COPIES REQUESTED
SA5 C
SB7 0 SET OCTAL BASE
RJ DXB
NZ X4,DOC7 IF ILLEGAL
SX7 X6-64
ZR X6,DOC7 IF NO CHARACTER
PL X7,DOC7 IF NOT VALID CHARACTER
SA6 C SET CHECK CHARACTER
SA5 P
SB7 P SET DECIMAL BASE
RJ DXB
NZ X4,DOC7 IF PAGE SIZE IS ILLEGAL
SX7 X6-MPGS
NG X7,DOC7 IF .LT. MINIMUM PAGE SIZE
SA6 LLM SET PAGE SIZE
SA1 T DOCUMENTATION TYPE
LX1 18
SX6 3REXT
BX5 X1-X6
SX7 3RINT
BX6 X1-X7
ZR X5,CKO1 IF EXTERNAL
NZ X6,DOC7 IF ILLEGAL
SX6 4
SA6 IDAS
SX7 2 SET INTERNAL FLAGS
SA6 NAS
SA7 MAS
SA7 EDAS
SA2 =10H INTERNAL
BX6 X2
SA6 RIFD CHANGE TITLE PAGE
SA6 HDG2 CHANGE HEADER LINE
* SPLIT FL FOR BUFFERS.
CKO1 SX6 A0 SET AVAILABLE FL
SB6 BUF
SA6 I+4 SET LIMIT ON INPUT BUFFER
SX7 A0-B6 GET REMAINDER OF CORE
AX7 1 DIVIDE BY 2
SX7 X7+B6
SA7 SCR1+4 SET LIMIT ON SCRATCH FILE
SA7 I+1 SET FIRST ON INPUT FILE
SA7 A7+B1 IN
SA7 A7+B1 OUT
SA1 MAS SET LIST OPTION STACK
SA2 NAS
SA3 XFL
LX1 40
LX2 20
BX6 X1+X2
BX6 X6+X3
SA6 LSCB
EQ CKO EXIT
* PROCESS NO OUTPUT ERRORS.
NOF MESSAGE (=C* NO I/O REQUESTED.*)
ENDRUN
SIZ EQU *-DCD SIZE OF SET-UP AREA
IFLE SIZ,NCR,1
BSSZ NCR-SIZ+1 ZERO OUT REMAINDER OF DECODE AREA
USE *
CTF SPACE 4,15
** CTF - CHECK TERMINAL OUTPUT FILE.
*
* ENTRY (O) = PRINT FILE NAME.
*
* EXIT (PD) = 0 IF PRINT FILE IS A TERMINAL FILE.
*
* USES X - 1, 2, 6.
* A - 1, 6.
*
* CALLS STF.
CTF SUBR ENTRY/EXIT
SA1 O GET CURRENT FILE NAME
BX6 X1
SA6 CTFA USE LOCAL FET FOR *STF*
SX2 A6
RJ STF
NZ X6,CTFX IF NOT A TERMINAL FILE
SA6 PD
EQ CTFX EXIT
CTFA FILEB CTFA,4,(FET=6)
CTP SPACE 4,15
** CTP - CALCULATE TITLE PAGE.
*
* ENTRY (LLM) = PAGE SIZE.
*
* EXIT (HDSL1,HDSL2) = BLANK LINES COUNT FOR TITLE PAGE.
*
* USES X - 1, 2, 3, 6, 7.
* A - 1, 6, 7.
* B - 6, 7.
CTP SUBR ENTRY/EXIT
SA1 LLM GET PAGE SIZE
SB6 B1+B1
SX6 X1+7
SA6 LCT FORCE NEW TITLE
AX6 B6,X1 DIVIDE SIZE BY 4 FOR BOTTOM LINE COUNT
IX3 X1-X6
SX2 3
IX7 X1/X2
SX7 X7-3
SA7 HDSL1 BLANK LINE COUNT FROM TOP TO TITLE
IX6 X3-X7
SX6 X6-1-7
SA6 HDSL2 BLANK LINE COUNT AFTER TITLE
EQ CTPX EXIT
BUFFERS SPACE 4
USE BUFFERS
* SCRATCH (TABLE OF CONTENTS) BUFFER.
BSSZ 1
SBUF BSS SBUFL SCRATCH BUFFER
BUF BSS 0 RESERVE SCRATCH BUFFER
IPP SPACE 4,15
** IPP - INITIALIZE PAGE PARAMETERS.
*
* EXIT JOB DEFAULT PAGE PARAMETERS INITIALIZED.
*
* USES X - 0, 1, 6.
* A - 1, 6.
* B - 2.
*
* CALLS CDD.
*
* MACROS GETPP.
IPP SUBR ENTRY/EXIT
GETPP IPPA,LLM,PD
SA1 LLM GET JOB PAGE SIZE
RJ CDD CONVERT TO DECIMAL DISPLAY
MX0 1
SB2 B2-B1
AX0 B2
BX6 X0*X4 REMOVE BLANKS
SA6 P STORE DEFAULT JOB PAGE SIZE
SA1 IPPA+1 GET DEFAULT SYSTEM PAGE SIZE
MX0 -8
AX1 12+8
BX1 -X0*X1
RJ CDD
MX0 1
SB2 B2-B1
AX0 B2
BX6 X0*X4
SA6 ARGB+3 STORE ALTERNATE DEFAULT
EQ IPPX RETURN
IPPA BSS 2 *GETPP* RESPONSE BLOCK
RIF SPACE 4,10
** RIF - READ INPUT FILE.
*
* USES A - 1, 2, 3, 4, 5, 6, 7.
* X - ALL.
RIF PS 0 ENTRY/EXIT
DATE HDG1
SA2 I
ZR X2,RIF IF NO INPUT FILE
SX7 B1 SET COMPLETE BIT
BX7 X2+X7
SA7 A2
READ I,R
SA1 X2+2
SA3 A1+B1
IX4 X1-X3
ZR X4,RIF1 IF NO DATA
READH X2,FOT,7 READ INPUT CARD
SA3 FOT
SA2 =1L
MX0 6
BX7 -X0*X3
BX7 X2+X7
SA7 A3
EQ RIF1
RIFA DATA 2L1 TITLE PAGE
RIFAL EQU *-RIFA
* INSERT (HDSL1) BLANK LINES
RIFB DATA 1H
RIFC DATA 48L
DATA 2L
DATA 1H
DATA 1H
RIFD DATA C* EXTERNAL DOCUMENTATION*
RIFBL EQU *-RIFB
* INSERT (HDSL2) BLANK LINES
RIFS DATA 1H
DATA H*PUBLICATION NUMBER*
RIFE DATA 1H
DATA 0 END OF LINE
DATA 2L
DATA 1H
DATA H*REVISION LEVEL ...*
RIFF DATA 5L
DATA 2L
DATA 1H
DATA H*REVISION DATE ....*
RIFG DATA 1H
DATA 0 END OF LINE
RIFSL EQU *-RIFS LENGTH IN WORDS OF BOTTOM PORTION
RIF1 SA1 FOT MOVE PAGE FOOT INFORMATION TO TITLE PAGE
SA2 A1+B1
MX0 30 MASK TO SPLIT PUB NUMBER
SA3 A2+B1
SA4 A3+B1
SA5 A4+B1
BX6 X1
LX7 X2
SA6 RIFC STORE FIRST WORD OF PACKAGE NAME
SA7 A6+B1 STORE SECOND WORD
BX6 X3
LX7 X4
SA6 A7+B1 STORE THIRD WORD
SA7 A6+B1 STORE FOURTH WORD
BX6 X0*X5 GET LAST FIVE CHARACTERS OF PACKAGE NAME
BX7 -X0*X5 GET FIRST FIVE CHARACTERS OF PUB NUMBER
SA6 A7+B1 STORE FIFTH WORD
LX7 30 SHIFT FIRST 5 CHARS HIGH
SA1 A5+B1 READ END OF PUB NO. AND REV. LEVEL
LX1 30
SA2 A1+B1 GET REVISION DATE
BX6 -X0*X1 GET LAST 5 CHARS OF PUB NUMBER
BX7 X6+X7
BX6 X0*X1 GET REVISION LEVEL ALONE
SA7 RIFE STORE PUBLICATION NUMBER
SA6 RIFF STORE REVISION LEVEL
SA3 RIF MOVE EXIT BEFORE IT IS DESTROYED
BX7 X2
LX6 X3
SA7 RIFG STORE REVISION DATE
SA7 NI SET INPUT FOUND FLAG
SA6 RIF4
SA1 PCT BUMP PAGE COUNT FOR PAGE PARITY
SX6 X1+B1
SA6 A1
WRITEW SCR1,RIFA,RIFAL WRITE PAGE EJECT
SA5 HDSL1 GET COUNT OF BLANK LINES
RIF2 WRITEC SCR1,(=2L )
SX5 X5-1
NZ X5,RIF2 IF MORE BLANK LINES TO WRITE
WRITEW SCR1,RIFB,RIFBL WRITE TITLE
SA5 HDSL2 GET COUNT OF BLANK LINES
RIF3 WRITEC SCR1,(=2L )
SX5 X5-1
NZ X5,RIF3 IF MORE BLANK LINES TO WRITE
WRITEW SCR1,RIFS,RIFSL WRITE BOTTOM OF PAGE
WRITER SCR1,R
RIF4 EQ RIF EXIT
*CALL COMCCPM
*CALL COMCCDD
*CALL COMCSTF
MFL= EQU 200000B+BUF+2*BFSZ+10B
USE *
END SPACE 4
END