ASMB,A,B,L,C
      HED 2100 SERIES COMPUTER EAU TEST 
      ORG 2 
      SUP           SUPPRESS EXTENDED STRINGS 
* 
******************************************************************* 
* 
* 
* DIAGNOSTIC CHECKS EAU INSTR GROUP 
* 
* DIAGNOSTIC ASSUMES THE FOLLOWING TESTS HAVE BEEN RUN
* 
*    MEMORY REFERENCE GROUP  DSN 101000 
*    ALTER-SKIP GROUP        DSN 101001 
*    SHIFT-ROTATE GROUP      DSN 101002 
* 
* RUNS IN 4K MEMORY 
* 
* TELETYPE MAY BE USED BUT NOT REQUIRED 
* 
* DIAGNOSTIC CONFIGURATOR IS REQUIRED 
* 
* DIAGNOSTIC SERIAL NO (DSN) 101004 
* 
* OPERATING INSTRUCTIONS: 
* 
*     1.  LOAD EAU DIAGNOSTIC.
* 
*     2.  SET P REGISTER TO 100.
* 
*     3.  SELECT PROGRAM OPTIONS IN THE SWITCH REGISTER.
* 
*     4.  PRESS PRESET(INT. AND EXT. IF PRESENT) AND RUN. 
* 
      SKP 
