HED BASE PAGE AND LINKAGES
      ORG 126B
      IFN 
      OCT 101016    2100 DIAGNOSTIC SERIAL NUMBER 
      XIF 
      IFZ 
      OCT 101117    21MX DIAGNOSTIC SERIAL NUMBER 
      XIF 
* 
      ORG 140B
IOIP  DEF IOID
TSTP  DEF TSTD
HDMP  DEF HDMS
      IFN 
STDA  OCT 1777
      XIF 
      IFZ 
STDA  OCT 777 
      XIF 
STDB  OCT 0 
      SUP 
* 
      ORG 150B
      IFN 
HDMS  ASC 23,2100 2000 COMPUTER SYSTEM COMM. PROC. FIRMWARE 
      ASC 6, DIAGNOSTIC/
      XIF 
      IFZ 
HDMS  ASC 23,21MX 2000 COMPUTER SYSTEM COMM. PROC. FIRMWARE 
      ASC 6, DIAGNOSTIC/
      XIF 
* 
IOID  EQU * 
      DEF TBGSC 
      DEF TBGIP 
      DEF TBGIT 
      DEC -1
TSTD  EQU * 
      DEF TST00 
      DEF TST01 
      DEF TST02 
      DEF TST03 
      DEF TST04 
      DEF TST05 
      DEF TST06 
      DEF TST07 
      DEF TST08 
      IFN 
      DEF TST09 
      XIF 
      DEC -1
      SKP 
* 
* DEFINE MICROS 
* 
      IFZ 
LAI   EQU 420B
SAI   EQU 420B
CRC   EQU 460B
RESTR EQU 461B
READF EQU 462B
INS   EQU 463B
ENQ   EQU 464B
PENQ  EQU 465B
DEQ   EQU 466B
TRSLT EQU 467B
IAL   EQU 470B
PFREI EQU 471B
PFREX EQU 472B
PFRIO EQU 473B
SAVE  EQU 474B
      XIF 
      IFN 
IAL   EQU 0 
LAI   EQU 40B 
SAI   EQU 100B
BMVE  EQU 120B
CRC   EQU 150B
TRSLT EQU 160B
MOVE  EQU 200B
READF EQU 220B
PFRIO EQU 221B
PFREI EQU 222B
PFREX EQU 223B
ENQ   EQU 240B
PENQ  EQU 257B
DEQ   EQU 260B
SAVE  EQU 362B
STBYT EQU 300B
LBYTE EQU 320B
RESTR EQU 340B
      XIF 
* 
* 
* 
* 
      SUP 
      DEC -40,-39,-38,-37,-36,-35,-34,-33 
      DEC -32,-31,-30,-29,-28,-27,-26,-25 
      DEC -24,-23,-22,-21,-20,-19,-18,-17 
      DEC -16,-15,-14,-13,-12,-11,-10,-9
      DEC -8,-7,-6,-5,-4,-3,-2,-1 
.     DEC 0,1,2,3,4,5,6,7 
      DEC 8,9,10,11,12,13,14,15 
      DEC 16,17,18,19,20,21,22,23 
      DEC 24,25,26,27,28,29,30,31 
      UNS 
* 
M500  DEC -500
* 
* 
MRGHT OCT 377 
MLEFT OCT 177400
* 
* 
* 
* 
* 
* RNDGN PUTS A PSUEDO RANDOM NUMBER IN A EACH TIME
* IT IS CALLED
* 
RNDGN NOP 
      LDA BASE
      ADA PRIME 
      SSA 
      LDA BASE
      CLE,ELA 
      STA BASE
      RAR 
      JMP RNDGN,I 
