TITLE 'TELEFILE ASSEMBLY PROGRAM - APCCI'
PCC 0
SPACE 6
* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
* %%%%% MODULE NAME: APCCI %%%%%
* %%%%% LAST UPDATED: MAR 07, 1984 %%%%%
* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SPACE 2
SPACE 12
* T E L E F I L E P R O P R I E T A R Y P R O D U C T
SPACE 2
* THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
* PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
* DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
* TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
* SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
* COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
* THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
* PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
PAGE
SPACE 12
* T E L E F I L E P R O P R I E T A R Y P R O D U C T
SPACE 2
* THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
* PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
* DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
* TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
* SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
* COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
* THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
* PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
PAGE
BPMUTS EQU 2
RBM EQU 3
SYS EQU BPMUTS
XAPDATA DSECT 0 OVERLAY DATA AREA
XAPD1 DSECT 0 OVERLAY DATA AREA
CCI1 CSECT 1 CODE SECTION
DO SYS=BPMUTS
SYSTEM BPM
M:PT 1 GENERATE FPT'S IN PROTECT. TYPE 1
FIN
DO SYS=RBM
SYSTEM RBM
FIN
*
SYSTEM AP%IL
*
* XEROX ASSEMBLY PROGRAM CONTROL CARD INTERPRETER.
*
REF AC%FLAG
REF PD%FLAG
*
DEF CTL%CARD%INTERPRETER (ENTRY POINT.)
DEF STDERROR
DEF AP%ABORT (ENTRY POINT)
*
REF CO%SIZE BYTE SIZE OF CO RECORD
REF M:C
REF ERR%%X1,ERR%%X3
REF ERR%%X2,ERR%%X4
REF ABN%%X1,ABN%%X3
REF ABN%%X2,ABN%%X4
REF ABN%%STD
REF ABORT
REF ACCOUNTS
REF #ACCTS
REF CORRESWD FLAGS INDIC. IDEN. DCB ASSIGNMENTS
REF ERR%%STD *D-CCI
REF LOWCORE
REF ENDCORE
REF MAJLINE,SUBLINE ASSEMBLY LINE NUMBER
REF SEGMENT# AP OVERLAY SEGMENT
*
DO SYS=BPMUTS
REF INIT%TUNITS
REF PAGETBL
REF SO%ADJ%FPT
REF SO%ADJ%NAME
REF SO%KEY
FIN
*
REF SYSLEVEL
REF MPX1
REF SYSNAME
REF CLOSE%FILES
REF ROOTRTN
REF SAVAREA
REF XAPCODE
REF X3BUF,WDX3SIZE
REF WRITEDO,WRITELO
REF LSTBF
REF CLRLSTBF
REF OPTION%FLAGS
REF PGLINES
REF SDFCON
REF SDFSYS
REF SDFSYS%SIZE
REF LINE%TYPE
REF ASSEMBLE%FLAG
REF NUM%PAGE%LINES
REF ERR%%BO,ERR%%CI,ERR%%CO,ERR%%DO
REF ERR%%GO,ERR%%LO,ERR%%SI,ERR%%SO
REF BYX1SIZE,BYX3SIZE
REF BO%IDWDS,CO%IDWDS
DO SYS=BPMUTS
REF DO%ONLINE
REF LO%ONLINE
REF M:UC
REF F:X1,F:X2,F:X3,F:X2KF,F:X5
FIN
REF F:STD,F:SYS
REF TRAPLOC
REF M:SI,M:SO,M:CI,M:CO
REF M:BO,M:DO,M:GO,M:LO
*
DO SYS=BPMUTS
SREF J:JIT,JOPT
SREF TPEXT
SREF TPOVT
SREF TUEXT
SREF TUOVT
FIN
*
DO SYS=RBM
REF M:X1,M:X2,M:X3,M:X4,M:X5
FIN
*
DEF CCI1
*
* EQUATES FOR ABORT
*
ABORT9 EQU 9
ABORT10 EQU 10
ABORT11 EQU 11
ABORT12 EQU 12
*
* REGISTERS.
*
R0 EQU 0
X1 EQU 1 TEMP INDEX.
X2 EQU 2 INDEX TO CURRENT CHARACTER.
X3 EQU 3
X4 EQU 4
X5 EQU 5
X6 EQU 6
X7 EQU 7 INTERNAL LINK REGISTER.
R8 EQU 8 OPTION-NAME ACCUMULATOR.
R9 EQU 9 CURRENT CHARACTER.
R10 EQU 10 TEMP.
R11 EQU 11 TEMP.
R12 EQU 12 TEMP.
R13 EQU 13 TEMP.
R14 EQU 14
R15 EQU 15 EXTERNAL LINK REGISTER.
IOADD EQU 8
IOSIZE EQU 9
IORL EQU 10
SR1 EQU 8
SR2 EQU 9
SR3 EQU 10
SR4 EQU 11
AR EQU 0 ABORT REGISTER
AM EQU 1 ABORT MESSAGE REGISTER
XW EQU 2
XT EQU 4 TEMP (EVEN)
XT1 EQU XT+1 TEMP (ODD)
XT2 EQU XT+2 TEMP
RL EQU 7 SUBROUTINE LINK REGISTER
* *D-CCI
* MISCELLANEOUS *D-CCI
* *D-CCI
ADDRFLD EQU X'1FFFF' WORD ADDRESS FIELD MASK *D-CCI
EADRFLD EQU X'1FFFE' (EVEN) WORD ADDRESS FIELD MASK *D-CCI
*
* SALUTE MESSAGE
*
SALUTE%START TEXT ' TELEFILE ASSEMBLY PROGRAM '
DATA,1 X'0D',X'40',C'O',C'P'
TEXT 'TIONS '
SALUTE%END DATA X'16000000'
*
* EQUATES FOR LOCATIONS WITHIN RBM
*
CPRABNEO EQU 4 DCB ABN FIELD OFFSET (CP-R) *D-CCI
CPRERREO EQU 3 CPR ERR FIELD OFFSET (CP-R) *D-CCI
D1 EQU 6 TYPE CODE FOR 'D1' AREA ON DISK
K:BPEND EQU X'153' FWA OF USABLE BACKGROUND
K:BCKEND EQU X'141' LWA OF USABLE BACKGROUND
K:PAGE EQU X'174' BYTE 0 HAS NO. LINES ON PRINT PAGE
K:CCBUF EQU X'144' CONTAINS LOCATION OF CONTROL CARD
* UTS JIT OPTION BITS. MASKS FOR BITS WITHIN JOPT WORD
LOBIT EQU 1 BIT 31. SET BY TEL 'LIST'
GOBIT EQU X'80' BIT 24. SET BY TEL 'OUTPUT'
DOBIT EQU X'100' BIT 23. SET BY TEL 'COMMENT'
*
* SIMPLE OPTIONS - THOSE REQUIRING ONLY A PRESENCE FLAG.
* TO ADD A SIMPLE OPTION USE THE 'OPTION' COMMAND WITH LF(1) =
* FLAG NAME & AF(1) = OPTION-STRING (<= 4 CHARACTERS). DON'T
* FORGET TO ADD CORRESPONDING ENTRY TO OPTION%FLAGS TABLE (ROOT).
*
#SIMPLE%OPTIONS SET 0
*
OPTION CNAME
PROC
REF LF (THESE ARE IN THE ROOT)
DATA AF(1)
#SIMPLE%OPTIONS SET #SIMPLE%OPTIONS+1
PEND
USECT CCI1
OPTION%NAMES RES 0
*
BA%FLAG OPTION 'BA'
BO%FLAG OPTION 'BO'
CI%FLAG OPTION 'CI'
CO%FLAG OPTION 'CO'
DC%FLAG OPTION 'DC'
GO%FLAG OPTION 'GO'
LO%FLAG OPTION 'LO'
LS%FLAG OPTION 'LS'
LU%FLAG OPTION 'LU'
ND%FLAG OPTION 'ND'
NS%FLAG OPTION 'NS'
SD%FLAG OPTION 'SD' SYMBOLIC DEBUGGING OUTPUT
SI%FLAG OPTION 'SI'
SO%FLAG OPTION 'SO'
SU%FLAG OPTION 'SU'
PAGE
LOCAL %05,%10,%20,%30
CTL%CARD%INTERPRETER EQU %
STW,R15 ROOTRTN SAVE RETURN ADDRESS
*
* SET UP CURRENT TIMER UNIT COUNT FOR STATUS
* REPORTING BY ON-LINE BREAK RECEIVER.
*
DO SYS=BPMUTS
LW,XT J:JIT+TPEXT GET CURRENT CHARGEABLE
AW,XT J:JIT+TPOVT TIME UNITS AND SAVE
AW,XT J:JIT+TUEXT FOR LATER STATUS.
AW,XT J:JIT+TUOVT
STW,XT INIT%TUNITS
LI,XT 0
STW,XT SO%KEY
FIN
*
LW,X1 =' '
STW,X1 BLANKS
STW,X1 BLANKS+1
LI,X1 0
STW,X1 LINE%TYPE
STW,X1 SDFCON INITIAL SYSTEM NAME TABLE LENGTH
STW,X1 SYSLEVEL
STW,X1 #ACCTS
STW,X1 BLANK%SWITCH SET TO IGNORE BLANKS
STW,X1 PRINT%SWITCH
STW,X1 PGLINES
STW,X1 SEGMENT#
BAL,IORL OPENC
BAL,IORL OPENDO
BAL,IORL OPENLO
M:DEVICE M:LO,(VFC)
DO SYS=BPMUTS
MTW,0 *X'4F' ARE WE ONLINE?
BGEZ %05 BRANCH IF NO.
LW,X1 J:JIT+JOPT
CI,X1 LOBIT SET LO%FLAG IF 'LIST' BIT IS ON
BAZ %+2 IT'S OFF
MTW,+1 LO%FLAG
CI,X1 GOBIT SET GO%FLAG IF 'OUTPUT' IS ON
BAZ %+2 IT'S OFF
MTW,+1 GO%FLAG
CAL1,1 =X'2C00006E' SET '>' AS PROMPT CHARACTER
M:WRITE M:UC,(BUF,SALUTE%START),(SIZE,38)
BAL,X7 READ%CTL%CARD READ CONTROL CARD.
B %20
ELSE
LI,X1 0
LV,XT D1
STB,XT ACCOUNTS PRESET DEFAULT ACCOUNT AREA
MTW,+1 #ACCTS SET DEFAULT # ACCTS TO 1
%30 RES 0
LW,R8 *K:CCBUF,X1 MOVE CONTROL CARD
STW,R8 CTL%CARD,X1 TO CTL%CARD AREA
AI,X1 1
CI,X1 20
BL %30
B %10
FIN
%05 RES 0
BAL,X7 READ%CTL%CARD READ CONTROL CARD
%10 RES 0
LI,X2 0
BAL,X7 GET%NEXT%NONBLANK SKIP LEADING BLANKS
%12 RES 0
BAL,X7 GET%NEXT%CHAR SKIP TO THE
CI,R9 ' ' TERMINATOR AFTER
BE %20 THE PROCESSOR NAME
CI,R9 ','
BNE %12
%20 BAL,X7 GET%NEXT%NONBLANK GET 1ST OPTION CHARACTER.
CI,R9 '.' IS IT PERIOD?
BE SET%DEFAULTS BRANCH IF YES.
AI,X2 -1 BACK UP FOR RESCAN OF 1ST CHAR.
B COLLECT%OPTION GO GET OPTIONS.
PAGE
LOCAL %10
NEXT%OPTION EQU %
CI,R9 ',' IS CURRENT CHAR A COMMA?
BE COLLECT%OPTION BRANCH IF YES.
CI,R9 '.' IS IT A PERIOD?
BE OPTIONS%DONE BRANCH IF YES. (ALL DONE.)
B BAD%SYNTAX IT'S STRANGE; REPORT ERROR.
COLLECT%OPTION EQU %
LI,R8 0 CLEAR OPTION-NAME ACCUMULATOR.
%10 BAL,X7 GET%NEXT%NONBLANK GET A CHARACTER.
CI,R9 'A' IS IT LETTER OR DIGIT?
BL SEARCH%OPTIONS BRANCH IF NO.
SLS,R8 +8 SHIFT PREVIOUS CHARS OVER.
OR,R8 R9 MERGE IN NEWEST.
B %10 GO GET ANOTHER.
PAGE
LOCAL %10,%20,%30,%40,%50,%60,%70,%80,%90
LOCAL %100,%110,%120
LOCAL %130,%140,%150,%160,%170,%180
LOCAL %200,%210,%220,%125
SEARCH%OPTIONS EQU %
LI,X1 #SIMPLE%OPTIONS SEARCH ALL SIMPLE OPTIONS.
%10 CW,R8 OPTION%NAMES-1,X1 IS IT THIS ONE?
IF,EQ
MTW,+1 OPTION%FLAGS-1,X1
B NEXT%OPTION
*
FI
BDR,X1 %10 TRY ANOTHER.
*
* NOT A SIMPLE OPTION - IS IT ONE OF THE SPECIAL OR
* AUGMENTED OPTIONS?
*
CI,R8 'CN'
IF,EQ
MTH,+1 DC%FLAG
B NEXT%OPTION
*
FI
CI,R8 'PD'
BE %40 BRANCH IF YES.
CI,R8 'AC' IS IT 'AC'?
BE %90 BRANCH IF YES.
CI,R8 'SB' IS IT 'SB'?
BE %130 BRANCH IF YES.
CI,R8 'SC' IS IT 'SC'?
BE %140 BRANCH IF YES.
B ILLEGAL%OPTION NOT FOUND; REPORT ERROR.
%40 MTW,+1 PD%FLAG SET FLAG.
CI,R9 '(' ARE THERE SYSTEM NAMES?
BNE NEXT%OPTION BRANCH IF NO.
LI,X6 0 INITIALIZE NAME-TABLE INDEX.
STW,X6 SDFCON CLEAR SDFSYS SIZE & NO. OF ENTRIES
%50 LW,X5 X6 SAVE INDEX FOR STORING LENGTH.
%60 BAL,X7 GET%NEXT%CHAR GET CHARACTER.
CI,R9 ')' ARE WE FINISHED WITH ALL NAMES?
BE %70 BRANCH IF YES.
CI,R9 ',' ARE WE FINISHED WITH THIS NAME?
BE %70 BRANCH IF YES.
AI,X6 +1 BUMP INDEX.
CI,X6 SDFSYS%SIZE HAVE WE EXCEEDED TABLE SIZE?
BG BAD%SYNTAX BRANCH IF YES.
STB,R9 SDFSYS,X6 STORE CHAR IN TABLE.
B %60 GO GET ANOTHER CHAR.
%70 MTW,+1 SDFCON BUMP NAME COUNT.
LW,R8 X6 CALCULATE NAME
SW,R8 X5 LENGTH.
BEZ BAD%SYNTAX ZERO LENGTH = ERROR.
STB,R8 SDFSYS,X5 STORE LENGTH.
CI,R9 ')' ARE ALL NAMES FINISHED?
BE %80 BRANCH IF YES.
AI,X6 +1 BUMP INDEX.
B %50 GO GET NEXT NAME.
*
%80 RES 0
AI,X6 +4 CONVERT BYTES
SAS,X6 -2 TO WORDS.
STH,X6 SDFCON STORE COUNT OF BYTES.
BAL,X7 GET%NEXT%NONBLANK GET CHAR. (SHOULD BE ',' IF MORE.)
B NEXT%OPTION GO PROCESS NEXT OPTION.
%90 MTW,+1 AC%FLAG INDICATE OPTION.
DO SYS=RBM
MTW,-1 #ACCTS DELETE LAST ACCOUNT (SP AREA)
FIN
CI,R9 '(' IF NOT '('
BNE BAD%SYNTAX THEN ERROR.
%100 LD,R12 8BLANKS INITIALIZE ACCT-NAME ACCUMULATOR.
LI,X5 0 INITIALIZE ACCUM. INDEX.
%110 BAL,X7 GET%NEXT%CHAR GET NEXT CHAR.
CI,R9 ',' IS IT COMMA?
BE %120 BRANCH IF YES.
CI,R9 ')' IS IT ')'?
BE %120 BRANCH IF YES.
STB,R9 R12,X5 STORE INTO ACCUM.
AI,X5 +1 BUMP INDEX.
CI,X5 +8 MORE THAN 8
BG BAD%SYNTAX CHARS IS ERROR.
B %110 GO GET NEXT CHAR.
DO SYS=BPMUTS
%120 LW,X5 #ACCTS GET ACCT-NAME COUNT.
MTW,+1 #ACCTS INCREMENT COUNT (IN MEMORY).
STD,R12 ACCOUNTS,X5 USE FORMER COUNT AS STORE INDEX.
CI,X5 8
BL ACCT%OK
FIN
DO SYS=RBM
%120 RES 0
CI,X5 2 ACCOUNTS MUST BE TWO CHARS
BNE BAD%SYNTAX
LI,X5 16 TOTAL NUMBER OF ACCOUNTS
NEXT%AC RES 0
CW,R12 AC%TABLE-1,X5 FIND THE ACCOUNT NAME
BE AC%FND
BDR,X5 NEXT%AC
B BAD%SYNTAX
AC%FND RES 0
LW,X1 #ACCTS
CI,X1 15 TEST FOR TOO MANY
BL ACCT%OK
FIN
ABORT ABORT9 TOO MANY ACCOUNT AREAS SPECIFIED
ACCT%OK RES 0
DO SYS=RBM
AI,X5 -1
LB,X7 AC%CODE,X5 ACCOUNT CODE
STB,X7 ACCOUNTS,X1
MTW,+1 #ACCTS BUMP NUMBER OF ACCTS
FIN
CI,R9 ',' IS THERE ANOTHER NAME?
BE %100 BRANCH IF YES.
DO SYS=RBM
LI,X7 D1 ADD D1 AREA AS LAST ACCT. /27062/*D-CCI
AI,X1 1
STB,X7 ACCOUNTS,X1
MTW,+1 #ACCTS AND BUMP # OF ACCTS
FIN
%125 RES 0
BAL,X7 GET%NEXT%NONBLANK GET CHAR. (SHOULD BE '.' OR ',')
B NEXT%OPTION GO PROCESS NEXT OPTION.
%130 RES 0
LI,R14 BO%FLAG
LI,X3 BO%IDWDS
B %150
%140 RES 0
LI,R14 CO%FLAG
LI,X3 CO%IDWDS
%150 RES 0
LI,X7 8 SET NO. OF DIGITS TO 8
STB,X7 *R14
MTH,1 *R14 SET SB OR SC FLAG
LI,X7 0
STW,X7 0,X3 CLEAR THE 3 ID/SEQ-NO
STW,X7 1,X3 WORDS
STW,X7 2,X3
STW,X7 3,X3 CLEAR THE INITIAL SEQNO. WORD
STW,X3 SAVEREGS SAVE FOR ADDRESS OF SEQUENCE NO.
CI,R9 '(' IS THERE AN IDENT STRING
BNE NEXT%OPTION NO. GO GET NEXT OPTION
SLS,X3 1 CONVERT TO HALFWORD ADDRESS
%160 RES 0
BAL,X7 GET%NEXT%CHAR NEXT IDENT CHARACTER
CI,R9 ')'
BE %125 END OF IDENT. GO READ TRAILING ','
CI,R9 '(' IS THERE AN INITIAL SEQUENCE NUMBER
BE GETSEQ YES. GO CONVERT IT
MTB,-1 *R14 SUBT. 1 FROM BYTE COUNT
BLZ BAD%SYNTAX MORE THAN 8 IDENT. CHARACTERS
LI,X7 X'3F' TRIM IDENT CHAR TO 6 BITS
AND,X7 R9
LH,R9 IDENTBL,X7 TRANSLATE TO A 12-BIT COLUMN CODE
LB,X7 SFTBL,X1 GET NEXT SHIFT AMOUNT
SLS,R9 0,X7 SHIFT 12-BIT CODE TO NEXT FIELD
CI,X1 3 IS THIS 1ST OR 5TH CHARACTER
BAZ %180 YES, DON'T BUMP HALFWORD ADDRESS
LH,X7 R9 STORE HIGH ORDER
AH,X7 0,X3 BITS IN
STH,X7 0,X3 CURRENT HALFWORD
AI,X3 1 BUMP HALFWORD ADDRESS
%180 RES 0
AH,R9 0,X3 STORE LOW ORDER BITS
STH,R9 0,X3
AI,X1 1 BUMP INDEX TO SHIFT TABLE
B %160
GETSEQ RES 0
LW,X3 SAVEREGS GET ADDR (-3) OF SEQUENCE NO.
GETSEQ1 RES 0
BAL,X7 GET%NEXT%CHAR NEXT SEQUENCE CHARACTER
AI,R9 -'0' IS IT NUMERIC
BL SEQEND NO, TEST FOR RT PAREN
CI,R9 9 ERROR IF GREATER THAN 9
BG BAD%SYNTAX
LW,X7 3,X3 PARTIAL SEQUENCE WORD
MI,X7 10
AW,X7 R9
STW,X7 3,X3
B GETSEQ1
SEQEND RES 0
CI,R9 ')'-'0' TERMINATOR MUST BE RT PAREN
BNE BAD%SYNTAX
BAL,X7 GET%NEXT%CHAR GET TERMINATOR FOR IDENT
CI,R9 ')' IT MUST ALSO BE RT PAREN
BE %125
B BAD%SYNTAX
SFTBL DATA,1 4,8,12,16,4,8,12,16
BOUND 4
ILLEGAL%OPTION EQU %
AI,R8 0 IGNORE
BEZ NEXT%OPTION NULL OPTION.
OR,R8 =' ' INSERT LEADING BLANKS.
LI,X7 MSGS SIZE OF MESSAGE
LW,R10 OPTION%IGNORED-1,X7
STW,R10 BUF%PRINT-1,X7 MOVE MESSAGE TO PRINT AREA
BDR,X7 %-2
STW,R8 BUF%PRINT-1+MSGS STORE UNKNOWN OPTION
M:PRINT (MESS,BUF%PRINT)
B NEXT%OPTION GO GET NEXT OPTION.
PAGE
LOCAL %10
BAD%SYNTAX EQU %
* PRINT CONTROL CARD IN ERROR, PRINT ERROR POINTER,
* PRINT ERROR MESSAGE, EXIT TO MONITOR.
M:WRITE M:LL,(BUF,CTL%CARD%DISPLAY),(SIZE,88)
LD,R12 8BLANKS
LI,X1 +10
%10 STD,R12 CTL%CARD%DISPLAY,X1
BDR,X1 %10
LI,R8 ':'
STB,R8 CTL%CARD,X2
M:WRITE M:LL,(BUF,CTL%CARD%DISPLAY),(SIZE,88)
ABORT ABORT10 CONTROL CARD ERROR
PAGE
LOCAL %05,%10,%15,%20
GET%NEXT%CHAR EQU %
MTW,+1 BLANK%SWITCH DON'T IGNORE BLANKS.
GET%NEXT%NONBLANK EQU %
STW,X7 GET%NEXT%RETURN SAVE RETURN.
%05 CI,X2 +79 ARE WE AT END OF RECORD?
BGE %15 BRANCH IF YES.
AI,X2 +1 BUMP INDEX TO NEXT CHAR.
LB,R9 CTL%CARD,X2 GET CHARACTER.
CI,R9 X'15' IS IT LINE-FEED?
BE %10 BRANCH IF YES.
CI,R9 X'0D' IS IT CARRIAGE-RETURN?
BE %10 BRANCH IF YES.
MTW,0 BLANK%SWITCH SHALL WE IGNORE BLANKS?
BNEZ %20 BRANCH IF NO.
CI,R9 ' ' IS IT A BLANK?
BE %05 BRANCH IF YES.
CI,R9 ';' IS IT SEMICOLON?
BNE %20 BRANCH IF NO.
BAL,X7 READ%CTL%CARD READ CONTINUATION RECORD.
B %05 GO GET CHARACTER.
%10 LI,R9 ' ' REPLACE LF OR
STB,R9 CTL%CARD,X2 CR WITH BLANK.
%15 LI,R9 '.' RETURN FAKE PERIOD.
LI,X2 +80
%20 LI,X7 0 INSURE
STW,X7 BLANK%SWITCH SWITCH OFF.
B *GET%NEXT%RETURN RETURN.
PAGE
LOCAL %10,%20
READ%CTL%CARD EQU %
LI,X1 +10 CLEAR
LD,R12 8BLANKS BUFFER
%10 STD,R12 CTL%CARD%DISPLAY,X1 TO
BDR,X1 %10 BLANKS.
M:READ M:C,(BUF,CTL%CARD),(SIZE,80)
LI,X2 -1 INITIALIZE BUFFER INDEX.
DO SYS=BPMUTS
MTW,0 *X'4F' ARE WE ONLINE?
BLZ 0,X7 RETURN IF YES.
MTW,0 PRINT%SWITCH IS THIS 1ST CTL CARD?
BEZ %20
FIN
M:WRITE M:LL,(BUF,CTL%CARD),(SIZE,80)
%20 MTW,+1 PRINT%SWITCH SET TO PRINT CONTINUATIONS.
B 0,X7 RETURN.
PAGE
* EQUATES FOR COLUMN NUMBERS USED IN IDENTBL
#12 EQU X'800' COLUMN 12
#11 EQU X'400' COLUMN 11
#0 EQU X'200' COLUMN 0
#1 EQU X'100' COLUMN 1
#2 EQU X'080' COLUMN 2
#3 EQU X'040' COLUMN 3
#4 EQU X'020' COLUMN 4
#5 EQU X'010' COLUMN 5
#6 EQU X'008' COLUMN 6
#7 EQU X'004' COLUMN 7
#8 EQU X'002' COLUMN 8
#9 EQU X'001' COLUMN 9
IDENTBL RES 0
DATA,2 0 BLANK
DATA,2 #12+#1 A 12-1
DATA,2 #12+#2 B 12-2
DATA,2 #12+#3 C 12-3
DATA,2 #12+#4 D 12-4
DATA,2 #12+#5 E 12-5
DATA,2 #12+#6 F 12-6
DATA,2 #12+#7 G 12-7
DATA,2 #12+#8 H 12-8
DATA,2 #12+#9 I 12-9
DATA,2 #12+#8+#2 CENT 12-8-2
DATA,2 #12+#8+#3 DEC PT 12-8-3
DATA,2 #12+#8+#4 LESS 12-8-4
DATA,2 0 LT PAREN
DATA,2 #12+#8+#6 PLUS 12-8-6
DATA,2 #12+#8+#7 OR 12-8-7
DATA,2 #12 AND 12
DATA,2 #11+#1 J 11-1
DATA,2 #11+#2 K 11-2
DATA,2 #11+#3 L 11-3
DATA,2 #11+#4 M 11-4
DATA,2 #11+#5 N 11-5
DATA,2 #11+#6 O 11-6
DATA,2 #11+#7 P 11-7
DATA,2 #11+#8 Q 11-8
DATA,2 #11+#9 R 11-9
DATA,2 #11+#8+#2 EXCLAM 11-8-2
DATA,2 #11+#8+#3 DOLLAR 11-8-3
DATA,2 #11+#8+#4 ASTERISK 11-8-4
DATA,2 0 RT PAREN
DATA,2 #11+#8+#6 SEMICLN 11-8-6
DATA,2 #11+#8+#7 NOT 11-8-7
DATA,2 #11 MINUS 11
DATA,2 #0+#1 SLASH 0-1
DATA,2 #0+#2 S 0-2
DATA,2 #0+#3 T 0-3
DATA,2 #0+#4 U 0-4
DATA,2 #0+#5 V 0-5
DATA,2 #0+#6 W 0-6
DATA,2 #0+#7 X 0-7
DATA,2 #0+#8 Y 0-8
DATA,2 #0+#9 Z 0-9
DATA,2 #12+#11 12-11
DATA,2 #0+#8+#3 COMMA 0-8-3
DATA,2 #0+#8+#4 PERCENT 0-8-4
DATA,2 #0+#8+#5 UNDSCORE 0-8-5
DATA,2 #0+#8+#6 GREATER 0-8-6
DATA,2 #0+#8+#7 QUESTION 0-8-7
DATA,2 #0 0 0
DATA,2 #1 1 1
DATA,2 #2 2 2
DATA,2 #3 3 3
DATA,2 #4 4 4
DATA,2 #5 5 5
DATA,2 #6 6 6
DATA,2 #7 7 7
DATA,2 #8 8 8
DATA,2 #9 9 9
DATA,2 #8+#2 COLON 8-2
DATA,2 #8+#3 NUMBER 8-3
DATA,2 #8+#4 AT 8-4
DATA,2 #8+#5 PRIME 8-5
DATA,2 #8+#6 EQUAL 8-6
DATA,2 #8+#7 QUOTES 8-7
BOUND 4
PAGE
LOCAL %05,%10,%20,%30
SET%DEFAULTS EQU %
MTW,+1 SI%FLAG SET
MTW,+1 LO%FLAG DEFAULT
MTW,+1 GO%FLAG OPTIONS.
OPTIONS%DONE EQU %
BAL,RL IGNORE%TRAPS
*
* 'DC' OVERRIDES 'CN' IF BOTH WERE SPECIFIED
*
LH,R8 DC%FLAG
IF,NZ
LW,R8 DC%FLAG
CI,R8 X'FFFF'
IF,ANZ
LI,R8 1
STW,R8 DC%FLAG
FI
FI
MTW,0 PD%FLAG FORCE NO STD DEF FILE READ
BEZ %+2 IF WE'RE PRODUCING ONE
MTW,1 ND%FLAG
* SET ASSEMBLE%FLAG TO REFLECT WHETHER THE DEFGEN PASS IS REQUIRED
LW,R8 GO%FLAG
OR,R8 LO%FLAG
OR,R8 BO%FLAG
STW,R8 ASSEMBLE%FLAG
DO SYS=BPMUTS
BNEZ %05 IT'S REQUIRED
* IF ON-LINE, DEFGEN IS REQ'D IF 'LIST','OUTPUT',OR 'COMMENT' IS ON
LW,R8 *X'4F'
BGEZ %05 BRANCH IF NOT ON LINE
LI,R8 LOBIT+GOBIT+DOBIT
AND,R8 J:JIT+JOPT
STW,R8 ASSEMBLE%FLAG
FIN
%05 RES 0
DO SYS=BPMUTS
MTW,0 *X'4F' IF ON-LINE, SET SI AS DEFAULT
BGEZ %06 BRANCH IF NOT ON-LINE
LW,R8 CI%FLAG
BNEZ %06
MTW,+1 SI%FLAG
FIN
%06 RES 0
MTW,0 SI%FLAG IS THERE SI?
BEZ %10 BRANCH IF NO.
MTW,+1 LINE%TYPE INDICATE SI.
%10 MTW,0 CI%FLAG IS THERE CI?
BEZ TEST%SO BRANCH IF NO.
MTW,2 LINE%TYPE
TEST%SO RES 0
MTW,0 SO%FLAG
BEZ TEST%CO
BAL,IORL OPENSO
TEST%CO RES 0
MTW,0 CO%FLAG
BEZ TEST%BO
BAL,IORL OPENCO
TEST%BO RES 0
MTW,0 BO%FLAG
BEZ TEST%GO
BAL,IORL OPENBO
TEST%GO RES 0
MTW,0 GO%FLAG
BEZ TEST%TEMPS
BAL,IORL OPENGO
TEST%TEMPS RES 0
LW,R8 LINE%TYPE
CI,R8 3
BNE OPEN%TEMPS
BAL,IORL OPENX2KF
BAL,IORL OPENX2
OPEN%TEMPS RES 0
BAL,IORL OPENX1
BAL,IORL OPENX3
LW,IORL LO%FLAG TURN OFF DO-LO CORRESPONDANCE
BNEZ TEST%STD IF 'LO' IS NOT REQUESTED
*
STB,IORL CORRESWD
TEST%STD RES 0
LI,X1 0
MTW,0 ND%FLAG
BNEZ TEST%PD
BAL,IORL OPENSTD OPEN F:STD IN USER'S ACCOUNT
B TEST%SI IT'S OPEN
TEST%PD RES 0
MTW,0 PD%FLAG
BEZ TEST%SI
BAL,IORL OPENSTDOUT OPEN F:STD FOR OUTPUT
TEST%SI RES 0
* DON'T OPEN SI OR CI UNTIL ALL OUTPUT FILES HAVE BEEN OPENED
MTW,0 SI%FLAG
BEZ TEST%CI
BAL,IORL OPENSI
TEST%CI RES 0
MTW,0 CI%FLAG
BEZ OPEN%SYS
BAL,IORL OPENCI
OPEN%SYS RES 0
%20 MTW,0 LINE%TYPE IS THERE ANYTHING INDICATED?
BEZ %30 BRANCH IF NO.
DO SYS=BPMUTS
LW,X7 #ACCTS
MTW,2 #ACCTS
LI,X1 1 INSERT USER'S ACCOUNT
LW,R8 *X'4F',X1
AI,X1 1
LW,R9 *X'4F',X1
STD,R8 ACCOUNTS,X7
LD,R8 COLON%SYS INSERT :SYS ACCOUNT
STD,R8 ACCOUNTS+2,X7
M:SETDCB F:STD,; CHANGE TO ROOT-RESIDENT ROUTINES
(ERR,ERR%%STD),;
(ABN,ABN%%STD)
ELSE
LV,R9 ADDRFLD
LI,R8 ERR%%STD
STS,R8 F:STD+CPRERREO
LI,R8 ABN%%STD
STS,R8 F:STD+CPRABNEO
FIN
B *ROOTRTN RETURN TO THE ROOT
%30 RES 0
ABORT ABORT11 NO INPUT SPECIFIED
STDERROR RES 0
LB,R8 SR3 ERROR CODE
CI,R8 3
BNE ABN%%STD
DO SYS=BPMUTS
CI,X1 0 WAS OPEN IN :SYS ACCOUNT
BNE STDERR5 YES
FIN
* ABORT IF F:STD WAS RE-ASSIGNED
LI,R8 X'F'
AND,R8 F:STD
CI,R8 1
BNE SDFNOTHR
DO SYS=BPMUTS
LW,R8 F:STD+X'17'
CW,R8 =X'085B7AE2' COMPARE FOR '%:STDDEF'
BNE SDFNOTHR
LW,R8 F:STD+X'18'
CW,R8 ='TDDE'
BNE SDFNOTHR
LI,X1 1 SET FLAG FOR :SYS ACCT
BAL,IORL OPENSTD%SYS TRY OPEN IN :SYS ACCOUNT
B TEST%SI IT'S OPEN
FIN
DO SYS=RBM
LW,XT F:STD+1
AND,XT L(X'3F'**8)
CV,XT D1**8
BNE SDFNOTHR REASSIGNED IF NOT IN DEFAULT AREA
*
LW,R8 F:STD+5 IF NAME ISN'T '%:STDDEF',
CW,R8 ='%:ST'
BNE SDFNOTHR
LW,R8 F:STD+6
CW,R8 ='DDEF'
BNE SDFNOTHR
LI,X1 1
FIN
STDERR5 RES 0
STW,X1 ND%FLAG
B TEST%SI
SDFNOTHR RES 0
ABORT ABORT12 STD DEF FILE DOES NOT EXIST
PAGE
*
* O P E N X 1
* OPEN THE X1 (ENCODED TEXT) FILE
*
OPENX1 RES 0
DO SYS=BPMUTS
LI,IOADD F:X1
LW,IOSIZE =X'05C6E7F1' 'FX1'
B OPNJOIN
FIN
DO SYS=RBM
M:OPEN M:X1,(ERR,ERR%%X1),(ABN,ABN%%X1)
M:DEVICE M:X1,;
(SIZE,BYX1SIZE),;
(ORG,UNBLOCK)
B *IORL
FIN
*
* O P E N X 2
* OPEN THE X2 FILE
*
OPENX2 RES 0
DO SYS=BPMUTS
LI,IOADD F:X2
LW,IOSIZE =X'05C6E7F2' 'FX2'
B OPNJOIN
FIN
DO SYS=RBM
M:OPEN M:X2,(ERR,ERR%%X2),(ABN,ABN%%X2)
M:DEVICE M:X2,;
(SIZE,80),;
(ORG,BLOCK)
B *IORL
FIN
*
* O P E N X 3
* OPEN THE X3 (COMPRESSED SOURCE) FILE
*
OPENX3 RES 0
DO SYS=BPMUTS
LI,IOADD F:X3
LW,IOSIZE =X'05C6E7F3' 'FX3'
B OPNJOIN
FIN
DO SYS=RBM
M:OPEN M:X3,(ERR,ERR%%X3),(ABN,ABN%%X3)
M:DEVICE M:X3,;
(SIZE,BYX3SIZE),;
(ORG,UNBLOCK)
B *IORL
FIN
*
* O P E N X 2 K F
* OPEN THE X2KF FILE
*
OPENX2KF RES 0
DO SYS=BPMUTS
LI,IOADD F:X2KF
LW,IOSIZE =X'05F2D2C6' '2KF'
OPNJOIN RES 0
LI,X1 OPENEND-OPENFPT SIZE OF FPT TO MOVE
OPNJN1 RES 0
LW,X2 OPENFPT-1,X1 MOVE AN FPT WORD TO TEMP
STW,X2 SAVAREA-1,X1
BDR,X1 OPNJN1
STW,IOSIZE SAVAREA+4 STORE FILE NAME
LW,IOSIZE *X'4F'
STH,IOSIZE SAVAREA+5 UNIQUE ACCOUNT I.D.
M:OPEN,E SAVAREA OPEN THE TEMP FILE
B *IORL
OPENFPT M:OPEN,L *IOADD,(FILE,'2KF '),(OUTIN)
OPENEND RES 0
FIN
DO SYS=RBM
M:OPEN M:X4,(ERR,ERR%%X4),(ABN,ABN%%X4)
M:DEVICE M:X4,;
(SIZE,12),;
(ORG,BLOCK)
B *IORL
FIN
*
* O P E N L O
* OPEN THE LISTING OUTPUT FILE
*
OPENLO RES 0
M:OPEN M:LO,(OUT),(ERR,ERR%%LO),(ABN,ERR%%LO)
LI,SR1 0
DO1 SYS=BPMUTS
STW,SR1 LO%ONLINE
STW,SR1 NUM%PAGE%LINES
M:DEVICE M:LO,(CORRES,M:C)
LI,XT 1 TO BYTE 1
STB,SR1 CORRESWD,XT
M:DEVICE M:LO,(CORRES,M:DO)
STB,SR1 CORRESWD TO BYTE 0
DO SYS=BPMUTS
LW,SR1 M:LO CHECK FOR
AND,SR1 =X'F' DEVICE
CI,SR1 3 TYPE ASSIGNMENT
BNE OPENLO2 NO, SET PAGE SIZE VERY LARGE
LW,SR1 *X'4F'
BGEZ *IORL EXIT IF NOT ON-LINE
LW,SR1 M:LO+1 CHECK IF NOT OP LABEL
CI,SR1 X'8000'
BAZ *IORL EXIT IF AN OP LABEL
SLS,SR1 -8 RT JUSTIFY 'TYPE' ITEM
AND,SR1 =X'3F' TEST FOR TYPEWRITER CODE
CI,SR1 1
BE OPENLO3 TYPEWRITER
CI,SR1 X'10' TEST FOR USER CONSOLE DEVICE
BNE *IORL NO
OPENLO3 RES 0
MTW,+1 LO%ONLINE SET LO-IS-ONLINE FLAG
OPENLO2 RES 0
LI,SR1 X'7FFFF' LARGE NUMBER TO PAGE SIZE
STW,SR1 NUM%PAGE%LINES
FIN
DO SYS=RBM
LB,SR1 K:PAGE
AI,SR1 -2
STW,SR1 NUM%PAGE%LINES
FIN
B *IORL EXIT
*
* O P E N B O
* OPEN THE BINARY OUTPUT FILE
*
OPENBO RES 0
M:OPEN M:BO,(OUT),(ERR,ERR%%BO),(ABN,ERR%%BO)
M:DEVICE M:BO,(BIN)
EXIT IORL
*
* O P E N C
* OPEN THE CONTROL DEVICE
*
OPENC RES 0
M:OPEN M:C,(IN)
EXIT IORL
*
* O P E N D O
* OPEN THE DO (DIAGNOSTIC OUTPUT) FILE
*
OPENDO RES 0
M:OPEN M:DO,(OUT),(ERR,ERR%%DO),(ABN,ERR%%DO)
DO SYS=BPMUTS
LI,SR1 0
STW,SR1 DO%ONLINE
LW,SR1 M:DO
AND,SR1 =X'F'
CI,SR1 3
BNE *IORL EXIT IF NOT A DEVICE TYPE ASSIGNMENT
LW,SR1 *X'4F'
BGEZ *IORL EXIT IF NOT ON-LINE
LW,SR1 M:DO+1
CI,SR1 X'8000'
BAZ *IORL EXIT IF AN OP LABEL
SLS,SR1 -8 RIGHT JUSTIFY 'TYPE' ITEM
AND,SR1 =X'3F'
CI,SR1 1
BE OPENDO1 BRANCH IF DEVICE IS TYPEWRITER
CI,SR1 X'10'
BNE *IORL EXIT IF NOT USER CONSOLE DEVICE
OPENDO1 RES 0
MTW,1 DO%ONLINE SET DO-IS-ON-LINE FLAG
FIN
B *IORL EXIT
*
* O P E N G O
* OPEN THE GO FILE
*
OPENGO RES 0
M:OPEN M:GO,(OUT),(ERR,ERR%%GO),(ABN,ERR%%GO)
DO SYS=RBM
M:PFIL M:GO
FIN
M:DEVICE M:GO,(BIN)
B *IORL EXIT
*
* O P E N S T D
* OPEN THE F:STD FILE IN THE USER ACCOUNT
*
OPENSTD RES 0
M:OPEN F:STD,(IN)
B *IORL
*
* O P E N S T D % S Y S
* OPEN THE F:STD FILE IN THE :SYS ACCOUNT
*
DO SYS=BPMUTS
OPENSTD%SYS RES 0
M:OPEN F:STD,(FILE,'%:STDDEF',':SYS'),(IN)
B *IORL
FIN
*
* O P E N S T D O U T
* OPEN THE F:STD FILE FOR OUTPUT
*
OPENSTDOUT RES 0
M:OPEN F:STD,(OUT)
DO SYS=RBM /27493/*D-CCI
M:DEVICE F:STD,; /27493/*D-CCI
(SIZE,BYX1SIZE),; /27493/*D-CCI
(ORG,UNBLOCK) /27493/*D-CCI
FIN /27493/*D-CCI
B *IORL
*
* O P E N S I
* OPEN THE SYMBOLIC INPUT FILE
*
OPENSI RES 0
M:OPEN M:SI,(IN),(ERR,ERR%%SI),(ABN,ERR%%SI)
M:DEVICE M:SI,(CORRES,M:C)
LI,XT 2 TO BYTE 2
STB,SR1 CORRESWD,XT
B *IORL EXIT
*
* O P E N C I
* OPEN THE COMPRESSED INPUT FILE
*
OPENCI RES 0
M:OPEN M:CI,(IN),(ERR,ERR%%CI),(ABN,ERR%%CI)
B *IORL EXIT
*
* O P E N S O
* OPEN THE SYMBOLIC OUTPUT FILE
*
LOCAL %10
*
OPENSO RES 0
*
DO SYS=BPMUTS
*
* IF M:SO IS CURRENTLY ASSIGNED TO A FILE, ADJUST ITS DCB
* FOR KEYED OUTPUT.
*
LI,XT M:SO
LI,XT2 1 WANT FILE NAME
CALL FIND%VARP RETURNS PTR TO NAME IN XT1 IF FILE
CI,XT1 0
IF,NE -00- DOIF ASN=FILE
*
* MOVE THE FILE NAME INTO THE ADJUST FPT. THIS MESSING ABOUT
* SHOULD NOT BE NECESSARY WITH CP-V E00, BUT FOR NOW, M:SO
* IS SUBJECT TO FILE EXTENSION, EVEN THOUGH IT IS A KEYED
* FILE. CHANGING THE NAME (SAME NAME, BUT...) DEFEATS FILE
* EXTENSION, AND THUS THE INOUT MODE WHICH WOULD CAUSE A
* 1600 ABNORMAL (MAYBE) WHEN WE WENT TO WRITE THE KEYED
* RECORDS.
*
LI,XT2 2
LB,XT *XT1,XT2 JUST MOVE THE WORDS IN USE
STB,XT SO%ADJ%NAME,XT2
%10 RES 0
LW,XT2 *XT1,XT
STW,XT2 SO%ADJ%NAME,XT
BDR,XT %10
*
CAL1,1 SO%ADJ%FPT
LI,XT 3
STB,XT SO%KEY SET FLAG (SKELETON KEY)
FI -00-
FIN
*
M:OPEN M:SO,(OUT),(ERR,ERR%%SO),(ABN,ERR%%SO)
B *IORL EXIT
*
* O P E N C O
* OPEN THE COMPRESSED OUTPUT FILE
*
OPENCO RES 0
M:OPEN M:CO,(OUT),(ERR,ERR%%CO),(ABN,ERR%%CO)
M:DEVICE M:CO,(BIN)
LI,XT 120 STANDARD RECORD LENGTH
*
DO SYS=BPMUTS
MTH,0 CO%FLAG
IF,EQ DOIF 'SC' NOT SPECIFIED
LI,XT 108 'SHORT' BINARY RECORDS
FI
FIN
*
STW,XT CO%SIZE BYTE SIZE OF CO RECORD
EXIT IORL
IGNORE%TRAPS RES 0
M:TRAP TRAPLOC,(IGNORE,FX),(TRAP,NAO)
DO SYS=BPMUTS
M:GDDL GET DYNAMIC DATA LIMITS
STW,SR1 LOWCORE
CI,SR3 128
BLE %+2 BRANCH IF LESS THAN 128 PAGES
LI,SR3 128 USE 128 PAGES AS MAXIMUM
SLS,SR3 9 # PAGES * 512 = AMT OF CORE
AW,SR3 SR1 ADD AMT OF CORE TO LOWCORE
STW,SR3 ENDCORE
FIN
DO SYS=RBM
LW,SR1 K:BPEND MOVE LOWEST ADDRESS
AI,SR1 1 FORCE TO DOUBLEWORD BOUND /26685/*D-CCI
AND,SR1 L(EADRFLD) /26685/*D-CCI
STW,SR1 LOWCORE USABLE BY THE ASSEMBLER
LW,SR1 K:BCKEND
AI,SR1 1
SW,SR1 LOWCORE MAKE SURE THAT
CI,SR1 65536 ENDCORE IS NOT
BLE %+2 MORE THAN 65536
LI,SR1 65536 WORDS BEYOND
AW,SR1 LOWCORE LOWCORE
STW,SR1 ENDCORE
FIN
EXIT RL
PAGE
*
* F I N D % V A R P
* TESTS A DCB FOR HAVING BEEN ASSIGNED TO A FILE, AND RETURNS
* A POINTER TO THE VARIABLE PARAMETER OF INTEREST.
*
* INPUT: XT IS ADDRESS OF DCB
* XT2 IS VARIABLE PARAMETER CODE (1 = NAME, ETC.)
*
* OUTPUT: XT PRESERVED
* XT1 IS 0 IF NOT A FILE, OR IS ADDRESS OF
* VARIABLE PARAMETER CONTROL WORD.
*
* USES: R12
*
LOCAL %10
*
FIND%VARP RES 0
*
LW,XT1 0,XT WORD 0 OF DCB TO XT1
AND,XT1 L(X'F') ASN FIELD
CI,XT1 1 TEST FOR ASSIGNMENT TO FILE
IF,EQ -20-
LW,XT1 6,XT
AND,XT1 L(X'1FFFF') FLP
*
* SEARCH THE VARP LIST FOR THE DESIRED CONTROL. IF NOT
* FOUND, RETURN A 0, AS IF NOT A FILE.
*
%10 RES 0
CB,XT2 *XT1 TEST TYPE BYTE AGAINST DESIRED
EXIT,EQ GET OUT IF FOUND (XT1 IS SET)
*
* ADVANCE TO NEXT PARAMETER
*
LW,R12 0,XT1
CV,R12 X'00010000' WAS THIS THE LAST ONE?
IF,AZ -10- DOIF NOT LAST
AND,R12 L(X'FF')
AW,XT1 R12 SIZE
BIR,XT1 %10 ADVANCE TO NEXT CONTROL
*
FI -10-
FI -20-
LI,XT1 0 FAIL RETURN
EXIT
PAGE
* DATA AREA.
*
USECT XAPDATA
PATCH RES 32 ***** PATCH AREA *****
GET%NEXT%RETURN RES 1
ABORT%CODE RES 1 SAVED CODE FOR ABORT TYPE
BLANK%SWITCH RES 1 0=IGNORE BLANKS; 1=DON'T
PRINT%SWITCH RES 1
USECT CCI1
DO SYS=RBM
AC%TABLE RES 0
TEXT 'SP '
TEXT 'D1 '
TEXT 'D2 '
TEXT 'D3 '
TEXT 'D4 '
TEXT 'D5 '
TEXT 'D6 '
TEXT 'D7 '
TEXT 'D8 '
TEXT 'D9 '
TEXT 'DA '
TEXT 'DB '
TEXT 'DC '
TEXT 'DD '
TEXT 'DE '
TEXT 'DF '
AC%CODE RES 0
DATA,1 0,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20
BOUND 4
FIN
OPTION%IGNORED TEXTC 'ILLEGAL OPTION IGNORED: '
MSGS EQU %-OPTION%IGNORED
BOUND 8
DO SYS=BPMUTS
COLON%SYS RES 0
TEXT ':SYS '
FIN
USECT XAPDATA
RES ABSVAL(%)&1 BOUND 8 WITH NO ZERO'S GENERATED
BLANKS EQU %
8BLANKS EQU %
CTL%CARD%DISPLAY EQU %
RES 2
CTL%CARD EQU %
RES 20
BUF%PRINT RES 20 TEMP PRINT AREA
SAVEREGS EQU X3BUF+WDX3SIZE-16 SAVE AREA FOR REGISTERS 0-15
USECT CCI1
PAGE
*
* A P % A B O R T
* THIS ROUTINE PROCESSES ABORT CONDITIONS.
*
* INPUT: REGISTER AR CONTAINS AN ABORT NUMBER
*
* OUTPUT: AN ABORT MESSAGE IS OUTPUT ON THE 'LO' AND 'DO'
* DEVICES; ALL FILES ARE CLOSED; AND, A RETURN TO
* MONITOR IS PERFORMED VIA AN M:ERR CALL.
*
AP%ABORT RES 0
LCI 0
STM,0 SAVEREGS SAVE REGISTERS 0-15
STW,AR ABORT%CODE SAVE CODE FOR ABORT TYPE
*
DO SYS=BPMUTS
M:SETDCB M:LO,; LET MOTHER DIAGNOSE *D-CCI
(ERR,0),; *D-CCI
(ABN,0) *D-CCI
M:SETDCB M:DO,; *D-CCI
(ERR,0),; *D-CCI
(ABN,0) *D-CCI
FIN
*
DO SYS=RBM
M:CLOSE M:LO,SAVE
M:CLOSE M:DO,SAVE
M:OPEN M:LO,; LET MOTHER DIAGNOSE *D-CCI
(ERR,0),; *D-CCI
(ABN,0) *D-CCI
M:OPEN M:DO,; *D-CCI
(ERR,0),; *D-CCI
(ABN,0) *D-CCI
FIN
*
M:DEVICE M:LO,(CORRES,M:DO) CHANGE DOLOSAME TO IGNORE
STB,SR1 CORRESWD
CI,AR ABSIZE-1
BG ABORT%9 ABORT NUMBER IS OUT OF RANGE
LW,XT AR
BLZ ABORT%9 ABORT NUMBER IS OUT OF RANGE
LH,XT ABRTTBL,XT LOAD INDEX TO ABORT PROCESSOR
B ABRTBASE,XT BRANCH TO SPECIFIED ROUTINE
*
AB COM,16 AF(1)-ABRTBASE
*
ABRTTBL RES 0 TABLE OF INDEXES TO ABORT ROUTINES
AB AB%0 SYSTEM DG
AB AB%1 HILIMIT DG
AB AB%2 SCAN DG
AB AB%3 OVERFLOW NCDR
AB AB%4 RDSDF NCDR
AB AB%5 IO%ABORT ROOT
AB AB%6 TRAPLOC ROOT
AB AB%7 CANTHAVE ROOT
AB AB%8 BADTRAP ROOT
AB AB%9 AC%FND CCI
AB AB%10 BAD%SYNTAX CCI
AB AB%11 OPEN%SYS CCI
AB AB%12 SDFNOTHR CCI
AB AB%13 ERR%ABN2 CD
AB AB%14 ABNSI5 CD
AB AB%15 SYSOPNR CD
AB AB%16 2MANYSYS CD
AB AB%17 ABNX2KF CD
AB AB%18 VALIDATE CD
AB AB%19 VALID%2 CD
AB AB%20 BADCTRL CD
AB AB%21 WDOUT NCD /27493/*D-CCI
AB DELETED
AB AB%23 PRINT%ER1 CD
AB AB%24 PRINT%ER2 CD
AB AB%25 LECTURE%MAJ INIT
AB DELETED
AB AB%27 ABNSI5 INIT
ABSIZE EQU HA(%)-HA(ABRTTBL) NUMBER OF AB ENTRIES
*
BOUND 4
*
ABORT%1 RES 0
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
ABORT%2 RES 0
BAL,RL PRINT OUTPUT MESSAGE
ABORT%3 MTW,0 SYSLEVEL
BLEZ ABORT%4 NOT WITHIN A SYSTEM FILE
LI,AM BA(ABORTSYS) ADDRESS OF 'PROCESSING SYSTEM- '
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
LI,AM BA(SYSNAME) ADDRESS OF SYSTEM NAME
BAL,RL MOVE APPEND SYSNAME TO MESSAGE IN BUFFER
BAL,RL PRINT OUTPUT MESSAGE
ABORT%4 RES 0
LI,AM BA(ABORTAP) ADDRESS OF 'AP ABORT ERROR'
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
LW,RL SEGMENT#
LW,AM SEG%MSG,RL
CALL MOVE
LW,XT SEGMENT#
IF,NE -20- DOIF NOT CCI
CI,XT 4
IF,NE -21- DOIF NOT END
LI,AM BA(LINE#MSG)
CALL MOVE
LW,X3 MAJLINE
CALL DECEDIT
LW,X3 SUBLINE
IF,NE -22- DOIF NO SUB-LINE #
LI,XT '.'
STB,XT LSTBF,XT1
AI,XT1 1
CALL DECEDIT
FI -22-
FI -21-
FI -20-
BAL,RL PRINT OUTPUT MESSAGE
ABORT%5 RES 0
LI,AM BA(D%1)
BAL,RL CLR%MOVE
BAL,RL SNAPRINT PRINT A BLANK LINE
LI,AM BA(APDATA)
BAL,RL CLR%MOVE
LI,X3 XAPDATA
SLS,X3 12
LI,AM 5
BAL,RL HEXEDIT
BAL,RL SNAPRINT 'XAPDATA = XXXXX'
LI,AM BA(APD1)
BAL,RL CLR%MOVE
LI,X3 XAPD1
SLS,X3 12
LI,AM 5
BAL,RL HEXEDIT
BAL,RL SNAPRINT 'XAPD1 = XXXXX'
LI,AM BA(APOPTFLG)
BAL,RL CLR%MOVE
LI,X3 OPTION%FLAGS
SLS,X3 12
LI,AM 5
BAL,RL HEXEDIT
BAL,RL SNAPRINT 'OPTION%FLAGS = XXXXX'
LI,AM BA(APCODE)
BAL,RL CLR%MOVE
LI,X3 XAPCODE
SLS,X3 12
LI,AM 5
BAL,RL HEXEDIT
BAL,RL SNAPRINT 'XAPCODE = XXXXX'
LI,AM BA(APMODULE)
BAL,RL CLR%MOVE
LI,X3 CCI1
SLS,X3 12
LI,AM 5
BAL,RL HEXEDIT
BAL,RL SNAPRINT 'AP OVERLAY MODULE = XXXXX'
LI,AM BA(D%1)
BAL,RL CLR%MOVE
BAL,RL SNAPRINT PRINT A BLANK LINE
LI,AM BA(RO%R7)
BAL,RL CLR%MOVE
LI,X6 SAVEREGS
STW,X6 R13
BAL,R15 HEXDUMP1 DUMP REGS 0-7 IN HEX FORMAT
LI,AM BA(R8%R15)
BAL,RL CLR%MOVE
LI,X6 SAVEREGS+8
BAL,R15 HEXDUMP1 DUMP REGS 8-15 IN HEX FORMAT
LW,XT ABORT%CODE GET SAVED CODE
LB,XT1 DUMP%SW,XT
BEZ ABORT%7 BRIF MINI-DUMP REQUIRED
*
LI,AM BA(D%1)
BAL,RL CLR%MOVE
BAL,RL SNAPRINT PRINT A BLANK LINE
LI,X6 XAPDATA START ADDRESS FOR DUMP
LI,R13 ROOTRTN END ADDRESS FOR DUMP
BAL,R15 HEXDUMP DUMP MEMORY IN HEX FORMAT
LW,XT ABORT%CODE GET SAVED CODE
LB,XT1 DUMP%SW,XT GET DUMP FLAG
CI,XT1 1
BE ABORT%7 BRIF MIDI-DUMP IS REQUIRED
*
DO SYS=BPMUTS
LI,X1 -5 INDEX TO PAGETBL
LI,X2 1 # BITS REMAINING (+1) IN LAST WORD
LW,X6 LOWCORE INITIAL DUMP ADDRESS
FIND%1ST RES 0 LOOK FOR INIT. DUMP ADDRESS
CW,X6 ENDCORE
BGE ABORT%7 BRIF END-OF-CORE
*
CALL NEXT%PG
B ABORT%7 END-OF-PAGETBL EXIT
BNEZ FIND%LAST BRIF PAGE USED
*
FIND%L1 RES 0
AI,X6 512 BUMP TO NEXT CORE PAGE
B FIND%1ST
*
FIND%LAST RES 0 LOOK FOR END ADDRESS FOR DUMP
LW,R13 X6 INIT -> FINAL DUMP ADDRESS
FIND%L2 RES 0
AI,R13 512 BUMP END ADDRESS
CW,R13 ENDCORE
BGE NEXT%PRT BRIF END OF CORE
*
CALL NEXT%PG GET NEXT 'PAGE-USED' BIT
B NEXT%PRT END-OF-PAGETBL
BNEZ FIND%L2 BRIF LAST ADDR. NOT FOUND
*
NEXT%PRT RES 0
CW,R13 ENDCORE DECREASE END ADDRESS IF REQ'D
BLE %+2
LW,R13 ENDCORE
LCI 15
STM,0 SAVAREA SAVE REGS
AI,R13 -1 ADJUST LAST ADDRESS
BAL,R15 HEXDUMP
LCI 15
LM,0 SAVAREA
LW,X6 R13 LAST ADDRESS -> FIRST
B FIND%L1
*
FIN
*
DO SYS=RBM
LW,X6 LOWCORE
LW,R13 ENDCORE
AI,R13 -1
BAL,R15 HEXDUMP
FIN
*
ABORT%7 RES 0
LI,IORL 1 ABNORMAL CLOSE
BAL,RL CLOSE%FILES
LCI 0
LM,0 SAVEREGS RESTORE REGISTERS 0-15
M:ERR RETURN TO MONITOR
*
* HERE IF ABORT NUMBER IS OUT OF RANGE
ABORT%9 RES 0
DELETED RES 0
LI,AM BA(ABORT%10)
B ABORT%1
ABORT%10 TEXTC 'ABORT CALLED WITH ILLEGAL ARGUMENT'
*
SEG%MSG RES 0
DATA BA(CCI%SEG)
DATA BA(NCDR%SEG)
DATA BA(DEF%SEG)
DATA BA(GEN%SEG)
DATA BA(END%SEG)
DATA BA(CONC%SEG)
CCI%SEG TEXTC 'CONTROL CARD PROCESSOR'
NCDR%SEG TEXTC 'ENCODER'
DEF%SEG TEXTC 'ASSEMBLY PASS 1'
GEN%SEG TEXTC 'ASSEMBLY PASS 2'
END%SEG TEXTC 'END SUMMARIES'
CONC%SEG TEXTC 'CONCORDANCE'
LINE#MSG TEXTC ' PROCESSING LINE '
ABORTSYS TEXTC 'PROCESSING SYSTEM- '
ABORTAP TEXTC 'AP ABORT ERROR IN '
APDATA TEXTC 'XAPDATA = '
APD1 TEXTC 'XAPD1 = '
APOPTFLG TEXTC 'OPTION%FLAGS = '
APCODE TEXTC 'XAPCODE = '
APMODULE TEXTC 'AP OVERLAY MODULE = '
RO%R7 TEXTC ' R0-R7'
R8%R15 TEXTC ' R8-RF'
*
* DUMP SWITCHES TABLE. INDEXED BY ERROR CODE.
*
* 0=MINI DUMP. 1=MIDI DUMP. 2=MAXI DUMP.
*
DUMP%SW RES 0
DATA,1 0,2,2,2,1,1,2,2,2,0 CODES 0 THRU 9
DATA,1 0,0,0,0,0,0,1,1,1,1 CODES 10 THRU 19
DATA,1 0,1,2,1,1,1,2,0 CODES 20 THRU 27 /27493/*D-CCI
BOUND 4
PAGE
*
ABRTBASE RES 0
* HERE FOR ABORT FROM SYSTEM DIRECTIVE IN AP-DG
* XT CONTAINS BASE ADDRESS OF ENCODED TEXT AT WORD RESOLUTION
* XW POINTS TO HALFWORD PRECEEDING SYSTEM NAME
AB%0 RES 0
LW,XT SAVEREGS+XT GET BASE ADDRESS OF ENCODED TEXT
SLS,XT 2 CONVERT WORD ADDRESS TO BYTE
AI,XW 1 SKIP MULTI-INTEGER HALFWORD
SLS,XW 1 CONVERT HALFWORD OFFSET TO BYTE
AW,XW XT SAVE ADDRESS OF SYSTEM NAME
LI,AM BA(AB%00) ADDRESS OF 'UNABLE TO FIND SYSTEM-'
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
LW,AM XW ADDRESS OF SYSTEM NAME
BAL,RL MOVE APPEND NAME TO MESSAGE IN BUFFER
B ABORT%2
AB%00 TEXTC 'UNABLE TO FIND SYSTEM- '
* HERE FOR ABORT FROM HILIMIT ROUTINE IN AP-DG
AB%1 RES 0
LI,AM BA(AB%01) ADDRESS OF 'SPACE OVERFLOW'
B ABORT%1
AB%01 TEXTC 'DEF/GEN SPACE OVERFLOW'
* HERE FOR ABORT FROM SCAN ROUTINE IN AP-DG
AB%2 RES 0
LI,AM BA(AB%02) ADDRESS OF 'BAD ENCODED TEXT'
B ABORT%1
AB%02 TEXTC 'BAD ENCODED TEXT'
* HERE FOR ABORT FROM OVERFLOW IN AP-NCDR
AB%3 RES 0
LI,AM BA(AB%03) ADDRESS OF 'ENCODER SPACE OVERFLOW'
B ABORT%1
AB%03 TEXTC 'ENCODER SPACE OVERFLOW'
* HERE FOR ABORT FROM RDSDF IN AP-NCDR
AB%4 RES 0
LI,AM BA(AB%04) ADDRESS OF MESSAGE
B ABORT%1
AB%04 TEXTC 'STD DEF FILE INCOMPATIBLE'
* HERE FOR ABORT FROM IO%ABORT IN AP-ROOT
* REGISTER SR3 CONTAINS ERRORCODE (BITS 0-14) AND DCB
* ADDRESS (BITS 15-31)
AB%5 RES 0
LI,AM BA(AB%05) ADDRESS OF 'ERR OR ABN ON FILE'
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
LI,SR4 X'1FFFF' MASK FOR ADDRESS FIELD
LI,XT DCBSIZE-1 NUMBER OF DCBT ENTRIES TO SEARCH
LW,SR3 SAVEREGS+SR3 GET ERRORCODE & DCB ADDRESS
AB%%51 RES 0
CS,SR3 DCBTABLE,XT FIND DCB WHICH GAVE
BE %+2 ERROR OR ABNORMAL
BDR,XT AB%%51 RETURN
* XT CONTAINS INDEX TO DCB NAME
LW,XT DCBTABLE,XT
LB,AM XT LOAD INDEX TO DCB NAME
AI,AM BA(DCBMSG) AM NOW CONTAINS ADDRESS OF DCB NAME
BAL,RL MOVE MOVE DCB NAME TO LIST BUFFER
LI,AM BA(D%1)
BAL,RL MOVE MOVE A BLANK TO LIST BUFFER
SLD,SR3 -24 RIGHT ADJUST HIGH ORDER 8 BITS
SLS,SR4 -1 INSERT A ZERO
SLD,SR3 -8 NOW 16 BITS ARE CONTIGUOUS
LI,AM 4
LW,X3 SR4
BAL,RL HEXEDIT EDIT ERROR CODE INTO LIST BUFFER
B ABORT%2
AB%05 TEXTC 'ERR OR ABN ON FILE '
*
DCBT COM,8,24 BA(AF(1))-BA(DCBMSG),AF(2)
*
DCBTABLE RES 0
DCBT D%1,0
DCBT D%2,M:SI
DCBT D%3,M:CI
DCBT D%4,M:BO
DCBT D%5,M:CO
DCBT D%6,M:DO
DCBT D%7,M:GO
DCBT D%8,M:LO
DCBT D%9,M:SO
DCBT D%10,F:STD
DCBT D%11,F:SYS
DO SYS=RBM
DCBT D%12,M:X1
DCBT D%13,M:X2
DCBT D%14,M:X3
DCBT D%15,M:X4
DCBT D%16,M:X5
FIN
DO SYS=BPMUTS
DCBT D%12,F:X1
DCBT D%13,F:X2
DCBT D%14,F:X3
DCBT D%17,F:X2KF
DCBT D%16,F:X5
FIN
DCBSIZE EQU %-DCBTABLE NUMBER OF DCBT ENTRIES
*
DCBMSG RES 0
D%1 TEXTC ' '
D%2 TEXTC 'SI'
D%3 TEXTC 'CI'
D%4 TEXTC 'BO'
D%5 TEXTC 'CO'
D%6 TEXTC 'DO'
D%7 TEXTC 'GO'
D%8 TEXTC 'LO'
D%9 TEXTC 'SO'
D%10 TEXTC 'STD'
D%11 TEXTC 'SYS'
D%12 TEXTC 'X1'
D%13 TEXTC 'X2'
D%14 TEXTC 'X3'
D%15 TEXTC 'X4'
D%16 TEXTC 'X5'
D%17 TEXTC 'X2KF'
*
* HERE FOR ABORT FROM TRAPLOC IN AP-ROOT (RBM VERSION)
* X1 CONTAINS A POINTER TO A 19 WORD AREA CONTAINING THE
* PSD, REGS 0-15, AND THE TRAP LOCATION
AB%6 RES 0
STW,X1 MPX1 SAVE POINTER TO PSD-REG BLOCK
LI,AM BA(AB%06) ADDRESS OF MESSAGE
AB%%61 RES 0
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
LW,X3 *MPX1 GET PSW1
LI,AM 8
BAL,RL HEXEDIT HEX OF PSW1 TO LIST BUFFER
LI,AM BA(D%1)
BAL,RL MOVE MOVE A BLANK TO LIST BUFFER
LI,X1 1
LW,X3 *MPX1,X1 GET PSW2
LI,AM 8
BAL,RL HEXEDIT HEX OF PSW2 TO LIST BUFFER
BAL,RL PRINT PRINT THE LIST BUFFER
LW,X1 MPX1
LCI 0 MOVE RESIGTES 0-15
LM,0 2,X1 FROM TRAP ROUTINE'S SAVE AREA
LCI 0 TO ABORT ROUTINE'S SAVE AREA
STM,0 SAVEREGS
B ABORT%3
AB%06 TEXTC 'MONITOR TRAP, PSD = '
* HERE FOR ABORT FROM CANTHAVE IN AP-ROOT (UTS VERSION)
* MPX1 CONTAINS A POINTER TO A 19 WORD AREA CONTAINING THE
* PSD, REGS 0-15, AND THE TRAP LOCATION
AB%7 RES 0
LI,AM BA(AB%07) ADDRESS OF MESSAGE
AB%%71 RES 0
MTW,-2 MPX1 POINTER TO PSD-REG BLOCK
B AB%%61
AB%07 TEXTC 'MEMORY PROTECTION TRAP, PSD = '
* HERE FOR ABORT FROM BADTRAP IN AP-ROOT (UTS VERSION)
AB%8 RES 0
LI,AM BA(AB%08) ADDRESS OF MESSAGE
B AB%%71
AB%08 TEXTC 'BAD INSTRUCTION TRAP, PSD = '
* HERE FOR ABORT FROM AC%FND IN AP-CCI
AB%9 RES 0
LI,AM BA(AB%09) ADDRESS OF MESSAGE
B ABORT%1
AB%09 TEXTC 'TOO MANY ACCOUNT AREAS SPECIFIED'
* HERE FOR ABORT FROM BAD%SYNTAX IN AP-CCI
AB%10 RES 0
LI,AM BA(AB%010) ADDRESS OF MESSAGE
B ABORT%1
AB%010 TEXTC 'CONTROL CARD ERROR'
* HERE FOR ABORT FROM OPEN%SYS IN AP-CCI
AB%11 RES 0
LI,AM BA(AB%011) ADDRESS OF MESSAGE
B ABORT%1
AB%011 TEXTC 'NO INPUT SPECIFIED'
* HERE FOR ABORT FROM SDFNOTHR IN AP-CCI
AB%12 RES 0
LI,AM BA(AB%012) ADDRESS OF MESSAGE
B ABORT%1
AB%012 TEXTC 'STD DEF FILE DOES NOT EXIST'
* HERE FOR ABORT FROM ERR%ABN2 IN AP-CD
AB%13 RES 0
LI,AM BA(AB%013) ADDRESS OF MESSAGE
B ABORT%1
AB%013 TEXTC 'EXPECTED CI MISSING'
* HERE FOR ABORT FROM ABNSIS IN AP-CD
AB%14 RES 0
LI,AM BA(AB%014) ADDRESS OF MESSAGE
B ABORT%1
AB%014 TEXTC 'EXPECTED SI MISSING'
* HERE FOR ABORT FROM SYSOPNR IN AP-CD
AB%15 RES 0
LI,AM BA(AB%015) ADDRESS OF MESSAGE
B ABORT%1
AB%015 TEXTC 'ERR OR ABN WHEN OPENING F:SYS'
* HERE FOR ABORT FROM 2MANYSYS IN AP-CD
AB%16 RES 0
LI,AM BA(AB%016) ADDRESS OF MESSAGE
B ABORT%1
AB%016 TEXTC 'SYSTEMS NESTED TOO DEEPLY'
* HERE FOR ABORT FROM ABNX2KF IN AP-CD
AB%17 EQU AB%5
*
* HERE FOR ABORT FROM VALIDATE IN AP-CD
* X1 CONTAINS THE CONTROL WORD OF THE CURRENT COMPRESSED RECORD
* XT1 CONTAINS THE EXPECTED RECORD NUMBER
AB%18 RES 0
STH,XT1 X3 SAVE RECORD NUMBER LEFT ADJUSTED
LI,AM BA(AB%018) ADDRESS OF MESSAGE
AB%18A BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
LI,AM 4
BAL,RL HEXEDIT EDIT RECORD NUMBER INTO LIST BUFFER
BAL,RL PRINT PRINT THE LIST BUFFER
LI,AM BA(AB%018A) ADDRESS OF NEXT MESSAGE
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
BAL,RL PRINT PRINT LIST BUFFER
LI,AM BA(AB%018B) ADDRESS OF NEXT MESSAGE
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
LI,IOADD 4
LW,X3 SAVEREGS+X1 GET COMPRESSED RECORD CONTROL WORD
AB%18C RES 0
LI,AM 2 EDIT NEXT 2 DIGITS OF CONTROL WORD
BAL,RL HEXEDIT INTO LIST BUFFER
LI,AM '/'
STB,AM LSTBF,XT1 STORE A SLASH IN LIST BUFFER
AI,XT1 1 INCREMENT LIST BUFFER INDEX
BDR,IOADD AB%18C CONTINUE UNTIL CONTROL WORD EDITED
AI,XT1 -1 REMOVE LAST SLASH
B ABORT%2
AB%018 TEXTC 'SEQUENCE ERROR ON CI RECORD # '
AB%018A TEXTC 'COMPRESSED RECORD ID/SEQUENCE/CHECKSUM/BYTE COUNT'
AB%018B TEXTC ' IS '
* HERE FOR ABORT FROM VALID%2 IN AP-CD
* X1 CONTAINS THE CONTROL WORD OF THE CURRENT COMPRESSED RECORD
* X3 CONTAINS THE RECORD NUMBER+1
AB%19 RES 0
AI,X3 -1 DECREMENT RECORD NUMBER
SLS,X3 16 LEFT ADJUST RECORD NUMBER
LI,AM BA(AB%019) ADDRESS OF MESSAGE
B AB%18A
AB%019 TEXTC 'CHECKSUM ERROR ON CI RECORD # '
* HERE FOR ABORT FROM ENDFILE OR BADCTRL IN AP-CD
* X3 CONTAINS RECORD NUMBER+1
AB%20 RES 0
LI,AM BA(AB%020) ADDRESS OF MESSAGE
BAL,RL CLR%MOVE MOVE MESSAGE TO LIST BUFFER
AI,X3 -1 DECREMENT RECORD NUMBER
SLS,X3 16 LEFT ADJUST RECORD NUMBER
LI,AM 4
BAL,RL HEXEDIT EDIT RECORD NUMBER INTO LIST BUFFER
B ABORT%2
AB%020 TEXTC 'CI CODE ERROR ON RECORD # '
* /27493/*D-CCI
* HERE FROM WDOUT IN AP-NCD WHEN STATEMENT CANNOT BE ENCODED /27493/*D-CCI
* INTO A SINGLE BUFFER. /27493/*D-CCI
AB%21 RES 0 /27493/*D-CCI
LI,AM BA(AB%021) ADDRESS OF MESSAGE /27493/*D-CCI
B ABORT%1 /27493/*D-CCI
* /27493/*D-CCI
AB%021 TEXTC 'STATEMENT TOO LONG TO ENCODE' /27493/*D-CCI
*
* HERE FOR ABORT FROM PRINT%ER1 IN AP-CD
* X1 CONTAINS THE CONTROL WORD OF THE CURRENT COMPRESSED RECORD
* X3 CONTAINS THE RECORD NUMBER
AB%23 RES 0
SLS,X3 16 LEFT ADJUST RECORD NUMBER
LI,AM BA(AB%023) ADDRESS OF MESSAGE
B AB%18A
AB%023 TEXTC 'ID ERROR ON CI RECORD # '
* HERE FOR ABORT FROM PRINT%ER2 IN AP-CD
AB%24 RES 0
LI,AM BA(AB%024) ADDRESS OF MESSAGE
B ABORT%1
AB%024 TEXTC 'COMPRESSED OR BINARY RECORD FOUND IN SI FILE'
* HERE FOR ABORT FROM LECTURE%MAJ IN AP-INIT
AB%25 RES 0
LI,AM BA(AB%025) ADDRESS OF MESSAGE
B ABORT%1
AB%025 TEXTC 'UPDATE FILE IS IN COMPRESSED OR BINARY FORMAT'
*
* HERE FOR ABORT FROM ABNSI5 IN AP-INIT
AB%27 EQU AB%14
*
PAGE
*
* C L R % M O V E
* THIS ROUTINE CLEARS THE LIST BUFFER AND THEN STORES A
* CHARACTER STRING INTO IT.
*
* M O V E
* THIS IS AN ALTERNATE ENTRY POINT WHICH STORES A CHARACTER
* STRING INTO THE LIST BUFFER WITHOUT FIRST CLEARING IT.
*
* INPUT: REGISTER AM CONTAINS THE BYTE ADDRESS OF A 'TEXTC'
* CHARACTER STRING
* REGISTER XT1 CONTAINS THE FIRST CHARACTER POSITION
* IN LIST BUFFER TO STORE INTO. (INITIALIZED TO ONE
* IF CLR%MOVE IS CALLED)
*
* OUTPUT: REGISTER XT1 CONTAINS THE NEXT CHARACTER POSITION
* IN LIST BUFFER TO STORE INTO
*
* USES REGISTER
* AM
* XT
* XT1
* XT2
* IORL
*
CLR%MOVE RES 0
STW,RL IORL
BAL,RL CLRLSTBF CLEAR LIST BUFFER
LI,XT1 1 INITIALIZE LIST BUFFER INDEX
LW,RL IORL
MOVE RES 0
LB,XT2 0,AM LOAD CHARACTER COUNT
MOVE1 RES 0
AI,AM 1 INCREMENT 'FROM' ADDRESS
LB,XT 0,AM MOVE NEXT CHARACTER FROM MESSAGE TO
STB,XT LSTBF,XT1 NEXT POSITION IN LIST BUFFER
AI,XT1 1 INCREMENT 'TO' INDEX
BDR,XT2 MOVE1 CONTINUE UNTIL ALL CHARS MOVED
EXIT RL
PAGE
*
* H E X D U M P
* DUMP A SPECIFIED AREA OF MEMORY IN HEXADECIMAL FORMAT
*
* INPUT: REGISTER X6 CONTAINS THE ADDRESS OF THE FIRST
* WORD TO BE DUMPED
* REGISTER R13 CONTAINS THE ADDRESS OF THE LAST
* WORD TO BE DUMPED
*
* USES REGISTER
* X1, X2, X3, X6
*
HEXDUMP RES 0
AND,X6 =X'FFFFFFF8' TRUNCATE START & END ADDRESSES TO
AND,R13 =X'FFFFFFF8' AN 8 WORD BOUNDARY
AI,R13 7
LI,X2 ' '
NXTLOC RES 0
STH,X2 LSTBF 1ST 2 BYTES OF LIST BUFFER
LW,X3 X6 ADDRESS OF 1ST WORD OF THIS LINE
SLS,X3 12 LEFT ADJUST ADDRESS
LI,AM 5 NUMBER OF HEX DIGITS
LI,XT1 2 NEXT POSITION IN LIST BUFFER
BAL,RL HEXEDIT EDIT ADDRESS INTO LIST BUFFER
HEXDUMP1 RES 0 ENTRY POINT FOR REGISTER DUMP
LI,R14 8
NXTWORD RES 0
LI,X2 ' '
STB,X2 LSTBF,XT1 STORE A BLANK IN LIST BUFFER
AI,XT1 1 INCREMENT INDEX TO LIST BUFFER
LW,X3 0,X6 LOAD NEXT WORD TO BE CONVERTED
LI,AM 8 NUMBER OF HEX DIGITS
BAL,RL HEXEDIT EDIT WORD INTO LIST BUFFER
AI,X6 1 ADDRESS OF NEXT WORD TO CONVERT
BDR,R14 NXTWORD CONTINUE UNTIL EIGHT WORDS EDITED
BAL,RL SNAPRINT PRINT THE LIST BUFFER
CW,X6 R13 EXIT WHEN ALL WORDS
BG *R15 HAVE BEEN CONVERTED
LW,X3 X6
LI,X2 ' '
NXTCMP RES 0
LW,AM 0,X3 BRANCH IF THIS WORD DIFFERS FROM
CW,AM -8,X3 CORRESPONDING WORD OF LAST LINE
BNE NXTLOC DUMPED
AI,X3 1
CI,X3 7 CONTINUE UNTIL ALL EIGHT WORDS
BANZ NXTCMP HAVE BEEN EXAMINED
CW,X3 R13
BG NXTLOC FORCE LAST LINE OUT
STW,X3 X6
LI,X2 ' *'
B NXTCMP
PAGE
*
* D E C E D I T
* CONVERT A BINARY NUMBER TO DECIMAL DIGITS AND STORE
*
* INPUT: NUMBER IS IN X3
* XT1 HAS BYTE INDEX TO OUTPUT AREA (LSTBF)
*
DECEDIT RES 0
LI,X6 4 INDEX TO TENS TABLE
DECED1 RES 0 FIND NUMBER OF SIGNIF. DIGITS
CW,X3 TENS,X6
BGE DECED2 1ST DIGIT FOUND
*
BDR,X6 DECED1
*
DECED2 RES 0
LI,X2 0
DW,X2 TENS,X6 CONVERT AND
AI,X3 '0' STORE NEXT
STB,X3 LSTBF,XT1 DIGIT
AI,XT1 1 BUMP OUTPUT INDEX
LW,X3 X2 REMAINDER -> DIVIDEND
AI,X6 -1 BUMP TO NEXT TENS ENTRY
BGEZ DECED2 BRIF NOT DONE
*
EXIT RL
*
TENS DATA 1,10,100,1000,10000
PAGE
*
* N E X T % P G
* GET NEXT PAGETBL BIT
*
* INPUT: X2 HAS # BITS REMAINING IN CURRENT PAGETBL WORD
* X1 HAS INDEX TO CURRENT PAGETBL WORD
* X4 HAS PARTIAL PAGETBL WORD
*
* OUTPUT: X4 AND COMPARITOR HAVE NEXT PAGETBL BIT
* RETURN TO CALL+1 IF END-OF-PAGETBL; ELSE TO CALL+2
*
DO SYS=BPMUTS
NEXT%PG RES 0
BDR,X2 NXT%PG1 DEC. PG COUNT. BRIF MORE PAGES
*
BIR,X1 NXT%PG2 BUMP PAGETBL INDEX AND BRANCH
*
EXIT RL END-OF-PAGETBL EXIT
*
NXT%PG2 RES 0
LW,X5 PAGETBL+4,X1 NEXT PAGETBL WORD
LI,X2 32 PAGE COUNT FOR THIS WORD
NXT%PG1 RES 0
SLD,X4 1 NEXT PAGE-USED BIT -> X4
AND,X4 =1 SET COMPARITOR
B 1,RL NORMAL EXIT
*
FIN
PAGE
*
* H E X E D I T
* THIS ROUTINE CONVERTS A NUMBER TO HEXADECIMAL AND STORES IT
* IN THE LIST BUFFER
*
* INPUT: NUMBER OF DIGITS TO STORE IS IN REGISTER AM
* INDEX TO LEFT-MOST CHAR POSITION OF LIST BUFFER IS
* IN REGISTER XT1
* NUMBER TO CONVERT IS LEFT-ADJUSTED IN REGISTER X3
*
* OUTPUT: REGISTER AM IS ZERO
* REGISTER XT1 IS INDEX TO NEXT CHAR POSITION OF LIST
* BUFFER TO BE STORED
*
HEXEDIT RES 0
LI,X2 0 SHIFT HIGH ORDER HEX DIGIT
SLD,X2 4 TO LOW ORDER OF REGISTER X2
LB,X2 HEXTABLE,X2 CONVERT IT TO A HEX CHARACTER
STB,X2 LSTBF,XT1 AND STORE IT IN LIST BUFFER
AI,XT1 1 INCREMENT INDEX TO LIST BUFFER
BDR,AM HEXEDIT CONTINUE UNTIL ALL DIGITS CONVERTED
EXIT RL
*
HEXTABLE TEXT '0123456789ABCDEF' TABLE OF HEX CHARACTERS
PAGE
*
*
* P R I N T
* PRINT THE CONTENTS OF LIST BUFFER ON 'LO' AND 'DO' FILES
*
* INPUT: REGISTER XT1 CONTAINS THE NUMBER OF BYTES IN LIST
* BUFFER
*
* USES REGISTER
* AM, IOADD, IOSIZE, IORL.
*
PRINT RES 0
STW,RL AM
LI,IOADD LSTBF ADDRESS OF LIST BUFFER
LW,IOSIZE XT1 NUMBER OF BYTES TO OUTPUT
BAL,IORL WRITELO WRITE ON 'LO' FILE
BAL,IORL WRITEDO WRITE ON 'DO' FILE
EXIT AM
PAGE
*
* S N A P R I N T
* PRINT THE CONTENTS OF LIST BUFFER ON 'LO' AND/OR 'DO'
* IF THEY ARE NOT ASSIGNED TO A TERMINAL
*
* INPUT: REGISTER XT1 CONTAINS THE NUMBER OF BYTES IN LIST
* BUFFER
*
* USES REGISTER
* IOADD, IOSIZE, IORL
*
SNAPRINT RES 0
LI,IOADD LSTBF ADDRESS OF LIST BUFFER
LW,IOSIZE XT1 NUMBER OF BYTES TO OUTPUT
DO SYS=BPMUTS
MTW,0 LO%ONLINE BRANCH IF 'LO' IS ASSIGNED TO A
BNEZ SNAPRT1 TERMINAL
FIN
STD,X6 X2
BAL,IORL WRITELO WRITE ON 'LO'
LD,X6 X2
SNAPRT1 RES 0
DO SYS=BPMUTS
MTW,0 DO%ONLINE EXIT IF 'DO' IS ASSIGNED TO A
EXIT,NE RL TERMINAL
FIN
BAL,IORL WRITEDO WRITE ON 'DO'
EXIT RL
END