Retro1.org codex

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