* 
PRIME DEC -31069
BASE  OCT 34521 
* 
* 
* 
** REGCK
* 
* THIS ROUTINE CHECKS IF THE REGISTERS HAVE BEEN MODIFIED 
* SINCE THE LAST CALL TO SAVR.  A FOUR BIT VECTOR IS RE-
* TORNED IN THE LOW BITS OF REGST TO INDICATE ANY CHANGES.
* BIT 3 IS SET IF (A) HAS CHANGED, BIT 2 IF (B), BIT 1 IF 
* (E) AND BIT 0 IF (O).  THE REMAINING BITS IN REGST ARE
* CLEARED.
* 
REGCK NOP 
      STA REGCA 
      XOR SAVRA 
      SZA,RSS       (A) CHANGED?
      JMP *+3       NO
      CLA           YES 
      RSS 
      INA 
      ALS 
      CPB SAVRB     (B) CHANGED?
      INA           NO
      ALS           YES 
      SEZ,RSS       (E) SET?
      INA           NO
      ALS 
      SOS           (O) SET?
      INA           NO
      XOR REGEO 
      CMA 
      AND .+17B 
      STA REGST 
      LDA REGCA     RESTORE (A) 
      JMP REGCK,I 
* 
REGCA BSS 1 
REGST BSS 1 
* 
* 
** SAVRG
* 
* THIS ROUTINE RECORDS THE CONTENTS OF THE REGISTERS. 
* 
*     SAVA <= (A) 
*     SAVB <= (B) 
*     REGEO <= (E)/(O), IN BITS 1/0 
* 
SAVRG NOP 
      STA SAVRA 
      STB SAVRB 
      CLA 
      SEZ 
      INA 
      ALS 
      SOC 
      INA 
      STA REGEO 
      LDA SAVRA 
      JMP SAVRG,I 
* 
SAVRA BSS 1 
SAVRB BSS 1 
REGEO BSS 1 
* 
** RANEO
* 
* THIS ROUTINE SET (E) AND (O) WITH RANDOM VALUES 
* 
RANEO NOP 
      STA RANA
      JSB RNDGN     GET A RANDOM NUMBER 
      ALF 
      SLA 
      JMP *+3 
      CLE 
      RSS 
      CCE 
      SSA 
      JMP *+3 
      CLO 
      RSS 
      STO 
      LDA RANA
      JMP RANEO,I 
* 
RANA  BSS 1 
* 
* 
* 
**  GET BYTE
* 
* CALLING SEQUENCE
* 
*         LDB BYADR       BYTE ADDR OF CHAR 
*         JSB GBYTE       RESULT IN A 
*         <RETURN>
* 
* (B) IS RESTORED ON EXIT 
* 
GBYTE NOP 
      STB GBYTB      SAVE B 
      RBR            MAKE ADDR INTO WORD ADDR 
      ELB,CLE,ERB    CLEAR BIT15
      LDA B,I        GET WORD CONTAINING BYTE 
      LDB GBYTB      GET BYTE ADDR
      SLB            LEFT BYTE? 
      JMP *+4        NO 
      AND MLEFT      YES
      ALF,ALF 
      RSS 
      AND MRGHT      EXTRACT RIGHT BYTE 
* 
      LDB GBYTB      RESTORE B
      JMP GBYTE,I    RETURN 
* 
* 
GBYTB BSS 1 
* 
* 
* 
**  STORE BYTE
* 
* 
* CALLING SEQUENCE
* 
*         LDA CHAR
*         LDB BYADR     BYTE ADDR 
*         JSB SBYTE 
* 
*         <RETURN>
* 
* (B) IS RESTORED ON EXIT 
* 
* 
SBYTE NOP 
      STB SBYTB      SAVE B 
      STA SBYTA 
      AND MRGHT 
      STA SBYCH      SAVE CHAR
      RBR 
      ELB,CLE,ERB 
      STB SBYTD      SAVE DESTINATION ADDRESS 
      LDA B,I        GET DESTINATION WORD 
      LDB SBYTB 
      SLB            STORE INTO LEFT BYTE?
      JMP SRGHT      NO 
      AND MRGHT      YES
      ALF,ALF 
      ADA SBYCH     INSERT CHAR 
      ALF,ALF 
      JMP *+3 
SRGHT AND MLEFT 
      ADA SBYCH      INSERT CHAR
      STA SBYTD,I 
* 
      LDA SBYTA      RESTORE A
      LDB SBYTB        AND B
      JMP SBYTE,I    RETURN 
