CONSUB
* /--- FILE TYPE = E
* /--- BLOCK COND ERROR 00 000 81/07/28 03.34
*
*
IDENT CONDERR
TITLE CONDENSE ERROR SUBROUTINES
*
* (A5,B5,X5,A7,B7,X7) ARE 'A'L'W'A'Y'S PRESERVED
*
* GET COMMON SYMBOL TABLE
*
CST
*
ENTRY ERR,ERR2,ERRB
ENTRY ERRORC
ENTRY ERRNOZ
*
EXT ECSPRTY
EXT COMNAMS,FINISC,PPTERRC
EXT UNITNAM,UNITPNM,ENTRYNM,STPSNAM
EXT COMCONT,NXTC,NXTLINE,GETLINE,COMINFO
EXT RJERR,RJERNOZ,RJERR2,RJERRB
*
*CALL MACROS
*
* -ERR- AND -RJERR- (STANDARD ROUTINES)
*
* 'ON ENTRY, B1 HOLDS THE ERROR NUMBER (VALUE < 2048)
*
* -ERRNOZ- SAME AS -ERR-, BUT DOES NOT SET ZCONDOK
*
ERRNOZ RJ RJERNOZ
EQ ERROUT
ERR2 RJ RJERR2
EQ ERROUT
*
ERRB RJ RJERRB
EQ ERROUT
*
ERRORC SB1 1 ***BAD LINE*** ERRORS
ERR RJ RJERR
* ABORT REMAINDER OF PRESENT LINE
ERROUT SA1 TSCOMFG CONDEN COMMAND STAT FLAG
PL X1,ERROUTA JUMP IF FLAG OFF
SX6 1 SET FLAG OFF TEMP
SA6 TSCOMFG DONT INCLUDE IN STATISTICS
ERROUTA SA2 COMMAND BAD COMMAND NAME
*
SA1 UNITNAM CHECK FOR -UNIT-
BX1 X1-X2
ZR X1,SKPUNIT IF UNIT, SKIP THE TEXT
*
SA1 UNITPNM CHECK -UNITOP-
BX1 X1-X2
ZR X1,SKPUNIT IF UNITOP, SKIP THE TEXT
*
SA1 ENTRYNM CHECK -ENTRY-
BX1 X1-X2
NZ X1,UNIT2 IF NOT ENTRY, BRANCH AROUND
*
SKPUNIT RJ GETLINE
SA3 COMMAND GET COMMAND
*
SA2 UNITNAM GET -UNIT- COMMAND
BX2 X2-X3 CHECK CURRENT COMMAND
ZR X2,NXTC RETURN TO PROCESSING IF -UNIT-
*
SA2 UNITPNM GET -UNITOP- COMMAND
BX2 X2-X3 CHECK CURRENT COMMAND
ZR X2,NXTC IF -UNITOP- THEN EXIT
*
SA2 STPSNAM
BX2 X2-X3
ZR X2,NXTC IF -CSTOP*-, EXIT
*
EQ SKPUNIT
*
*
* /--- BLOCK COND ERROR 00 000 81/07/28 00.07
*
*
*
ADR MICRO 1,,/A0/ A0 = START OF HASH TABLE
COM MICRO 1,,/COMNAMS/ MICRO USED IN FIND MACRO
UNIT2 SA0 COMINFO COMINFO IS HASH TABLE
LIST G
* HASH THE COMMAND NAME
HASH X2,X0,A1 X2 = CURRENT COMMAND (HOLERITH)
* FIND COMMAND IN NAME TABLE
FIND X2,X0,ERROUTB,B1,X3,B2,B3,B4,A1
LIST *
EQ ERROUTC NAME NOT FOUND
ERROUTB LX3 17 CONTINUED COMMAND FLAG
PL X3,NXTLINE ZERO MEANS SINGLE LINE COMMAND
ERROUTC RJ GETLINE ELSE CONTINUE COMMAND
SA2 COMMAND THEN SKIP TO NEXT REAL COMMAND
SA3 COMCONT
BX4 X2-X3 SEE IF BLANK COMMAND
ZR X4,ERROUTC
EQ NXTC
*
ENTRY HASHCD
HASHCD DATA 20002525000100010001B HASH FOR CONDENSOR NAME TABLE
* /--- BLOCK END 00 000 81/07/28 00.07
*
END