TITLE 'TELEFILE ASSEMBLY PROGRAM - APINIT'
PCC 0
SPACE 6
* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
* %%%%% MODULE NAME: APINIT %%%%%
* %%%%% 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
CAR1 RES 0
CSECT 1
CAR2 RES 0
INITD EQU CAR1 ORIGIN OF INIT DATA
INITP EQU CAR2 ORIGIN OF INIT PROCEDURE
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
*
DEF IM@INIT ENTRY POINT
DEF INITP,INITD ORIGIN OF PROCEDURE AND DATA
*
REF ABN%%X1
REF ABORT
REF ADRDCB,LINE%TYPE
REF BO%FLAG
REF BO%SIZE BINARY RECORD SIZE
REF CORRESWD
REF DC%FLAG
REF ERR%%C
REF ERR%%X1
REF LO%FLAG
REF LU%FLAG
REF PGLINES,PGNUM
REF PAGENUM
REF POSITIONX1
REF RD%STD
REF REWX1
REF ND%FLAG
REF TITLEBUF
REF BLANC
REF M:SI
REF UPDT%ERROR
REF ROOTRTN
REF SEGMENT# AP OVERLAY SEGMENT
REF SU%FLAG
REF WRITEDO,WRITELO
*
REF M:C
REF M:DO
REF M:LO
*
DO SYS=RBM
REF M:X1
F:X1 EQU M:X1
REF M:X2
F:X2 EQU M:X2
REF M:X4
F:X2KF EQU M:X4
FIN
*
DO SYS=BPMUTS
REF F:X1
REF F:X2,F:X2KF
REF REPORT%STATUS
FIN
REF NIVO,FINMAJ
REF LOWCORE
REF ERR%%SI
REF SAVAREA
REF EODCNT,EODCNTCI
REF ROOTEXIT
REF BA%FLAG
REF ABN%%X2,ERR%%X2,ABN%%X4,ERR%%X4
*
* REGISTERS USED TO CONTROL THE SORTING OF PLUS CARDS IN CORE
*
PTR1 EQU 1 POINTER TO LOWEST KEY
PTR2 EQU 2 POINTER TO HIGHEST KEY
DEP EQU 3 PASS1/PASS2 ADDRESS
PTDEB EQU 10 INITIAL VALUE OF PTR1
PTFIN EQU 11 FINAL VALUE OF PTR1
FLAG EQU 15 RECORD-INVERTED FLAG
*
PAS EQU 4 NO. WORDS IN A '+' CARD RECORD
X EQU 1 PRIMARY INDEX REGISTER
X1 EQU 2 SECONDARY INDEX REGISTER
PT EQU 3 POINTER FOR NEXT '+' CARD RECORD
I EQU 4
NB EQU 5
K EQU 6
J EQU 7
R EQU 8
R1 EQU 9
R8 EQU 8
IOADD EQU 8
IOSIZE EQU 9
IORL EQU 10
VAL1 EQU 10
VAL EQU 11
LNKR EQU 12
RETRO EQU 13
RETOUR EQU 14
RETURN EQU 15
T1 EQU 8 TEMP - EVEN
XT EQU 4 TEMP - EVEN
XT1 EQU 5 TEMP - ODD
*
ZERO EQU 0
UN EQU 1
DEUX EQU 2
TROIS EQU 3
QUATRE EQU 4
SEPT EQU 7
HUIT EQU 8
DIX EQU 10
*
SR1 EQU 8
SR2 EQU 9
SR3 EQU 10
*
USECT CAR1
PATCH RES 32 ***** PATCH AREA *****
BOUND 8
INDICNOTE RES 2
ZONECI RES 4
BUFSI RES 20
MAXSI EQU 80 MAX BYTES IN SI
DO1 SYS=BPMUTS
RES 10
BUFSIEND EQU BUFSI+(MAXSI/4)
SYS%REGS RES 4
ADRTRI RES 1
LEC%TEMP RES 1 TEMP IN LECTURE%MAJ
PRINT%FLAG RES 1 0=UPDATE RECORD WAS PRINTED
SAVE%I RES 1
RES%LINE%COUNT RES 1 X2 FILE RECORD NUMBER
LAST%UPDATE RES 1
NEXT%UPDATE RES 1
UPDATE%LINE%COUNT RES 1
BUF%PRINT RES 30 TEMP PRINT AREA
*
* EQUATES FOR THE ABORT PROC
*
AR EQU 0 ABORT REGISTER
ABORT25 EQU 25
ABORT27 EQU 27
*
CR EQU X'0D' CARRIAGE RETURN
LF EQU X'15' LINE FEED
TAB EQU 5 EBCDIC FOR 'TAB' CHAR
PAGE
USECT CAR2
BOUND 8
FIVE%SIX DATA 5,6 EOF-EOT CODES
LIMITE%NUMERIQUE EQU %
DATA '0'
DATA '9'
ER3 TEXTC 'OVERLAPPING SEQUENCE NUMBERS. ',;
'LAST UPDATE GROUP IS IGNORED'
ER4 TEXTC 'ILLEGAL UPDATE SYNTAX'
ER5 TEXTC 'ILLEGAL UPDATE SEQUENCE'
CNERR1 TEXTC ' ** NO ''.'' IN COL 1 - CN SCAN TERMINATED'
DATA%DIX DATA 10
PAGE
*
*
*
IM@INIT RES 0
STW,10 ROOTRTN SAVE RETURN ADDRESS
LI,R 1
STW,R SEGMENT#
*
DO SYS=BPMUTS
M:INT REPORT%STATUS SET BREAK RECEIVER ADDRESS
FIN
*
LI,R 0
STW,R INDICNOTE
STW,R INDICNOTE+1
STW,R NIVO SYSTEM LEVEL INDICATOR
STW,R FINMAJ 1=FINISHED WITH UPDATES
STW,R UPDATE%LINE%COUNT
STW,R UPDT%ERROR NO. OF '+' CARD ERRORS
STW,R RES%LINE%COUNT
STW,R PGLINES CLEAR NUMBER OF LINES PER PAGE
STW,R PAGENUM
STW,R RD%STD SET RD%STD
STW,R EODCNT EOD COUNT FOR SI
STW,R EODCNTCI EOD COUNT FOR CI
STW,R LAST%UPDATE
STW,R SAVE%I FLAG FOR SKIPPING UPDATES
LW,R ND%FLAG ON IF
BNEZ %+2 F:STD IS
MTW,+1 RD%STD REQUIRED
LW,R BLANC
STW,R PGNUM BLANK PAGE NUMBER IN TITLE BUFFER
* SET THE VARIABLE PART OF THE TITLE BUFFER TO BLANKS
LI,X1 18
STW,R TITLEBUF+5,X1
BDR,X1 %-1
M:TIME TITLEBUF+2
*
* INITIALIZE BINARY RECORD SIZE
*
LI,XT S:S(SYS=BPMUTS,120,108) BINARY RECORD SIZE
MTH,0 BO%FLAG
IF,NZ DOIF 'SB' SPECIFIED
LI,XT 120 STANDARD RECORD LENGTH
FI
STW,XT BO%SIZE
*
* CHECK FOR UPDATES
*
LW,R LINE%TYPE IS THERE
CI,R 3 AN UPDATE PACKET
BNE EXITINIT NO. EXIT
LI,R M:SI
STW,R ADRDCB
M:REW F:X2
M:REW F:X2KF
PAGE
*
*
* READ UPDATE CONTROL CARDS, WRITE THEM ON F:X2, LIST THEM IF LU WAS RE
* BUILD CONTROL RECORDS & WRITE THEM ON F:X2KF.
LI,R -UN
STW,R INDICNOTE
STW,R INDICNOTE+UN
LW,NB LOWCORE
* INITIALIZE 'ADRTRI' AND ADRMAX'.
STW,NB PT
STW,NB ADRTRI
* BUILD 1ST POINTER AND INITIALIZE INDEX REGISTERS.
AI,PT UN
STW,PT *ADRTRI
LI,I ZERO
LI,J DEUX
LI,K UN
STW,I *ADRTRI,K PRESET UPDATE NUMBERS
STH,K *ADRTRI,J IN CASE THE
* FIRST UPDATE CARD IS '+END'
*
* IF CN CONTROL CARDS ARE IN THE WAY, BUFFER THEM OUT TO X1
*
MTH,0 DC%FLAG
IF,NZ 'CN' SPECIFIED
LW,RETOUR CORRESWD
CV,RETOUR X'0000FF00'
IF,ANZ SI & C ARE THE SAME DEVICE
BAL,RETOUR COPY%CN
FI
FI
BAL,RETOUR LECTURE%MAJ
BY%FIRST RES 0
*
* EXAMINE 1ST CHAR OF 'BUFSI' TO DETERMINE IF IT IS AN UPDATE CONTROL C
LB,R BUFSI
CI,R X'4E'
BE APPEL%CONVERT
LI,VAL UN
STH,VAL *ADRTRI,J
LI,VAL ZERO
AI,J UN
STH,VAL *ADRTRI,J
B NOTE%F:X2
APPEL%CONVERT EQU %
LI,X1 ZERO
BAL,RETOUR CONVERT%DEC%CONSTANT
CI,X1 UN
BE UPDATE%SYNTAX%ERROR
CI,R X'6B' CARACTERE SUIVANT=VIRGULE?
BE TEST%VAL
CI,R X'40' CARACTERE SUIVANT=BLANC?
IF,NE -20- NOT COMMA OR BLANK
CI,R TAB
BNE UPDATE%SYNTAX%ERROR
*
FI -20-
MTW,+0 SU%FLAG CHECK SEQUENCE IF SU OPTION
BEZ STH%VAL11 IS REQUESTED
CW,VAL LAST%UPDATE
BGE STH%VAL11 SEQUENCE IS OKAY
BAL,RETRO SEQNCERR REPORT A SEQUENCE ERROR
STH%VAL11 RES 0
* STORE 1ST HALF-WORD INTO TABLE OF CONTROL RECORDS.
STW,VAL LAST%UPDATE
AI,VAL 1
STH,VAL *ADRTRI,J
LI,VAL ZERO
B J%PLUS%UN
* SYNTAX-CHECK UPDATE CONTROL CARDS & STORE 2ND
* HALF-WORD INTO TABLE OF CONTROL RECORDS.
TEST%VAL EQU %
LW,VAL1 VAL
BEZ UPDATE%SYNTAX%ERROR
MTW,+0 SU%FLAG CHECK SEQUENCE IF SU OPTION
BEZ TEST%VAL1 IS REQUESTED
CW,VAL1 LAST%UPDATE
BG TEST%VAL1 OKAY
BAL,RETRO SEQNCERR REPORT A SEQUENCE ERROR
TEST%VAL1 RES 0
BAL,RETOUR CONVERT%DEC%CONSTANT
CI,R X'40' OCTET SUIVANT=BLANC?
IF,NE -40- NOT BLANK
CI,R TAB
BNE UPDATE%SYNTAX%ERROR
*
FI -40-
CW,VAL1 VAL
BLE STH%VAL1
AI,X1 -UN
B UPDATE%SYNTAX%ERROR
STH%VAL1 EQU %
STH,VAL1 *ADRTRI,J
STW,VAL LAST%UPDATE
J%PLUS%UN EQU %
AI,J UN
STH,VAL *ADRTRI,J
BAL,RETRO PRINT%UPDATE1
BAL,RETOUR LECTURE%MAJ
*
* DETERMINE IF 'BUFSI' CONTAINS AN UPDATE CONTROL CARD.
LB,R BUFSI
CI,R X'4E' 1ER CARACTERE=+?
BNE NOTE%F:X2
* STORE INDEX BLOCK INTO TABLE.
LW,R UPDATE%LINE%COUNT
STH,R INDICNOTE
LD,R INDICNOTE
STD,R *ADRTRI,K
B ZERO%SUR%INDICNOTE
NOTE%F:X2 EQU %
MTW,+1 INDICNOTE+1
LW,R RES%LINE%COUNT
STW,R INDICNOTE
LW,R UPDATE%LINE%COUNT
STH,R INDICNOTE
LD,R INDICNOTE
STD,R *ADRTRI,K
*
* READ UPDATE CARDS, WRITE THEM ON F:X2, & LIST THEM.
ECRIRE%X2 EQU %
BAL,RETRO PRINT%UPDATE1
BAL,RETOUR WRITE%X2
BAL,RETOUR LECTURE%MAJ
LB,R BUFSI
CI,R X'4E' 1ER OCTET=+?
BNE ECRIRE%X2
BAL,RETOUR WRITE%X2
ZERO%SUR%INDICNOTE EQU %
LI,R -UN
STW,R INDICNOTE
STW,R INDICNOTE+UN
BAL,RETRO AVINDEX
B APPEL%CONVERT
*
* MOVE%MSG ROUTINE
* MOVE A TEXTC MESSAGE TO THE BUF%PRINT AREA
*
MOVE%MSG RES 0
BAL,RETOUR SP%BLANC
LB,X *NB GET BYTE COUNT OF THE MESSAGE
MV%1 LB,R *NB,X MOVE NEXT BYTE
STB,R BUF%PRINT,X TO BUF%PRINT
BDR,X MV%1 COUNT & RETURN
BAL,RETOUR ERR%PRINT OUTPUT ON 'DO' & 'LO', IF REQ'D
B *RETRO EXIT
*
* SEQNCERR ROUTINE
* PRINT A SEQUENCE ERROR MESSAGE
*
SEQNCERR RES 0
MTW,+1 UPDT%ERROR
LCI +15 SAVE REGISTERS
STM,1 SAVAREA
BAL,RETRO SP%PRINT PRINT THE '+' CARD
MTW,-1 UPDATE%LINE%COUNT 1 WILL BE ADDED BY PRINT%UPDATE1
LI,NB ER5 ADDRESS OF ERROR MESSAGE
BAL,RETRO MOVE%MSG PRINT THE MESSAGE
LCI +15 RESTORE REGISTERS
LM,1 SAVAREA
B *RETRO
PAGE
*
*
* INCREMENT INDEX REGS I,J,K
AVINDEX EQU %
AI,PT QUATRE
AI,I QUATRE
STW,PT *ADRTRI,I
AI,J SEPT
AI,K DEUX
B *RETRO
*
PAGE
*
* HERE MEANS 'COPY%UPDATE%PACKET' HAS FINISHED READING F:SI.
*
FIN1%UPDATE EQU %
LD,R INDICNOTE
AND,R R1
CI,R -UN
BNE ECRIT%CARTE%END
LW,R RES%LINE%COUNT
LW,X UPDATE%LINE%COUNT
STH,X R
STD,R *ADRTRI,K
B TRI
ECRIT%CARTE%END EQU %
LI,R '+E' WRITE EOF
STH,R BUFSI SENTINEL.
BAL,RETOUR WRITE%X2
*
* SORT CONTROL RECORDS USING 1ST HALF-WORD AS KEY.
TRI EQU %
LI,PTDEB ZERO
LW,PTFIN I
STW,I SAVE%I SAUVE I POUR FIN ECRIT X2KF
* 1ST PASS IS FORWARD THRU CONTROL RECORDS.
* PUT CONTROL RECORD WITH HIGHEST KEY AT END OF TABLE.
LI,DEP CROISSANT
PASSE RES 0
CW,PTDEB PTFIN
BGE FIN%TRI
B %UN,DEP
UNSUITE EQU %
LI,FLAG ZERO
LW,I *ADRTRI,PTR1
LW,R *I
%BOUCLE RES 0
LW,J *ADRTRI,PTR2
CW,R *J
B %TROIS,DEP
* THE COMPARED RECORDS ARE IN SEQUENCE.
TROIS%SUITE EQU %
STW,I *ADRTRI,PTR1
LW,I J
LW,R *J
B %QUATRE,DEP
* THE COMPARED RECORDS ARE NOT IN SEQUENCE.
INVERS STW,J *ADRTRI,PTR1
LI,FLAG UN
B %QUATRE,DEP
CROISSANT RES 0
%UN EQU %-CROISSANT
LW,PTR1 PTDEB
LW,PTR2 PTR1
AI,PTR2 PAS
B UNSUITE
%TROIS EQU %-CROISSANT
BG INVERS
B TROIS%SUITE
%QUATRE EQU %-CROISSANT
AI,PTR1 PAS
AI,PTR2 PAS
CW,PTR1 PTFIN
BL %BOUCLE
* END OF FORWARD PASS. STORE POINTER OF LARGEST KEY.
* IF (FLAG) = ZERO, SORT IS FINISHED.
STW,I *ADRTRI,PTR1
CI,FLAG ZERO
BE FIN%TRI
* THE NEXT PASS GOES BACKWARD THRU THE TABLE.
AI,PTFIN -PAS
LI,DEP DECROIS
B PASSE
*
DECROIS RES ZERO
* %UN FOR BACKWARD PASS.
LW,PTR1 PTFIN
LW,PTR2 PTR1
AI,PTR2 -PAS
B UNSUITE
* %TROIS FOR BACKWARD PASS.
BL INVERS
B TROIS%SUITE
* %QUATRE FOR BACKWARD PASS.
AI,PTR1 -PAS
AI,PTR2 -PAS
CW,PTR1 PTDEB
BG %BOUCLE
* END OF BACKWARD PASS.
STW,I *ADRTRI,PTR1
CI,FLAG ZERO
BE FIN%TRI
* THE NEXT PASS IS FORWARD.
AI,PTDEB PAS
LI,DEP CROISSANT
B PASSE
*
* WRITE SORTED CONTROL RECORDS ON M:X4 (OR F:X2KF)
*
FIN%TRI RES 0
LI,PTR1 0
LI,DEP 1
LI,PTR2 4
FIN%T1 RES 0
LW,I *ADRTRI,PTR1 GET ADDRESS OF 1ST CONTROL RECORD
LCI +3 MOVE RECORD
LM,R *I TO
STM,R ZONECI PRINT AREA
CW,PTR2 SAVE%I TEST FOR LAST CONTROL RECORD
BLE FIN%T2 NO.
BAL,RETRO WRITEX4 WRITE THE LAST CONTROL RECORD
DO SYS=RBM
M:WEOF F:X2KF
FIN
*
M:REW F:X2KF
M:WEOF F:X2
M:REW F:X2
EXITINIT RES 0
LI,R 0
STW,R PGLINES
B *ROOTRTN RETURN TO THE ROOT
FIN%T2 RES 0
LW,J *ADRTRI,PTR2 ADDRESS OF NEXT CONTROL RECORD
MTH,0 ZONECI,DEP WAS 'K' PRESENT ON THE PLUS CARD
BNEZ FIN%T3 BRANCH IF YES
LW,R *J COMPARE J AND K
CW,R ZONECI
B FIN%T4
FIN%T3 RES 0
LH,R *J COMPARE K(2) WITH J(1)
CH,R ZONECI,DEP
FIN%T4 RES 0
BG FIN%T5 BRANCH IF OKAY
BAL,RETRO OVERLAP%ERR
B FIN%T6
FIN%T5 RES 0
BAL,RETRO WRITEX4 WRITE THIS CONTROL RECORD
FIN%T6 RES 0
AI,PTR1 4 BUMP POINTER ONE
AI,PTR2 4 BUMP POINTER TWO
B FIN%T1
*
* WRITE A 12-BYTE CONTROL RECORD ON M:X4 (OR F:X2KF)
* THE RECORD IS IN ZONECI
WRITEX4 RES 0
*
M:WRITE F:X2KF,(BUF,ZONECI),(SIZE,12),(WAIT),;
(ABN,ABN%%X4),(ERR,ERR%%X4)
B *RETRO
*
WRITE%X2 EQU %
*
M:WRITE F:X2,(BUF,BUFSI),(SIZE,80),(WAIT),;
(ABN,ABN%%X2),(ERR,ERR%%X2)
MTW,+1 RES%LINE%COUNT
B *RETOUR
*
LECTURE%MAJ EQU %
* CHECK LENGTH OF INPUT RECORD.
M:READ M:SI,(BUF,BUFSI),(SIZE,120-40*(SYS=RBM)),;
(ERR,ERR%%SI),(ABN,ABN%%SI)
LECT%MAJ%1 RES 0
MTW,+1 PRINT%FLAG SET FLAG TO 'LINE-NOT-PRINTED'
LB,1 BUFSI
AND,1 =X'DB' TEST FOR A BINARY
CI,1 X'18' OR COMPRESSED
BNE LECT%MAJ%2 RECORD
ABORT ABORT25 UPDATE FILE IN COMPRESSED FORMAT
LECT%MAJ%2 RES 0
LI,1 8 GET
LH,1 *ADRDCB,1 RECORD
SLS,1 -1 LENGTH
AI,1 -MAXSI
BGEZ CHECK%FOR%PLUS%END
LI,R1 X'40' BLANK
AI,1 -1 LAST
LB,R BUFSIEND,1 CHARACTER.
CI,R X'15' IS IT LF?
BE ZAP%LF%CR BRANCH IF YES.
CI,R X'0D' IS IT CR?
BNE SUITE%ZAP BRANCH IF NO.
ZAP%LF%CR EQU %
STB,R1 BUFSIEND,1 CR WITH BLANK
SUITE%ZAP EQU %
BIR,1 ZAP%LF%CR BLANK BALANCE OF RECORD
CHECK%FOR%PLUS%END EQU %
LW,R BUFSI IS CARD A
CW,R ='+END' '+END'?
BNE CK%PLUS%AST
BAL,RETRO PRINT%UPDATE1
B FIN1%UPDATE
CK%PLUS%AST RES 0
SLS,R -16
CI,R '+*' TEST FOR AN UPDATE COMMENT
BNE *RETOUR NO. EXIT
STW,RETOUR LEC%TEMP SAVE RETURN ADDRESS
BAL,RETRO PRINT%UPDATE1
LW,RETOUR LEC%TEMP RESTORE RETURN ADDRESS
B LECTURE%MAJ
ABN%%SI RES 0
LB,X SR3
CI,X 6 TEST FOR EOF
BE ABNSI5 YES
CI,X 5 TEST FOR EOD
BNE ERR%%SI NO. IT'S AN ERROR
MTW,+0 EODCNT FIRST EOD
BNEZ ABNSI5 NO
MTW,+1 EODCNT BUMP EOD COUNT
B LECTURE%MAJ GO RE-READ
ABNSI5 RES 0
MTW,+0 UPDATE%LINE%COUNT TEST FOR FIRST READ
BNEZ ABNSI10 NOT FIRST
MTW,+0 BA%FLAG BATCH ASSEMBLIES
BNEZ ROOTEXIT YES. NORMAL TERMINATION
ABORT ABORT27 EXPECTED SI MISSING
ABNSI10 RES 0
LI,1 -ENDMSIZE - SIZE OF 'END' MESSAGE
LW,SR3 ENDMSG+ENDMSIZE,1 MOVE THE 'END' MESSAGE
STW,SR3 BUFSI+ENDMSIZE,1 TO BUFSI
BIR,1 %-2
LI,1 ENDMSIZE*4-80 - BYTES REMAINING IN BUFSI
LI,R1 X'40'
B ZAP%LF%CR
ENDMSG TEXT '+END -- SUPPLIED AS THE RESULT OF AN <EOD>'
ENDMSIZE EQU %-ENDMSG
PAGE
* CONVERT TO BINARY THE LINE NUMBERS FROM UPDATE CONTROL
* CARDS (RESULT IN 'VAL' REG) & LEAVE THE FOLLOWING
* CHARACTER IN REG 'R'.
CONVERT%DEC%CONSTANT EQU %
LI,VAL ZERO
OCTET%SUIVANT EQU %
AI,X1 UN
LB,R BUFSI,X1
CLM,R LIMITE%NUMERIQUE
BCS,9 *RETOUR RETOUR SI OCTET NON NUMERIQUE
MI,VAL DIX
AI,R -240
AW,VAL R
B OCTET%SUIVANT
*
* CONVERT AN UPDATE LINE NUMBER
* TO EBCDIC & PUT IT IN THE OUTPUT BUFFER 'BUF%PRINT'.
CONVERT%BIN%DEC EQU %
LI,X HUIT
CONVERT%ERROR RES 0
AI,X -UN
LI,VAL1 ZERO
DW,VAL1 DATA%DIX
AI,VAL1 X'F0'
STB,VAL1 BUF%PRINT,X
CI,VAL 0
BNEZ CONVERT%ERROR
B *RETOUR
PAGE
PRINT%UPDATE1 EQU %
LW,R LU%FLAG
BNEZ SP%PRINT
MTW,+1 UPDATE%LINE%COUNT
B *RETRO
*
* ROUTINE UPDATE%SYNTAX%ERROR
*
UPDATE%SYNTAX%ERROR EQU %
MTW,+1 UPDT%ERROR
LCI +15
STM,1 SAVAREA SAVE REGS
MTW,+1 SAVE%I SET 'SKIP' FLAG
BAL,RETRO SP%PRINT
BAL,RETOUR SP%BLANC
* (RESTORE X1 CONTENTS.)
LW,X1 SAVAREA+X1-1
AI,X1 36
* PRINT A COLON UNDER THE CHARACTER IN ERROR.
LI,R X'7A' CARACTERE ':'
STB,R BUF%PRINT,X1
BAL,RETOUR ERR%PRINT OUTPUT ON 'DO' & 'LO', IF REQ'D
LI,NB ER4 ADDRESS OF ERROR MESSAGE
BAL,RETRO MOVE%MSG PRINT THE MESSAGE
B SYN%2
SYN%1 RES 0
BAL,RETRO SP%PRINT
SYN%2 RES 0
BAL,RETOUR LECTURE%MAJ FIND THE NEXT '+' CARD
LB,R BUFSI
CI,R '+'
BNE SYN%1
MTW,-1 SAVE%I RESET 'SKIP' FLAG
LCI +15
LM,1 SAVAREA
B APPEL%CONVERT
*
*
* PRINT THE UPDATE CARD IN ERROR.
*
SP%PRINT EQU %
STW,RETRO ZONECI
MTW,+1 UPDATE%LINE%COUNT
LI,R 0
XW,R PRINT%FLAG SET TO 'LINE-PRINTED'
BEZ *ZONECI
BAL,RETOUR SP%BLANC
LW,VAL UPDATE%LINE%COUNT
BAL,RETOUR CONVERT%BIN%DEC
LI,X -20
SP%PRINT1 RES 0
LW,R BUFSIEND,X
STW,R BUF%PRINT+29,X
BIR,X SP%PRINT1
DO SYS=BPMUTS
*
* INSERT THE KEY IF SI IS FROM A KEYED FILE
*
LW,X M:SI+5 FILE ORGANIZATION
AND,X =X'F0'
CI,X X'20' TEST FOR ORG=KEYED
BNE SP%PRINT4 NO
LW,VAL *M:SI+10 GET 3-BYTE KEY
AND,VAL =X'FFFFFF' CLEAN IT
LI,X 33 RIGHT-MOST COLUMN FOR KEY
SP%PRINT5 RES 0
LI,VAL1 0
DW,VAL1 DATA%DIX CONVERT NEXT DIGIT
AI,VAL1 X'F0'
SP%PRINT6 RES 0
STB,VAL1 BUF%PRINT,X
AI,X -1
LI,VAL1 '.'
CI,X 30 IS THIS THE COLUMN FOR DEC. PT.
BE SP%PRINT6 YES
BG SP%PRINT5 NOT YET
CI,VAL 0 TERMINATE AFTER LAST DIGIT
BNE SP%PRINT5 MORE DIGITS
SP%PRINT4 RES 0
FIN
MTW,0 SAVE%I
BEZ SP%PRINT2
LI,X -4
SP%PRINT3 RES 0
LW,R IGNORE+4,X MOVE IGNORED MESSAGE TO BUF%PRINT
STW,R BUF%PRINT+6,X
BIR,X SP%PRINT3
BAL,RETOUR ERR%PRINT OUTPUT ON 'DO' & 'LO', IF REQ'D
B *ZONECI
SP%PRINT2 RES 0
BAL,RETOUR PRINT
B *ZONECI EXIT
IGNORE TEXT ' *** IGNORED ***'
PAGE
SP%OVERLAP EQU %
BAL,RETOUR SP%BLANC
LH,VAL ZONECI
LI,X UN
LH,VAL1 ZONECI,X
LH,R ZONECI+UN
STW,R RES%LINE%COUNT
CI,VAL1 ZERO
BNE CARTE%2
* RE-BUILD +J-TYPE CONTROL CARDS.
STW,VAL LAST%UPDATE
BAL,LNKR CARTE%J
B *RETURN
CARTE%2 EQU %
STW,VAL NEXT%UPDATE
STW,VAL1 LAST%UPDATE
BAL,LNKR CARTE%JK
B *RETURN
*
* RE-BUILD AND PRINT +J,K-TYPE CONTROL CARDS.
CARTE%JK EQU %
LI,X 50
LW,VAL LAST%UPDATE
BAL,RETOUR CONVERT%ERROR
LI,R X'6B' 'VIRGULE'
AI,X -UN
STB,R BUF%PRINT,X
LW,VAL NEXT%UPDATE
SUITE%ERROR EQU %
BAL,RETOUR CONVERT%ERROR
LI,R X'4E' CARACTERE 'PLUS'
AI,X -UN
STB,R BUF%PRINT,X
* CONVERT CARD NUMBER.
LW,VAL RES%LINE%COUNT
BAL,RETOUR CONVERT%BIN%DEC
BAL,RETOUR ERR%PRINT OUTPUT ON 'DO' & 'LO', IF REQ'D
B *LNKR
*
* RE-BUILD +J CARD.
CARTE%J EQU %
MTW,-UN LAST%UPDATE
LW,VAL LAST%UPDATE
LI,X 50
B SUITE%ERROR
*
PAGE
OVERLAP%ERR RES 0
MTW,+1 UPDT%ERROR
LCI +15
STM,1 SAVAREA
CW,I J SET TO IGNORE THE SECOND
BG OVRLAP1 UPDATE RECORD
STW,I *ADRTRI,PTR2 REPLACE ADDRESS POINTER
XW,I J
OVRLAP1 RES 0
LCI TROIS
LM,R *J
STM,R ZONECI
BAL,RETURN SP%OVERLAP
LCI TROIS
LM,R *I
STM,R ZONECI
BAL,RETURN SP%OVERLAP
LI,NB ER3 ADDRESS OF ERROR MESSAGE
BAL,RETRO MOVE%MSG PRINT THE MESSAGE
LCI +15
LM,1 SAVAREA
B *RETRO
*
* OUTPUT AN ERROR LINE ON 'DO', AND ON 'LO' IF REQUIRED
*
ERR%PRINT RES 0
LI,IOADD BUF%PRINT
LI,IOSIZE 120
BAL,IORL WRITEDO
LW,R LO%FLAG OUTPUT ON 'LO' IF EITHER
OR,R LU%FLAG LU OR LO IS REQUESTED
BEZ *RETOUR
*
* PRINT THE LINE ON 'LO'
*
PRINT EQU %
LCI +4
STM,I SYS%REGS
LI,IOADD BUF%PRINT
LI,IOSIZE 120
BAL,IORL WRITELO
LCI +4
LM,I SYS%REGS
B *RETOUR
*
* CLEAR 'BUF%PRINT' TO BLANKS.
SP%BLANC EQU %
LW,R BLANC
LI,X 30
STW,R BUF%PRINT-UN,X
BDR,X %-UN
B *RETOUR
PAGE
*
* C O P Y % C N
* COPY CN CONTROLS FROM M:C, WRITING THEM TO LO & X1.
*
LOCAL %10,%20,%30,%40
*
COPY%CN RES 0
LCI 15
STM,1 SAVAREA SAVE REGISTERS 1 - 15
LI,XT 2
STH,XT DC%FLAG TELL ENCODER TO READ X1, NOT C
*
DO SYS=RBM
M:DEVICE F:X1,; CHANGE TEMPORARILY TO NEW FORMAT
(SIZE,80),;
(ORG,BLOCK)
FIN
*
M:REW F:X1
%10 RES 0
M:READ M:C,; NEXT CN CONTROL
(ERR,ERR%%C),;
(ABN,ABN%%C),;
(BUF,BUFSI),;
(SIZE,120-40*(SYS=RBM)),;
(WAIT)
*
* FILL RECORD WITH BLANKS, STRIPPING OFF A POSSIBLE
* TRAILING CR OR LF.
*
LI,XT 8
LH,XT M:C,XT
SLS,XT -1 ARS
AI,XT -MAXSI
IF,L DOIF PADDING NEEDED
LI,T1 ' ' FILL CHARACTER
AI,XT -1
LB,XT1 BUFSIEND,XT
IF,NE LF,XT1
CV,XT1 CR
BNE %30 SKIP INITIAL REPLACEMENT
*
FI
%20 RES 0
STB,T1 BUFSIEND,XT
%30 RES 0
BIR,XT %20
*
FI
* NOW LOG THE RECORD READ, UNLESS WE WOULD BE ECHOING
* IT BACK TO THE SAME DEVICE THAT IT CAME FROM.
*
LI,XT 1
MTB,0 CORRESWD,XT TEST LO=C FLAG
IF,EZ
LCI 10
LM,1 BUFSI
STM,1 BUF%PRINT+1
LM,1 BUFSI+10
STM,1 BUF%PRINT+11
LW,XT BLANC
STW,XT BUF%PRINT
LI,IOADD BUF%PRINT
LI,IOSIZE 84
BAL,IORL WRITELO
FI
%40 RES 0
M:WRITE F:X1,; AND SAVE IT
(ERR,ERR%%X1),;
(ABN,ABN%%X1),;
(BUF,BUFSI),;
(SIZE,80),;
(WAIT)
LB,XT BUFSI
CV,XT '.' CHECK FOR CN CONTROL COMMAND
IF,EQ
LW,XT BUFSI
CV,XT '.END'
BNE %10 WAS '.' COMMAND, BUT NOT END
*
ELS
LI,NB CNERR1
BAL,RETRO MOVE%MSG DIAGNOSE
LI,IOSIZE -1
BAL,IORL POSITIONX1 BACK UP OVER BAD RECORD
LV,XT '.END' FAKE GOOD END
STW,XT BUFSI
LV,XT ' '
STW,XT BUFSI+1
B %40
*
FI
BAL,IORL REWX1
LCI 15
LM,1 SAVAREA RESTORE REGS
EXIT RETOUR
*
* A B N % % C
*
ABN%%C RES 0
LB,XT SR3
CLM,XT FIVE%SIX CHECK FOR EOF OR EOT ON C
BOL ERR%%C OTHER ERROR - STD. HANDLING
*
BAL,IORL REWX1
LCI 15
LM,1 SAVAREA RESTORE REGS
EXIT RETOUR
*
END