* 
* 
SBYTA BSS 1 
SBYTB BSS 2 
SBYTD BSS 1 
SBYCH BSS 1 
* 
* 
* 
* 
** TBGIC
* 
* THIS ROUTINE STARTS THE TIME BASE GENERATOR 
* AND LOOPS UNTIL ABOUT 25 MICROSECONDS BEFORE
* THE INTERRUPT 
* 
* 
TBGIC NOP 
      STA TBGIA     SAVE (A)
      LDA TBGSU     LOAD INTERRUPT
      STA TBGSC,I     TRAP CELL 
      CLA           SET UP TBG FOR
TBGIP OTA TBG         .1 MILLISECOND
TBGIT STC TBG,C         PERIOD
      LDA .-15      LOOP
      ISZ A 
      JMP *-1 
      STF 0 
      LDA TBGIA     RESTORE (A) 
      JMP TBGIC,I   EXIT
* 
TBGSU JSB INTMB 
TBGIA BSS 1 
TBG   EQU 0         DUMMY TBG SC
TBGSC OCT 0 
* 
* INTERRUPT HANDLER FOR MOVE AND BYTE MOVE AND TRSLT
* 
INTMB NOP 
      CLF 0 
      STA INTMT     SAVE (A)
      LDA INTMB     WAS MICROPROGRAM INTERRUPTED? 
      IFN 
      CPA MOVEA 
      JMP *+4 
      CPA BMVEA 
      RSS           YES 
      XIF 
      CPA TRSTA     NO
      RSS           YES 
      JMP INTMB,I   NO, EXIT
      CLA,INA       INDICATE THE MICRO PROGRAM
      STA INTFG       WAS INTERRUPTED 
      LDA INTMT     RESTORE (A) 
      JMP INTMB,I   RETURN
* 
INTFG BSS 1 
INTMT BSS 1 
      IFN 
BMVEA DEF BMVAD 
MOVEA DEF MVEAD 
      XIF 
TRSTA DEF TRSAD 
      HED CRC TEST
* 
**  CRC TEST
* 
* 
* 1. GET AND EIGHT BIT CHAR 
* 2. CALCULATE CRC WITH PROGRAM 
* 3. CALCULATE CRC WITH MICRO-PROGRAM 
* 4. COMPARE
* 
* 
TST00 NOP 
      JSB MSGC,I     ANNOUNCE TEST
      DEF MS030 
      CLA 
      STA CRCPR      CLEAR CRC
      STA CRCMP 
      LDA N500
      STA CRCTC      DO 500 CHARS 
CRCT1 JSB RNDGN      GET A RANDOM NUMBER
      AND MRGHT      EXTRACT RIGHT EIGHT BITS 
      STA CRCMC      SAVE CHAR
* 
* CALCULATE CRC WITH PROGRAM
* 
      JSB CCRC
CRCPR BSS 1 
* 
* CALCULATE CRC WITH MICRO-PROGRAM
* 
      JSB RNDGN      SET (B) TO A RANDOM
      STA B            VALUE
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA CRCMC 
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+CRC     =RAM CRC
CRCMP BSS 1 
* 
* COMPARE RESULTS 
* 
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      SZA,RSS        ALL REGISTERS RESTORED?
      JMP *+4        YES
      JSB ERMS,I
      DEF MS032 
      JMP TST00,I 
      LDA CRCPR 
      CPA CRCMP 
      JMP *+4 
      JSB ERMS,I     ERROR, OUTPUT
      DEF MS031        MESSAGE
      JMP *+3 
* 
      ISZ CRCTC      DONE?
      JMP CRCT1      NO 
      JMP TST00,I 
* 
* 
N500  DEC -500
CRCTC BSS 1 
CRCMC BSS 1 
      SKP 
* 
* 
**  CALCULATE CRC 
* 
* 
* CALLING SEQUENCE
* 
*         LDA CHAR
*         JSB CCRC
*   CRCR  BSS 1 
*         <RETURN>
* 
* 
* (A) AND (B) ARE NOT AFFECTED
* 
* 
CCRC  NOP 
      STA CRCA      SAVE REGISTERS
      STB CRCB
      LDB .-8 
      STB CRCCT 