* 
*************** SWITCH REGISTER OPTIONS *************************** 
* 
*   BIT        MEANING
* 
*    0-5       RESERVED 
*    6         SUPPRESS NUMBER GENERATOR
*    7         SKIP INDIRECT ADDRESSING TESTS 
*    8         RESERVED 
*    9         EXIT TEST ON ERROR 
*    10        SUPPRESS NON-ERROR MESSAGES
*    11        SUPPRESS ERROR MESSAGES
*    12        HALT AT END OF PASS (102077) 
*    13        LOOP ON TEST(NEW DATA IF SW. 6 CLEAR)
*    14        SUPPRESS ERROR HALTS 
*    15        HALT AT END OF TEST (A/B= TEST#) 
* 
* 
*************** COMPUTER HALTS *************************************
* 
*   HALT       MEANING
* 
*  1020XX      ERROR HALTS (XX=TEST#) 
*  102076      END OF TEST HALT 
*  102077      END OF PASS HALT 
*  1060XX      UNEXPECTED TRAP CELL HALT (XX=SC)
* 
******************************************************************* 
* 
      SKP 
* EAU MACRO CODE WITHOUT BIT 15 
* 
DLD   EQU 4200B     DOUBLE LOAD 
DST   EQU 4400B     DOUBLE STORE
MPY   EQU 200B      MULTIPLY
DIV   EQU 400B      DIVIDE
ASR   EQU 1020B     ARITHMETIC SHIFT RIGHT 16 
ASL   EQU 20B       ARITHMETIC SHIFT LEFT 16
LSR   EQU 1040B     LOGICAL SHIFT RIGHT 16
LSL   EQU 40B       LOGICAL SHIFT LEFT 16 
RRR   EQU 1100B     ROTATE RIGHT 16 
RRL   EQU 100B      ROTATE LEFT 16
      SPC 3 
      ORG 100B
      JMP PSTRT,I   GO RUN EAU DIAGNOSTIC 
* 
LIST  EQU 102B      LINK TO SIO LIST DRIVER 
SOSC  EQU 112B
A     EQU 0 
B     EQU 1 
CRLF  EQU 6412B     ASCII CARRIAGE RETURN/LINE FEED 
* 
      ORG 105B
      DEF END       LAST WORD ADDRESS - FOR SIO DUMP
* 
      ORG 126B
      OCT 101004    DIAGNOSTIC SERIAL NO
      ORG 130B
      JMP PSTRT,I 
      JMP PSTRT,I 
      HED CONSTANTS, VARIABLES, MESSAGES, ETC.
RNA   NOP           WORKING ARGUMENTS OR OPERANDS 
RNB   NOP 
RNE   NOP 
RNM   NOP 
RNO   NOP 
SHFT  NOP           INSTRUCTION SHIFT FIELD 
IL#   NOP           # INDIRECT ADDRESSING LEVELS
EA    NOP           EXPECTED REGISTER RESULTS: A REG
AA    NOP           ACTUAL REGISTER RESULTS: A REG
EB    NOP           EXPECTED REGISTER RESULTS: B REG
AB    NOP           ACTUAL REGISTER RESULTS: B REG
EE    NOP           EXPECTED REGISTER RESULTS: E REG
AE    NOP           ACTUAL REGISTER RESULTS: E REG
EO    NOP           EXPECTED REGISTER RESULTS: O REG
AO    NOP           ACTUAL REGISTER RESULTS: O REG
SA    NOP           CONTENTS OF DST MACRO 
SB    NOP           CONTENTS OF DST MACRO 
* 
DSA   DEF SA
FLG6  NOP           0 MEANS SW. 6 DOWN DURING LOOP
ISR   NOP           INTERNAL SWITCH REGISTER
LCNT  NOP           COUNT OF LOOPS WITH SW. 6 DOWN
REI   NOP           REGISTER ERROR INDICATOR
S6    NOP           STATE OF SWITCH 6 
S8CNT OCT 177777    COUNTER USED WITH SWITCH 8
TST#  NOP           TEST (ERROR) #
T1    NOP           TEMPORARY STORAGE 
T2    NOP           TEMPORARY STORAGE 
T3    NOP           TEMPORARY STORAGE 
* 
APT   DEF DAD 
DAD   NOP           DIRECT ADDRESS
      DEF *-1,I     1 INDIRECT LEVEL
      DEF *-1,I     2 INDIRECT LEVELS 
      DEF *-1,I     3 INDIRECT LEVELS 
      DEF *-1,I     4 INDIRECT LEVELS 
* 
B7    OCT 7 
B10   OCT 10
B11   OCT 11
B12   OCT 12
B17   OCT 17
B20   OCT 20
B30   OCT 30
B60   OCT 60        ASCII 0 
B72   OCT 72
B77   OCT 77
B366  OCT 366 
B377  OCT 377 
* 
BIT0  OCT 1 
BIT6  OCT 100 
BIT7  OCT 200 
BIT9  OCT 1000
BIT12 OCT 10000 
BIT13 OCT 20000 
BIT15 OCT 100000
* 
M1    DEC -1
M5    DEC -5
M6    DEC -6
M16   DEC -16 
* 
.1    EQU BIT0
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.7    EQU B7
.8    EQU B10 
.10   EQU B12 
.11   DEC 11
.16   EQU B20 
.20   DEC 20
.28   DEC 28
.38   DEC 38
.63   EQU B77 
.1500 DEC 1500
* 
A00   ASC 1,00      2 ASCII 0'S 
A2S   ASC 1,        2 ASCII SPACES
* 
A2000 OCT 2000
PSTRT EQU A2000 
A4000 OCT 4000
D5000 OCT 35000 
D7400 OCT 37400 
* 
HLT1  OCT 106001
HLT77 OCT 106077
* 
ASR0  DEF ASR,I     ASR WITHOUT SHIFT FIELD 
ASL0  DEF ASL,I     ASL WITHOUT SHIFT FIELD 
LSR0  DEF LSR,I     LSR WITHOUT SHIFT FIELD 
LSL0  DEF LSL,I     LSL WITHOUT SHIFT FIELD 
RRR0  DEF RRR,I     RRR WITHOUT SHIFT FIELD 
RRL0  DEF RRL,I     RRL WITHOUT SHIFT FIELD 
* 
AMWMA DEF AMWM
BAMA  DEF BAM 
BAWMA DEF BAWM
MIA   DEF MI
MA77  DEF MG77
MA77B DEF MG77B 
RNAA  DEF RNA 
RNMA  DEF RNM 
STRMA DEF STRM
* 
MI    ABS CRLF
      ASC 14,2100 SERIES EAU DIAGNOSTIC 
* 
MG77  ASC 6,END OF PASS 
MG77A ASC 3,XXXXXX
MG77B ASC 1,XX
* 
BAM   ASC 1,B,
AMWM  ASC 4,A,M WAS 
* 
BAWM  ASC 4,B,A WAS 
* 
STRM  ASC 6,STORED WAS
      SPC 3 
* ASCII LABLE TABLE 
* 
ALT   DEF *-1 
      ASC 2,DLD     1 
      ASC 2,DST     2 
      ASC 2,MPY     3 
      ASC 2,DIV     4 
      ASC 2,ASR     5 
      ASC 2,ASL     6 
      ASC 2,LSR     7 
      ASC 2,LSL     8 
      ASC 2,RRR     9 
      ASC 2,RRL     10
      SPC 3 
DBUF  DEF BUF       BUFFER ADDRESS
BPT   NOP           BUFFER POINTER
BCNT  NOP           BUFFER CHARACTER COUNT
BUF   BSS 36        72 CHARACTER BUFFER 
EXEC  DEF EXRTN 
      HED SUBROUTINES 
* SUBROUTINE TO GENERATE NEW ARGUMENTS
* 
* IF SWITCH 6 IS DOWN, GENERATE NEW NUMBERS AND PUT THEM IN 
*  RNA, RNB, RNM, RNE, & RNO. 
*   IF LCNT=0,  RNM_000000 & RNA_NEGATIVE 
*   IF LCNT = 1,  RNB_000000, RNA_100000, RNM_000001
*   IF LCNT = 2,  RNB_000000, RNA_100000, RNM_177777
*   IF LCNT=63,127,191,...,  RNB_177777 
*   IF LCNT=64,128,192,...,  RNB_000000 
*   (IF SWITCH 8 IS UP, SUBSTITUTE S8CNT FOR LCNT)
*    RETURN P+1 
* IF SWITCH 6 IS UP, FLG6 _ NON 0, RETURN P+1 
* 
RNG   NOP 
      JSB GSR       GET SWITCH REGISTER 
      AND BIT6       CHECK SWITCH 6 
      SZA 
      STA FLG6        UP - FLG6 _ NON 0 
      SZA 
      JMP RNG,I       UP - RETURN P+1 
      LDA RN1 
      ADA RN2 
      STA RN1       SAVE NEW BASE 
      STA RNA       NEW RNA 
      ALF 
      STA RNB       NEW RNB 
      ALF 
      STA RNM       NEW RNM 
      RAL 
      AND BIT0
      STA RNE       NEW RNE (BIT 0 ONLY)
      LDA RNM 
      RAL,RAL 
      AND BIT0
      STA RNO       NEW RNO (BIT 0 ONLY)
      JSB CS8       CHECK SWITCH 8
      RSS 
      JMP RNG8C 
      LDA S8CNT       SET:  A_S8CNT_S8CNT+1 
      INA 
      STA S8CNT 
      RSS 
RNG8C LDA LCNT        CLEAR:  A_LCNT
      SZA 
      JMP RNG1
      STA RNM       LCNT=0,  RNM_000000 
      LDB RNA 
      SSB,RSS 
      CMB 
      STB RNA       LCNT=0,  RNA_NEGATIVE 
      JMP RNG,I 
RNG1  CPA .1
      RSS 
      JMP RNG2    LCNT NOT 1
      JSB RNBA      RNB,RNA _ 000000,100000 
      CLA,INA 
      STA RNM       RNM _ 000001
      JMP RNG,I 
RNG2  CPA .2
      RSS 
      JMP RNG3      LCNT NOT 2
      JSB RNBA      RNB,RNA _ 000000,100000 
      CCA 
      STA RNM       RNM _ 177777
      JMP RNG,I 
RNG3  AND B77 
      SZA,RSS       IF LCNT = 64,128,192,...
      STA RNB         RNB _ 000000
      CCB 
      CPA B77       IF LCNT = 63,127,191,...
      STB RNB         RNB _ 177777
      JMP RNG,I 
* 
RNBA  NOP 
      CLB 
      STB RNB       RNB_000000
      LDB BIT15 
      STB RNA       RNA_100000
      JMP RNBA,I
* 
SRN1  DEC -14397    BASE
SRN2  DEC 14397 
RN1   DEC -14397    BASE
RN2   DEC 14397     CONSTANT
      SPC 3 
* SUBROUTINE TO GET SWITCH REGISTER IN A
* 
GSR   NOP 
      LIA 1 
      JMP GSR,I 
      SPC 3 
* SUBROUTINE TO CHECK FOR AN ERROR MESSAGE
*  RETURN P+1 FOR NO MESSAGE - SWITCH 11 UP 
*  RETURN P+2 FOR MESSAGE - SWITCH 11 DOWN
* 
* BEFORE RETURNING FOR AN ERROR MESSAGE, INITIALIZE THE MESSAGE BUFFER
* PACK E-TST#, MACRO NAME & SHFT (IF A SHIFT ROTATE INSTR.) 
* 
CEM   NOP 
      LDA SOSC
      SZA,RSS       TEST FOR TTY PRESENT
      JMP CEM,I     RETURN P+1
      JSB GSR       GET SWITCH REGISTER 
      AND A4000     CHECK SWITCH 11 
      SZA 
      JMP CEM,I     EITHER UP - RETURN P+1
      ISZ CEM       SET TO RETURN P+2 
      JSB CBUF      BOTH DOWN - INITIALIZE MESSAGE
      LDA .2
      LDB EDMA
      JSB MOVE      PAK "E-"
      LDB TST#
      JSB CUTOX     CONVERT & PAK TST#
      LDB TST#
      BLS 
      ADB ALT 
      LDA .4
      JSB MOVE      PAK MACRO NAME, SPACE 
      LDB TST#
      ADB M5
      SSB 
      JMP CEM,I     NOT SHIFT/ROTATE
      LDB SHFT      SHIFT COUNT 
      SZB,RSS 
      ADB .16       MAKE 16 IF 0
      LDA B30 
      AND B 
      SZA 
      JMP CEM1
      LDA B60       PAK A LEADING 0 IF SHIFT COUNT
      JSB PAK         IS < 10 OCTAL 
CEM1  JSB CUTOX     CONVERT AND PAK 
      JMP CEM,I     RETURN P+2
* 
EDMA  DEF EDM 
EDM   ASC 1,E-
      SPC 3 
* SUBROUTINE TO CHECK FOR AN NON-ERROR MESSAGE
*  RETURN P+1 FOR NO MESSAGE - SWITCH 10 UP 
*  RETURN P+2 FOR MESSAGE - SWITCH 10 DOWN
* 
CNEM  NOP 
      LDA SOSC
      SZA,RSS       TEST FOR TTY PRESENT
      JMP CNEM,I    RETURN P+1
      JSB GSR       GET SWITCH REGISTER 
      AND A2000     CHECK SWITCH 10 
      SZA,RSS 
      ISZ CNEM      BOTH DOWN - RETURN P+2
      JMP CNEM,I    EITHER UP - RETURN P+1
      SPC 3 
* SUBROUTINE TO CHECK FOR NEXT INDIRECT LEVEL ADDRESSING
*  RETURN P+2 IF SWITCH 7 IS UP 
*  ELSE, STEP IL#; IF 5, RETURN P+2; ELSE RETURN P+1
* RETURN WITH IL# IN A
* 
CIA   NOP 
      JSB GSR 
      AND BIT7
      SZA           CHECK SWITCH 7
      JMP CIA1        UP - RETURN P+2 
      ISZ IL# 
      LDA IL#         DOWN -  IL# _ IL# +1
      CPA .5
CIA1  ISZ CIA         IL# = 5,  RETURN P+2
      JMP CIA,I     ELSE RETURN P+1 
      SPC 3 
* SUBROUTINE TO CHECK SWITCH 13 TO LOOP ON TEST 
*  IF SET:  RETURN P+1
*  IF CLEAR:  S8CNT_177777, RETURN P+2
* 
CS8   NOP 
      JSB GSR 
      AND BIT13 
      SZA 
      JMP CS8,I       SET:  RETURN P+1
      CCA           CLEAR:
      STA S8CNT 
      ISZ CS8         S8CNT_177777 (RESET)
      JMP CS8,I       RETURN P+2
      SPC 3 
* SUBROUTINE TO CHECK SWITCH 9 FOR AN ERROR BREAKOUT
* 
CS9   NOP 
      JSB GSR 
      AND BIT9      CHECK SWITCH 9
      SZA,RSS         UP - RETURN P+1 
      ISZ CS9         DOWN - RETURN P+2 
      JMP CS9,I 
      SPC 3 
* SUBROUTINE TO CHECK FOR AN ERROR HALT 
*  IF SWITCH 14 IS DOWN,RESTORE THE ACTUAL REGISTERS AND RETURN P+1 
*   FOR AN ERROR HALT; ELSE RETURN P+2
* 
CEHLT NOP 
      JSB GSR       GET SWITCH REGISTER 
      RAL 
      SSA,RSS 
      JMP CEHT1 
      ISZ CEHLT     SWITCH 14 WAS UP
      JMP CEHLT,I     RETURN P+2
CEHT1 LDA AE
      CLE,RAR       RESTORE E 
      CLO 
      LDA AO
      SLA 
      STO           RESTORE OV
      LDA AA        RESTORE A 
      LDB AB        RESTORE B 
      JMP CEHLT,I     RETURN P+1
      SPC 3 
* END OF TEST ROUTINE 
*  CHECK SWITCH 15:  IF DOWN, RETURN P+2
*    ELSE CHECK SWITCHES 1&10:  IF BOTH DOWN, PAK AND PRINT 
*      END OF TEST MESSAGE (EOT XX).
*        THEN RETURN P+1 WITH TST# IN BOTH A & B REGISTERS. 
* 
EOT   NOP 
      JSB GSR 
      SSA           CHECK SWITCH 15 
      JMP EOT1
      ISZ EOT         DOWN - RETURN P+2 
      JMP EOT,I 
EOT1  JSB CNEM        UP - CHECK FOR NON-ERROR MSG. 
      JMP EOT2          USER DOESN'T WANT MESSAGE 
      JSB CBUF      CLEAR BUFFER
      LDA .4
      LDB EOTMA 
      JSB MOVE      PAK "EOT" & SPACE 
      LDB TST#
      JSB CUTOX     PAK TST#
      JSB PBUF      PRINT EOT MESSAGE 
EOT2  LDA TST#
      LDB TST#
      JMP EOT,I     RETURN P+1, A_B_TST#
* 
EOTMA DEF EOTM
EOTM  ASC 2,EOT 
      SPC 3 
* SUBROUTINE TO INITIALIZE REGISTERS BEFORE A MACRO CALL
* E _ EE _ RNE(0) 
* OV _ RNO(0) 
*  A _ RNA
*  B _ RNB
* RETURN P+1
* 
IREG  NOP 
      CLO 
      LDB RNO 
      SLB 
      STO           OV _ RNB(0) 
      LDA RNE 
      AND BIT0
      STA EE        EE _ RNE(0) 
      ERA           E _ RNE(0)
      LDA RNA       A _ RNA 
      LDB RNB       B _ RNB 
      JMP IREG,I      RETURN P+1
      SPC 3 
* GET AND SAVE THE EXPECTED OV REGISTER 
* THEN CALL IREG TO INITIALIZE THE REST 
* 
IREGO NOP 
      LDA RNO 
      AND BIT0
      STA EO        EO _ RNO(0) 
      JSB IREG
      JMP IREGO,I 
      SPC 3 
* SUBROUTINE TO SAVE THE ACTUAL REGISTER RESULTS
*  THEN TO COMPARE THEM WITH THE EXPECTED 
* RETURN P+1 WITH A & REI INDICATING ANY ERRORS 
*    BITS(3-0) _ OV,E,B,A ERROR BITS RESPECTIVELY 
* 
CHECK NOP 
      STA AA        SAVE ACTUAL A 
      STB AB        SAVE ACTUAL B 
      CLA           ASSUME NO ERRORS
      CPB EB
      RSS           B OK
      ADA .2          BIT 1 INDICATES B ERROR 
      LDB AA
      CPB EA
      RSS           A OK
      INA             BIT 0 INDICATES A ERROR 
      CLB,SEZ 
      INB 
      STB AE        SAVE ACTUAL E 
      CPB EE
      RSS           E OK
      ADA .4          BIT 2 INDICATES E ERROR 
      CLB 
      SOC 
      INB 
      STB AO        SAVE ACTUAL OV
      CPB EO
      RSS           OV OK 
      ADA .8          BIT 3 INDICATES OV ERROR
      STA REI       SAVE REGISTER ERROR INDICATOR 
      JMP CHECK,I   RETURN P+1
      HED MESSAGE PACKING ROUTINES
* SUBROUTINE TO CLEAR THE BUFFER
* 
CBUF  NOP 
      CLA 
      STA BCNT      RESET COUNTER 
      LDB DBUF
      STB BPT       RESET POINTER 
      JMP CBUF,I
      SPC 3 
* SUBROUTINE TO PRINT BUFFER - RETURN P+1 
* 
PBUF  NOP 
      LDA BCNT      # CHARACTERS
      LDB DBUF      BUFFER ADDRESS
      JSB LIST,I
      JMP PBUF,I    RETURN P+1
      SPC 3 
* SUBROUTINE TO ADD CHARACTER IN A LOWER TO THE BUFFER
*  RETURN P+1 WITH B UNCHANGED. 
* 
PAK   NOP 
      STB ..B       SAVE B REGISTER 
      AND B377      CLEAR UPPER HALF
      LDB BCNT      BUFFER CHARACTER COUNT
      SLB,RSS 
      ALF,SLA,ALF   IF EVEN,ROTATE AND STORE
      IOR BPT,I     IF ODD, MERGE AND STORE 
      STA BPT,I 
      SLB 
      ISZ BPT       IF ODD, BUMP BUFFER ADDRESS 
      ISZ BCNT      STEP BUFFER CHARACTER COUNT 
      LDB ..B       RESTORE B 
      JMP PAK,I     RETURN P+1
* 
..B   NOP           TEMPORARY STORAGE FOR B REGISTER
      SPC 3 
* SUBROUTINE TO MOVE A STRING OF ASCII CHARACTERS TO THE BUFFER 
*  GIVEN: CHARACTER COUNT IN A
*         STRING ADDRESS IN B 
* THE 1ST CHARACTER IS ASSUMED IN BITS 15-8 OF THE FIRST WORD 
* RETURN P+1
* 
MOVE  NOP 
      STA T1        # CHARACTERS
      STB T2        ADDRESS 
      CLB           POSITION IN STRING
MOVEC CPB T1
      JMP MOVE,I    RETURN IF END OF STRING 
      LDA T2,I      NEXT WORD OF 2 CHARACTERS 
      SLB,RSS 
      ALF,ALF       ROTATE IF POSITION IS EVEN
      JSB PAK       PAK CHARACTER IN BUFFER 
      SLB,INB       TEST AND STEP POSITION
      ISZ T2        STEP ADDRESS IF POSITION WAS ODD
      JMP MOVEC     CONTINUE
      SPC 3 
* SUBROUTINE TO ADD 1 ASCII SPACE TO BUFFER 
* 
SPC1  NOP 
      LDA A2S       ASCII SPACE 
      JSB PAK         TO BUFFER 
      JMP SPC1,I    RETURN P+1
      SPC 3 
* SUBROUTINE TO PAK VARIABLE IN B AS OCTAL CHARACTERS 
* LEADING 0'S ARE NOT PACKED
* IF B=0, A SINGLE ASCII 0 IS PACKED
* RETURN P+1 AFTER ADDING 1 TRAILING SPACE TO THE BUFFER
* 
CUTOX NOP 
      CLE           E_0 INDICATING NO LEADING 0'S 
      JSB CUTO      CONVERT & PAK 
      JMP CUTOX,I 
      SPC 3 
* SUBROUTINE TO PAK VARIABLE IN B AS 6 OCTAL CHARACTERS 
* RETURN P+1 AFTER 1 TRAILING SPACE HAS BEEN ADDED TO THE BUFFER
* 
CUTO6 NOP 
      CCE           I_1 INDICATING SIGNIFICANT 0'S
      JSB CUTO      CONVERT & PAK 
      JMP CUTO6,I 
      SPC 3 
CUTO  NOP 
      LDA M6
      STA T1        6 DIGIT COUNTER 
      RBL           RIGHT JUSTIFY 1ST DIGIT 
      CLA,INA       1ST DIGIT MASK
CUTO1 AND B         MASK OFF NEXT DIGIT 
      SZA 
      CCE           SET E IF NOT 0
      IOR B60       ADD ASCII BASE
      SEZ 
      JSB PAK       PAK ONLY IF E=1 
      BLF,RBR       RIGHT JUSTIFY NEXT DIGIT
      LDA B7        NEXT DIGIT MASK 
      ISZ T1
      JMP CUTO1     CONTINUE IF NOT 6 DIGITS
      LDA B60 
      SEZ,RSS       IF VARIABLE WAS 0 
      JSB PAK         PUT 1 ASCII 0 IN BUFFER 
      JSB SPC1      ADD 1 ASCII SPACE TO BUFFER 
      JMP CUTO,I    RETURN P+1
      SPC 3 
* SUBROUTINE TO PAK INDIRECT LEVEL STRING 
* 
PIL#  NOP 
      LDA .3
      LDB ILMA
      JSB MOVE      PAK IL= 
      LDB IL# 
      JSB CUTOX     PAK X, SPACE
      JMP PIL#,I
* 
ILMA  DEF ILM 
ILM   ASC 2,IL= 
      SPC 3 
* SUBROUTINE TO PAK "SB" SPACE
* 
PSB   NOP 
      LDA .3
      LDB SBMA
      JSB MOVE      PAK SB, SPACE 
      JMP PSB,I     RETURN P+1
* 
SBMA  DEF SBM 
SBM   ASC 2,SB
      SPC 3 
* SUBROUTINE TO INCLUDE B&A ERRORS IN ERROR MESSAGE 
* 
PBA   NOP 
      LDA REI 
      AND .3
      SZA,RSS       CHECK REGISTER ERROR INDICATOR
      JMP PBA,I     NO B OR A REGISTER ERRORS 
      LDA .38 
      JSB CEOB      CHECK MESSAGE LENGTH
      LDA .4
      LDB BAQMA 
      JSB MOVE      PAK "B,A="
      LDB AB
      JSB CUTO6     CNVT & PAK ACTUAL B & SPACE 
      LDB AA
      JSB CUTO6     CNVT & PAK ACTUAL A & SPACE 
      JSB PSB       PAK "SB " 
      LDB EB
      JSB CUTO6     CNVT & PAK EXPECTED B & SPACE 
      LDB EA
      JSB CUTO6     CNVT & PAK EXPECTED A & SPACE 
      JMP PBA,I        RETURN P+1 
* 
BAQMA DEF BAQM
BAQM  ASC 2,B,A=
      SPC 3 
* SUBROUTINE TO INCLUDE E & OV REGISTERS ERRORS IN MESSAGE
* 
PEO   NOP 
      LDA REI 
      AND .4
      SZA,RSS 
      JMP PEO1      E OK
      LDA .63 
      JSB CEOB      CHECK MESSAGE LENGTH
      LDA .2
      LDB EQMA
      JSB MOVE      PAK "E="
      LDB AE
      JSB CUTOX     CNVT & PAK ACTUAL E 
      JSB PSB       PAK "SB"
      LDB EE
      JSB CUTOX     CNVT & PAK EXPECTED E 
PEO1  LDA REI 
      AND .8
      SZA,RSS 
      JMP PEO,I     OV OK 
      LDA .63 
      JSB CEOB      CHECK MESSAGE LENGTH
      LDA .3
      LDB OQMA
      JSB MOVE      PAK "OV=" 
      LDB AO
      JSB CUTOX     CNTV & PAK ACTUAL OV
      JSB PSB       PAK "SB"
      LDB EO
      JSB CUTOX     CNVT & PAK EXPECTED OV
      JMP PEO,I     RETURN P+1
* 
EQMA  DEF EQM 
OQMA  DEF OQM 
EQM   ASC 1,E=
OQM   ASC 2,OV= 
      SPC 3 
* SUBROUTINE TO CHECK BUFFER LENGTH 
* IF BCNT >= A, THEN
*  PRINT THE BUFFER, RESET IT, THEN ADD 2 SPACES
* RETURN P+1
* 
CEOB  NOP 
      CMA,INA 
      ADA BCNT
      SSA 
      JMP CEOB,I    OK: BCNT<A
      JSB PBUF      PRINT BUFFER CONTENTS 
      JSB CBUF      RESET BUFFER
      JSB SPC1
      JSB SPC1      ADD 2 SPACES
      JMP CEOB,I    RETURN P+1
  