* 
      XOR CCRC,I
CRC1  SLA,RAR 
      XOR POLYN 
      ISZ CRCCT 
      JMP CRC1
      STA CCRC,I
      ISZ CCRC
* 
      LDA CRCA       RESTORE REGISTERS
      LDB CRCB
      JMP CCRC,I     RETURN 
* 
CRCA  BSS 1 
CRCB  BSS 1 
CRCCT BSS 1 
POLYN OCT 020001
* 
* 
* 
* 
* 
      HED ENQUE AND DEQUE TESTS 
* 
* 
**  ENQUE AND DEQUE TESTS 
* 
* 1. INITIALIZE QHEAD, QTAIL, AND LINK WORDS
* 2. QUEUE ELEMENT 1
* 3. QUEUE ELEMENT 3
* 4. PRIOTITY QUEUE ELEMENT 2 
* 5. QUEUE ELEMENT 5
* 6. QUEUE ELEMENT 4
* 7. SCAN THROUGH QUEUE 
* 
* 1. DEQUEUE AN ELEMENT 
* 2. DEQUEUE ANOTHER
* 3. DEQUEUE ANOTHER
* 4. DEQUEUE ANOTHER
* 5. DEQUEUE ANOTHER
* 6. CHECK IF SKIP RETURN IS TAKEN WHEN A DEQUE IS TRIED ON AN
*    EMPTY QUEUE
* 
* 
TST01 NOP 
      JSB MSGC,I     ANNOUNCE TEST
      DEF MS040 
      CLA 
      STA ELEM1-1    CLEAR
      STA ELEM2-1      LINK WORDS 
      STA ELEM3-1 
      STA ELEM4-1 
      STA ELEM5-1 
      STA QHEAD      DEFINE 
      LDA QHEDP        AN EMPTY 
      INA                QUEUE
      STA QTAIL 
* 
      LDA QHEDP      => TO QHEAD/QTAIL
      LDB ELMP1      ENQUE ELEM1
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+ENQ  =RAM ENQ 
      RSS            EMPTY QUEUE RETURN 
      JMP ENQ12      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ17      ERROR
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      LDB ELMP3      ENQUE ELEM3
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+ENQ  =RAM ENQ 
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ17      ERROR
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      LDB ELMP2      PRIORITY ENQUE 
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+PENQ  OF ELEM2
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ17      ERROR
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      LDB ELMP5      ENQUE ELEM5
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+ENQ  =RAM ENQ 
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ17      ERROR
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      LDB ELMP4      ENQUE ELMP4
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+ENQ  =RAM ENQ 
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ17      ERROR
* 
* 
* 
* SCAN THROUGH QUEUE TO CHECK FOR CORRECTNESS 
* 
      LDA QHEAD     => TO FIRST ELEMENT 
      LDB A,I       GET IT
      CPB .+1       SHOULD BE ONE 
      RSS 
      JMP ENQ15      ENQ OR PENQ ERROR
      ADA .-1 
      LDA A,I        => TO NEXT ELEMENT 
      LDB A,I        GET IT 
      CPB .+2        SHOULD BE 2
      RSS 
      JMP ENQ15      ENQ OR PENQ ERROR
      ADA .-1 
      LDA A,I        => TO NEXT ELEMENT 
      LDB A,I        GET IT 
      CPB .+3        SHOULD BE 3
      RSS 
      JMP ENQ15      ENQ OR PENQ ERROR
      ADA .-1 
      LDA A,I        => TO NEXT ELEMENT 
      LDB A,I        GET IT 
      CPB .+4        SHOULD BE 4
      RSS 
      JMP ENQ15      ENQ OR PENQ ERROR
      ADA .-1 
      LDA A,I        => TO NEXT ELEMENT 
      LDB A,I        GET IT 
      CPB .+5        SHOULD BE 5
      RSS 
      JMP ENQ15      ENQ OR PENQ ERROR
      CPA QTAIL      QTAIL SHOULD POINT TO THIS 
      RSS              ENTRY
      JMP ENQ15      ENQ OR PENQ ERROR
* 
* 
** TEST DEQUE 
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP 
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+DEQ  DEQUE 1ST ENTRY
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      AND .+13B      A,E AND O SHOULD BE UNCHANGED
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ21      ERROR
      LDB B,I 
      CPB .+1        SHOULD BE 1
      RSS 
      JMP ENQ16      DEQ ERROR
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+DEQ  DEQUE 2ND ENTRY
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      AND .+13B      A,E AND O SHOULD BE UNCHANGED
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ21      ERROR
      LDB B,I 
      CPB .+2        SHOULD BE 2
      RSS 
      JMP ENQ16      DEQ ERROR
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+DEQ  DEQ 3RD ENTRY
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      AND .+13B      A,E AND O SHOULD BE UNCHANGED
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ21      ERROR
      LDB B,I 
      CPB .+3        SHOULD BE 3
      RSS 
      JMP ENQ16      DEQ ERROR
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+DEQ  DEQUE 4TH ENTRY
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      AND .+13B      A,E AND O SHOULD BE UNCHANGED
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ21      ERROR
      LDB B,I 
      CPB .+4        SHOULD BE 4
      RSS 
      JMP ENQ16      DEQ ERROR
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+DEQ  DEQUE 5TH ENTRY
      JMP ENQ11      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      AND .+13B      A,E AND O SHOULD BE UNCHANGED
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ21      ERROR
      LDB B,I 
      CPB .+5        SHOULD BE 5
      RSS 
      JMP ENQ16      DEQ ERROR
* 
* THE QUEUE IS NOW EMPTY
* 
      JSB RANEO      PUT RANDOM VALUES INTO E/O 
      LDA QHEDP      => TO QHEAD/QTAIL
      JSB SAVRG      RECORD REGISTER VALUES 
      ABS 105000B+DEQ  DEQUE
      RSS            EMPTY RETURN 
      JMP ENQ12      ERROR, WRONG RETURN TAKEN
      JSB REGCK      CHECK IF REGS HAVE CHANGED 
      LDA REGST 
      AND .+13B      A,E AND O SHOULD BE UNCHANGED
      SZA            ALL REGISTERS RESTORED?
      JMP ENQ21      ERROR
* 
      LDA QHEAD      QHEAD SHOULD 
      SZA              BE ZERO
      JMP ENQ13      ERROR
      LDA QHEDP      QTAIL SHOULD POINT 
      INA              TO ITSELF
      CPA QTAIL 
      RSS 
      JMP ENQ14      ERROR
      JMP TST01,I 
* 
* 
* 
* ERROR EXITS 
* 
ENQ11 JSB ERMS,I
      DEF MS041 
      JMP TST01,I 
ENQ12 JSB ERMS,I
      DEF MS042 
      JMP TST01,I 
ENQ13 JSB ERMS,I
      DEF MS043 
      JMP TST01,I 
ENQ14 JSB ERMS,I
      DEF MS044 
      JMP TST01,I 
ENQ15 JSB ERMS,I
      DEF MS045 
      JMP TST01,I 
ENQ16 JSB ERMS,I
      DEF MS046 
ENQ17 JSB ERMS,I
      DEF MS047 
      JMP TST01,I 
ENQ21 JSB ERMS,I
      DEF MS051 
      JMP TST01,I 
* 
* 
* 
QHEDP DEF QHEAD 
QHEAD BSS 1 
QTAIL BSS 1 
* 
* 
* ELEMENTS
* 
      BSS 1 
ELEM1 DEC 2 
* 
      BSS 1 
ELEM2 DEC 1 
* 
      BSS 1 
ELEM3 DEC 3 
* 
      BSS 1 
ELEM4 DEC 5 
* 
      BSS 1 
ELEM5 DEC 4 
* 
* 
ELMP1 DEF ELEM1 
ELMP2 DEF ELEM2 
ELMP3 DEF ELEM3 
ELMP4 DEF ELEM4 
ELMP5 DEF ELEM5 
* 
* 
*