* EXIT: 
*         A = TRACK/SECTOR
*         B IS SAVE 
* 
STT.S NOP           SECT. TO T/S
      STB T.STM+1   SAVE B FOR EXIT 
      CLB 
      JSB DIV       CALC. NO. TRKS. PLUS REMAINDER
      DEF SECTR 
      SOC           OVERFLOW? 
      JSB ER23      YES, ERROR SHOULD NOT OCCUR 
      ALF,ALF       SAVE NO. TRACKS IN HI 8 BITS
      ADA B         INCLUDE NO. SECTORS 
      LDB T.STM+1   RESTORE B 
      JMP STT.S,I   RETURN
      SKP 
* STZ   - STORE ZEROS INTO A BUFFER (STSPC STORES SPACES) 
* ENTER:
*         A = (-) NO. OF WORDS TO CLEAR 
*         B = STARTING ADDR. OF 1ST WORD
* EXIT: 
*         A = 0 
*         B = POINTER TO END-OF-BUFFER + 1
* 
STZ   NOP           STORE ZEROS 
      STA STZX1     SAVE NO. WORDS TO MOVE,(-). 
      CLA 
      STA B,I       PACK W/ ZEROS 
      INB           BUMP POINTER TO BUFFER
      ISZ STZX1     FINISHED? 
      JMP *-3       NO
      JMP STZ,I     RETURN
STZX1 OCT 0         INDEX REG 
      SKP 
* GRTXX - GENERAL READ FOR DISC TRACK X SECTOR X
* ENTER:
*         A = TRACK/SECTOR
*         B = ADDRESS OF BUFFER 
*         GNS = NO. OF SECTORS TO MOVE
*         GSC = SUB CH. 
* EXIT: 
*         BUFFER TRANSFERRED FROM DISC
* 
GRTXX NOP           GENERAL READ TRACK X SECT. X
      STB GBUF      SAVE BUFFER LOC.
      LDB REQCD     READ REQUEST CODE 
      JSB GRWSU     GENERAL R/W SETUP 
      JMP GRTXX,I   RETURN
      SPC 1 
GRWSU NOP           GENERAL R/W SETUP 
      STB REQC      SAVE REQUEST CODE 
      STA DRWBF     PACK T/S
*  CHECK TO INSURE T/S DOES NOT OVERFLOW
      JSB T.STS 
      ADA GNS       CALC. LAST TK. TO BE ACCESSED 
      CMA,INA 
      STA DRWBF+2   SAVE TEMPORARILY
      LDA SECTR     SECT./TK. 
      LDB D200
      JSB MPY       CALC. ABSOLUTE SECTORS
      LDB GNS       NO. SECT. TO TRANSFER 
      CLE           THIS IS A 16 BIT ARITHMETIC COMPARE 
      ADA DRWBF+2   CALC. OVERFLOW IF ANY 
      SEZ,RSS       OVERFLOW? 
      ADB A         YES, TRANSFER UP TO MAX AVAILABLE 
      LDA D128      WORDS/SECT. 
      JSB MPY       CALC. NO. WDS. TO TRANSFER
      STA DRWBF+2   NO. WORDS TO TRANSFER 
      LDB GSC       SUB CH. TO BE USED
      JSB CKDRI     CHECK DRIVE 
      LDA ADRWB     ADDR OF R/W BUFFER
      LDB REQC      REQUEST CODE
      OCT 0         FOR DEBUGGING 
      JSB $DISC 
      OCT 0         FOR DEBUGGING 
      JMP GRWSU,I   RETURN
ADRWB DEF DRWBF 
DRWBF EQU *         DISC R/W BUFF.
      OCT 0         DISC T/S
GBUF  OCT 0         ADDR. OF I/O BUFF.
      OCT 0         WORD COUNT
      SPC 1 
* CKDRI - CHECK DRIVE NO. 
* ENTER:
*        B = DESIRED SUB CH.
* EXIT: 
*        CUDSC PACKED 
*        CRFLG SET IF NECESSARY 
*        CUDLA SET IF NECESSARY 
CKDRI NOP           CHECK DRIVE 
      LDA CUDSC     CURRENT SUB CH. 
      OCT 0         FOR DEBUGGING 
      STB CUDSC     CUR. USER DISC SUB CH.
      CPB SYSSC     SYSTEM SUB CH?
      RSS           YES 
      ISZ CRFLG     SET DVR FLAG TO USER DISC 
      ARS           CALC. DRIVE NO. 
      BRS           CALC. DRIVE NO. 
      CPA B         SAME DRIVE? 
      JMP *+3       YES 
      LDA L8BT      NO
      STA CUDLA     FORCE LAST T/S TO BE MAX
      JMP CKDRI,I 
      SPC 3 
* GWTXX - GENERAL WRITE FOR DISC TRACK X SECTOR X 
* ENTER:
*         SAME AS GRTXX 
* EXIT: 
*         SAME AS GRTXX 
* 
GWTXX NOP           GENERAL WRITE TRACK X SECT. X 
      STB GBUF      SAVE BUFFER LOC.
      LDB REQCD+1   WRITE REQUEST CODE
      JSB GRWSU     GENERAL R/W SETUP 
      JMP GWTXX,I   RETURN
GSC   OCT 0         SUB CH. FOR GENERAL R/W 
GNS   OCT 0,0       NO. SECT, NO. WORDS TO XFER 
REQC  OCT 0         REQUEST CODE
      SKP 
* RTXSX - READ TRACK X SECTOR X INTO $BUF.
* ENTER:
*         TRKIO = TRACK NO. 
*         SECIO = SECTOR NO.
* EXIT: 
*         TK X SEC X PUT INTO $BUF. 
* 
RTXSX NOP           READ TK X SECT X
      LDB TRKIO     GET TRACK NO. 
      BLF,BLF       PUT TK. NO. IN HI BITS
      STB DRWBF 
      LDB REQCD     READ
RTSXX EQU * 
      LDA SECIO     GET SECTOR NO.
      IOR DRWBF     PACK SECT. NO.
      STA DRWBF     SAVE T/S
      LDA A$BUF     ADDR. OF I/O BUFF.
      STA DRWBF+1 
      LDA D128      WORDS/SECT. 
      STA DRWBF+2 
      LDA ADRWB     ADDR. OF CALL BUFFER
      JSB $DISC 
      CLA 
      STA XFLG      CLEAR INVALID SUB CH. FLAG RETURN 
      JMP RTXSX,I   RETURN
A$BUF DEF $BUF
REQCD EQU D1
      SPC 3 
* WTXSX - WRITE TRACK X SECTOR X FROM $BUF
* ENTER:
*         TRKIO = TRACK NO. 
*         SECIO = SECTOR NO.
* EXIT: 
*         TRACK X SECTOR X ON DISC FROM $BUF
* 
WTXSX NOP           WRITE TK. X SECT. X 
      LDB TRKIO     GET TRACK NUMBER
      BLF,BLF       PUT TK. NO. IN HI 8 BITS
      STB DRWBF     SAVE IT TEMP. 
      LDB WTXSX 
      STB RTXSX     PACK RETURN ADDR. 
      LDB REQCD+1   WRITE 
      JMP RTSXX 
      SKP 
*GETDE - GET DIRECTORY ENTRY
* ENTER:
*         B = ADDR OF OPEN TABLE ENTRY
* EXIT: 
*         CNAME = ADDR OF DIRECTORY ENTRY 
*         TRKIO = TRACK OF DIRECTORY SECTOR 
*         SECIO = SECTOR OF DIRECTORY ENTRY 
* 
GETDE NOP 
      STB ANAME     SAVE ADDR OF NAME 
      ADB D9        INCREMENT TO DIREC ENT T/S FIELD
      LDA B,I       GET DIREC ENTRY T/S 
      JSB PRETS     PREPARE T/S FOR I/O 
      LDB PAKSC     GET SUBCHANNEL
      CLA           READ SWITCH 
      JSB PRWIO     READ DIRECTORY SECTOR 
      LDB A$BUF     GET ADDR OF $BUF
      STB CNAME     STORE IT
NDIRE EQU * 
      LDA ANAME     GET ADDR OF FILE NAME 
      JSB CMPAR     EQUAL TO CURRENT ENTRY ?
      RSS           NO
      JMP GETDE,I   YES, RETURN 
      LDB CNAME     GET ADDR OF CURRENT ENTRY 
      ADB D9        INCREMENT TO NEXT ENTRY 
      STB CNAME     STORE NEW ADDR
      JMP NDIRE     CONTINUE
CNAME BSS 1         ADDR OF ENTRY 
ANAME BSS 1         ADDR OF DESIRED FILE NAME 
      SPC 3 
* CNVDA - CONVERT DECIMAL TO ASCII
* ENTER:
*        A = DECIMAL VALUE TO CONVERT(0-999)
*        B = ADDR OF ASCII OUTPUT 
* EXIT: 
*        FIRST 3 BYTES OF ADDR GIVEN IN B = ASCII VALUE 
CNVDA NOP 
      STA DECVL     SAVE DECIMAL VALUE
      STB ASCVL     SAVE ADDR OF OUTPUT 
      CLB           CLEAR HI DIVIDEND 
      JSB DIV       DIVIDE BY 100 
      DEF D100
      STB DECVL     SAVE REMAINDER
      IOR AMASK     CONVERT QUOTIENT TO ASCII(100'S)
      ALF,ALF 
      STA ASCVL,I   STORE 1ST ASCII CHARACTER(100'S)
      CLB           CLEAR HI DIVIDEND 
      LDA DECVL     INIT LO DIVIDEND
      JSB DIV       DIVIDE BY 10
      DEF D10 
      STB DECVL     SAVE REMAINDER
      IOR AMASK     CONVERT QUOTIENT TO ASCII(10'S) 
      XOR ASCVL,I 
      STA ASCVL,I   STORE 2ND ASCII CHARACTER(10'S) 
      LDA DECVL     GET REMAINDER(1'S)
      IOR AMASK     CONVERT TO ASCII CHARACTER
      ALF,ALF 
      LDB ASCVL 
      ADB D1
      STA B,I       STORE 3RD ASCII CHARACTER(1'S)
      JMP CNVDA,I   RETURN
DECVL BSS 1         DECIMAL VALUE SAVE AREA 
ASCVL BSS 1         ADDR OF OUTPUT AREA 
AMASK OCT 60        MASK FOR CONVERSION 
      SPC 3 
* CNPND - CONVERT PACK NUMBER TO DECIMAL
* ENTER:
*     A = ADDR OF 3RD CHAR OF PACK NAME 
* EXIT: 
*         P+1 = NOT DECIMAL 
*         P+2 = DECIMAL 
*               A = DECIMAL PACK NO.
*               DPNO = DECIMAL PACK NO. 
* 
CNPND NOP 
      STA PNADR     SAVE ADDR OF PACK NO. 
      LDA A,I       GET FIRST CHAR
      ALF,ALF 
      JSB ASDEC     CONVERT TO DECIMAL
      JMP CNPND,I   RETURN P+1
      STA DPNO      STORE RESULT
      LDA PNADR,I   GET 2ND CHAR
      JSB ASDEC     CONVERT TO DECIMAL
      JMP CNPND,I  RETURN P+1 
      STA DECPN     SAVE RESULT 
      LDA DPNO      CALCULATE INTERMEDIATE RESULT 
      LDB D10 
      JSB MPY 
      ADA DECPN 
      STA DPNO      SAVE INTERMEDIATE RESULT
      LDB PNADR     GET 3RD CHAR
      ADB D1
      LDA B,I 
      ALF,ALF 
      JSB ASDEC     CONVERT TO DECIMAL
      JMP CNPND,I  RETURN P+1 
      STA DECPN     SAVE RESULT 
      LDA DPNO      CALCULATE FINAL RESULT
      LDB D10 
      JSB MPY 
      ADA DECPN 
      STA DPNO      SAVE RESULT 
      ISZ CNPND     P+2 
      JMP CNPND,I   RETURN
PNADR BSS 1         ADDR OF PACK NO.
DPNO  BSS 1         DECIMAL TOTAL 
DECPN BSS 1         DECIMAL VALUE 
      SPC 3 
* CKSPC - CHECK FOR SUFFICIENT FILE SPACE 
* ENTER:
*         PNEAD = ADDR OF PACK NO. ENTRY
*         NOSEC = NO. SECTORS 
* EXIT: 
*         P+1 = INSUFFICIENT SPACE
*         P+2 = SUFFICIENT SPACE
* 
CKSPC NOP 
      LDA PNEAD     GET ADDR OF PACK NO. ENTRY
      ADA D3        INCREMENT TO LAST SECTOR ALLOCATED
      LDB A,I       GET LAST SECTOR ALLOCATED 
      CMB,INB       COMPUTE TOTAL SECTORS UNUSED
      ADA MD2 
      ADB A,I 
      STB SECLF     SAVE COUNT OF UNUSED SECTORS
      LDA NOSEC     GET NO. OF SECTORS NEEDED 
      CMA,INA 
      ADA SECLF 
      SSA           ENOUGH SECTORS AVAILABLE ?
      JMP CKSPC,I   NO, RETURN P+1
      ISZ CKSPC     YES, P+2
      JMP CKSPC,I   RETURN
SECLF BSS 1         NO. OF UNUSED SECTORS 
      SPC 3 
* STPNO - STORE PACK NO  ENTRY OFFSET 
* ENTER:
*         A = ADDR OF OPEN TABLE ENTRY
*         PNEAD = ADDR OF PACK NO. ENTRY
* EXIT: 
*         PACK NO. OFFSET STORED IN OPEN TABLE ENTRY
* 
STPNO NOP 
      STA OTEAD     SAVE OPEN TABLE ENTRY ADDR
      ADA D2        INCREMENT TO PACK NO. OFFSET FIELD
      LDA A,I       GET PACK NO. OFFSET 
      AND H8BT      ZERO IT 
      LDB OTEAD 
      ADB D2
      STA B,I       STORE IT
      LDA OPNTB     GET START OF OPEN TABLE 
      CMA,INA 
      ADA PNEAD     GET START OF PACK NO. ENTRY 
      CLB           CALCULATE OFFSET
      JSB DIV 
      DEF D4
      LDB OTEAD     GET OPEN TABLE ENTRY
      ADB D2        INCREMENT TO PACK NO. OFFSET FIELD
      XOR B,I 
      STA B,I       STORE PACK NO. OFFSET 
      JMP STPNO,I   RETURN
OTEAD BSS 1         ADDR OF OPEN TABLE ENTRY
      SPC 3 
* SFSTS - STORE FIRST T/S OF THE FILE 
* ENTER:
*         A = ADDR OF OPEN TABLE ENTRY(REL SECTOR OFFSET IN 4TH WORD) 
*         PNEAD = ADDR OF PACK NO. ENTRY
* 
* EXIT: 
*         STARTING T/S STORED IN OPEN TABLE ENTRY 
* 
SFSTS NOP 
      STA OTEAD     SAVE OPEN TABLE ENTRY ADDR
      LDA PNEAD,I   GET STARTING T/S OF PCAK NO.
      JSB T.STS     CONVERT TO SECTORS
      LDB OTEAD     GET OPEN TABLE ENTRY ADDR 
      ADB D3        INCREMENT TO SECTOR FIELD 
      ADA B,I       ADD REL SECTOR OFFSET 
      ADA MD1       ADJUST TO STARTING REL SECTOR 
      JSB STT.S     CONVERT TO T/S
      STA B,I       STORE STARTING T/S IN OPEN TABLE
      JMP SFSTS,I   RETURN
      SPC 3 
*PRETS - PREPARE TRACK/SECTOR 
*ENTER: 
*        A = TRACK/SECTOR 
*EXIT:
*        TRKIO = TRACK NO.
*        SECIO = SECTOR NO. 
PRETS NOP 
      STA TSTMP     SAVE THE T/S
      ALF,ALF       SHIFT TRACK NO. TO RIGHT MOST BYTE
      AND L8BT      ZERO LEFT MOST BYTE 
      STA TRKIO     STORE TRACK NUMBER
      LDA TSTMP     GET THE T/S 
      AND L8BT      ZERO LEFT MOST BYTE 
      STA SECIO     STORE SECTOR NUMBER 
      JMP PRETS,I   RETURN
TSTMP OCT 0         TEMPORARY 
      SPC 3 
*PRWIO - PREPARE FOR READ/WRITE 
*ENTER: 
*        A = 0(READ)/1(WRITE) 
*        B = SUBCHANNEL NO. 
*EXIT:
*        TRK X SEC X ON DISC FROM $BUF
PRWIO NOP 
      STA RWSWH     SAVE READ/WRITE SWITCH
      CPB SYSSC     SYSTEM SUBCHANNEL 
      RSS           YES 
      JSB CKDRI     NO, CHECK THE DRIVE 
      LDB RWSWH     GET READ/WRITE SWITCH 
      SZB           READ ?
      JMP WXX       NO
      JSB RTXSX     YES, READ THE RECORD
      JMP PRWIO,I   RETURN
WXX   EQU * 
      JSB WTXSX     WRITE THE RECORD
      JMP PRWIO,I   RETURN
RWSWH OCT 0         TEMPORARY 
      SPC 3 
* CKPNT - CHECK FOR AN AVAILABLE ENTRY OR AN EXISTING ENTRY 
* ENTER:
*         A = 0(CHECK FOR AN AVIALABLE ENTRY) 
*           = 1(CHECK FOR AN EXISTING ENTRY)
*         B = PACK NO.(IGNORED IF A IS NOT 1) 
* EXIT: 
*         P+1 = NO ENTRY AVAILABLE/NO ENTRY FOUND 
*         P+2 = ENTRY FOUND/ENTRY AVAILABLE 
*               PNEAD = ADDR OF FOUND/AVAILABLE ENTRY 
*               PAKSC = PACK SUBCHANNEL OF FOUND ENTRY
* 
CKPNT NOP 
      SZA           CHECK FOR AN AVAILABLE ENTRY
      JMP CKEXE     NO
      LDB NXPTL     GET NEXT AVAILABLE ENTRY ADDR 
      CPB FTRBE     END OF PACK NO. ENTRIES ? 
      JMP CKPNT,I   YES, RETURN P+1 
      STB PNEAD     NO, STORE NEXT ENTRY ADDR 
      ISZ CKPNT     P+2 
      JMP CKPNT,I   RETURN
CKEXE EQU * 
      LDA OPNT1     GET START OF OPEN TABLE FILE ENTRY
CKXPN EQU * 
      CPA NXOTL     END OF OPEN TABLE ACTIVE ENTRIES ?
      JMP CKPNT,I   YES, RETURN P+1 
      ADA D10       INCREMENT TO PACK NO. 
      CPB A,I       EQUAL TO REQUESTED PACK NO. ? 
      JMP PNFND     YES 
      ADA D6        INCREMENT TO NEXT ENTRY 
      JMP CKXPN     CONTINUE SEARCH 
PNFND EQU * 
      ADA D2        INCREMENT TO SUBCHANNEL FIELD 
      LDB A,I       GET SUBCHANNEL
      STB PAKSC     STORE PACK SUBCHANNEL 
      ADA MD10      BACK UP TO PACK NO. ENTRY NO. FIELD 
      LDB A,I       GET PACK NO. ENTRY NO.
      LDA B         TRANSFER TO 'A' FOR 'AND' 
      AND L8BT      CLEAR MEANINGLESS BITS
      LDB D4
      JSB MPY       CALC. OFFSET
      ADA OPNTB     CALCULATE ENTRY ADDR
      STA PNEAD     STORE PACK NO ENTRY ADDRESS 
      ISZ CKPNT     P+2 
      JMP CKPNT,I   RETURN
PNEAD BSS 1    PACK NO. ENTRY ADDR
      SPC 3 
* MVPNT - MOVE PACK NO. TABLE 
* ENTER:
*         A = OFFSET IN LO 8 BITS OF PACK NO. ENTRY 
*             WHICH HAS HAD AN OPEN TABLE FILE ENTRY DELETED
* EXIT: 
*         UPDATED PACK NO. TABLE(IF NEEDED) 
* 
MVPNT NOP 
      AND L8BT      CLEAR LEFT BYTE 
      STA OFFST     SAVE PACK NO. OFFSET
      LDB OPNT1     GET FIRST OPEN TABLE ENTRY
NXOTE EQU * 
      CPB NXOTL     END OF ENTRIES
      JMP UPNTB     YES 
      ADB D2        INCREMENT TO PACK NO. OFFSET
      LDA B,I       GET PACK NO. OFFSET 
      AND L8BT      CLEAR LEFT BYTE 
      CPA OFFST     EQUAL TO OFFSET OF DELETED FILE ENTRY 
      JMP MVPNT,I   YES, RETURN 
      ADB D14       NEXT OPEN TABLE ENTRY 
      JMP NXOTE     CONTINUE
UPNTB EQU * 
      LDA OFFST     GET DELETED OFFSET
      STA OFFS1     STORE IT
      LDB D4
      JSB MPY 
      ADA OPNTB 
UNXEN EQU * 
      ADA D4        INCREMENT TO NEXT ENTRY 
      CPA NXPTL     END OF PACK NO. ENTRIES ? 
      JMP UNXPT     YES 
      STA SVPNA     SAVE PACK NO. ENTRY ADDR
      LDB A         SAVE ADDR OF CURRENT ENTRY TO MOVE
      ADB MD4       BACK TO FIRST WORD OF NEW ENTRY TO USE
      STB NEADR     STORE ADDR OF NEW ENTRY 
MNXWD EQU * 
      LDB A,I       MOVE WORD 
      STB NEADR,I 
      LDB NEADR     INCREMENT TO NEXT WORD
      ADB D1
      STB NEADR 
      CPB SVPNA     ENTRY MOVED ? 
      JMP UDONE     YES 
      ADA D1        INCREMENT TO NEXT WORD
      JMP MNXWD     MOVE NEXT WORD
UDONE EQU * 
      LDB OFFST     GET DELETED OFFSET
      ADB D1        INCREMENT 
      STB OFFS1     SAVE OFFSET TO CHANGE 
      LDB OPNT1     GET START OF OPEN TABLE FILE ENTRIES
CNXOT EQU * 
      CPB NXOTL     END OF OPEN TABLE ENTRIES 
      JMP CKMPN     YES 
      ADB D2        INCREMENT TO PACK NO. OFFSET
      LDA B,I       GET PACK NO.
      AND L8BT      CLEAR LEFT BYTE 
      CPA OFFS1     OFFSETS EQUAL ? 
      RSS           YES 
      JMP INXOT     NO
      LDA B,I       GET PACK NO.
      AND H8BT      CLEAR RIGHT BYTE
      STA B,I       STORE 
      LDA OFFST     GET NEW OFFSET
      XOR B,I 
      STA B,I       STORE NEW OFFSET
INXOT EQU * 
      ADB D14       INCREMENT TO NEXT OPEN TABLE ENTRY
      JMP CNXOT     GO CHECK NEXT ENTRY 
CKMPN EQU * 
      LDA OFFST     GET OFFSET TO CHANGE
      ADA D1        INCREMENT 
      STA OFFST     STORE 
      LDA SVPNA     GET PACK NO. ENTRY ADDR.
      JMP UNXEN     CONTINUE
UNXPT EQU * 
      LDA NXPTL     UPDATE NEXT PACK NO. ENTRY ADDR 
      ADA MD4 
      STA NXPTL 
      JMP MVPNT,I   RETURN
OFFST BSS 1         OFFSET TO CHANGE
OFFS1 BSS 1         NEW OFFSET
SVPNA BSS 1         CURRENT PACK NO. ENTRY ADDR 
NEADR BSS 1         NEW ENTRY ADDR
      SPC 3 
* SVPNS - SAVE ARGUEMENTS FOR PACK NO. SEARCH 
* EXIT:   SEARCH ARGUMENTS SAVED
* 
SVPNS NOP 
      LDA MD9       NO. OF WORDS TO SAVE
      STA MOVCT     SAVE MOVE COUNT 
      LDA ATRKI     ADDR OF ARGUMENTS TO SAVE 
      LDB ASRCS     ADDR OF SAVE AREA 
      JSB MOVE      SAVE THE ARGUMENTS
      JMP SVPNS,I   RETURN P+1
ASRCS DEF SRCSV     ADDR OF SAVE AREA 
SRCSV BSS 9         SAVE AREA 
      SPC 3 
* REPNS - RESTORE ARGUMENTS FOR PACK NO. SEARCH 
* EXIT:   SEARCH ARGUMENTS RESTORED 
* 
REPNS NOP 
      LDA MD9       NO. OF WORDS TO RESTORE 
      STA MOVCT     SAVE MOVE COUNT 
      LDA ASRCS     GET ADDR OF SOURCE
      LDB ATRKI     GET ADDR OF RESTORE AREA
      JSB MOVE      RESTORE THE ARGUMENTS 
      CLA           READ
      LDB PAKSC     GET THE SUBCHANNEL
      JSB PRWIO     RESTORE $BUF
      JMP REPNS,I   RETURN P+1
      SPC 3 
* EXIT: 
*         A = CHECKSUM
* 
CKSUM NOP 
      LDB OPNTB     GET START OF OPEN TABLE(1ST PN ENTRY) 
      CCA           START AT -1 
PNLOP EQU * 
      CPB NXPTL     END OF PN ENTRIES ? 
      JMP SUMOE     YES 
      XOR B,I       COMPUTE CHECK SUM 
      ADB D1        INCREMENT TO NEXT CHECK SUM WORD
      JMP PNLOP     CHECK FOR END OF PN ENTRIES 
SUMOE EQU * 
      LDB OPNT1     GET START OF OPEN TABLE ENTRIES 
DELOP EQU * 
      CPB NXOTL     END OF OPEN TABLE ENTRIES ? 
      JMP CKSUM,I   YES 
      ADB D2        INCREMENT TO FIRST CHECK SUM WORD 
      XOR B,I       COMPUTE CHECK SUM 
      INB           INCREMENT TO NEXT CHECK SUM WORD
      XOR B,I       COMPUTE CHECK SUM 
      ADB D6        INCREMENT TO SECOND CHECK SUM WORD
      XOR B,I       COMPUTE CHECK SUM 
      INB           INCREMENT TO NEXT CHECK SUM WORD
      XOR B,I       COMPUTE CHECK SUM 
      ADB D2        INCREMENT TO NEXT CHECK SUM WORD
      XOR B,I       COMPUTE CHECK SUM 
      ADB D4        INCREMENT TO NEXT OPEN TABLE ENTRY
      JMP DELOP     NO
      HED MULTIPLY AND DIVIDE ROUTINES
* MPY - MULTIPLY TWO SIXTEEN BIT NUMBERS
* ENTER : 
*         A = MULTIPLICAND
*         B = MULTIPLIER
* 
* EXIT :
*         A = LEAST SIGNIF. VALUE 
*         B = MOST SIGNIF. VALUE
* 
      IFZ 
MPY   NOP 
      STB MULPL     STORE MULTIPLIER
      OCT 100200    MULTIPLY
      DEF MULPL     ADDR OF MULTIPLIER
      JMP MPY,I 
      XIF 
      SPC 3 
      IFN 
MPY   NOP 
      STA MPYTM     SAVE MULTIPLICAND 
      LDA MD16      MAX NO. OF SHIFTS 
      STA MPYX1 
      CLA           INITIALIZE PRODUCT
NXTBT EQU * 
      CLE,ELA 
      ELB 
      SEZ,CLE 
      ADA MPYTM 
      SEZ 
      INB 
      ISZ MPYX1 
      JMP NXTBT 
      JMP MPY,I 
MPYTM OCT 0         TEMP. STORAGE 
MPYX1 OCT 0         INDEX REG.
      XIF 
* DIV - DIVIDE A 32 BIT NUMBER BY A 16 BIT NUMBER 
* ENTER:
*         A = LEAST SIGNIF. VALUE OF DIVIDEND 
*         B = MOST SIGNIF. VALUE OF DIVIDEND
*         CONTENTS OF 'DIV' = ADDR OF ADDR OF DIVISOR 
* 
* EXIT: 
*         A = QUOTIENT
*         B = REMAINDER 
*         RETURN P+2
* 
      IFZ 
DIV   NOP 
      STB SCRTH     SAVE HIGH DIVIDEND
      LDB DIV,I     GET ADDR OF DIVISOR 
      LDB B,I       GET DIVISOR 
      STB MULPL     STORE FOR DIVIDE
      LDB SCRTH     RESTORE HIGH DIVIDEND 
      OCT 100400    DIVIDE
      DEF MULPL     ADDR OF DIVISOR 
      ISZ DIV       P+2 
      JMP DIV,I     RETURN
MULPL OCT 0         DIVISOR 
SCRTH OCT 0         TEMP
      XIF 
      SPC 3 
      IFN 
DIV   NOP 
      STB TEMPP     SAVE HI DIVIDEND
      LDB DIV,I     GET ADDR OF DIVISOR 
      LDB 1,I       GET DIVISOR 
      ISZ DIV       BUMP RETURN 
      SZB,RSS       ZERO DIVISOR
      JMP OVFLO     YES 
      CLE,SSB       SET B TO ABS AND E TO SIGN
      CMB,CME,INB 
      STB PLUSD     STORE POSITIVE DIVISOR
      CMB,INB 
      STB MIND      STORE NEGATIVE DIVISOR
      LDB M16 
      STB COUNT     INITIALIZE COUNTER
      LDB MD2 
      STB SIGNN 
      STB RSIGN     INITIALIZE SIGNS
      LDB TEMPP 
      SSB,RSS       TEST DIVIDEND SIGN
      JMP DIV1      POSITIVE
      ISZ RSIGN     SET REMAINDER SIGN NEGATIVE 
      CMB,CME     COMPLEMENT THE DOUBLE LENGTH
      SZA           DIVIDEND AND E BIT
      CMA,INA,RSS 
      INB 
DIV1  SEZ           TEST QUOTIENT SIGN
      ISZ SIGNN     IF NEG SET SIGN TO SAY NEG QUOT 
      ADB MIND      OVERFLOW ?
      SSB,RSS 
      JMP OVFLO 
      ADB PLUSD 
LOOP  CLE,ELA       SHIFT 
      ELB 
      ADB MIND      TEST
      SSB,RSS 
      INA,RSS       DIVIDE O. K. ?
      ADB PLUSD     NO DIVIDE 
      ISZ COUNT     ANY MORE ?
      JMP LOOP      YES 
      CMA,INA,SZA   SET QUOTIENT TO NEGATIVE
      SSA           AND MAKE SURE 
      RSS           THERE IS NO OVERFLOW
      JMP OVFLO     OVERFLOW
      CLO 
      ISZ SIGNN     IF POSITIVE 
      CMA,INA       TWO'S COMPLEMENT
      ISZ RSIGN     TWST FOR CORRECT QUOTIENT 
      JMP DIV,I 
      CMB,INB,RSS 
OVFLO STF 1         SET OVERFLOW BIT
      JMP DIV,I     RETURN
TEMPP BSS 1 
PLUSD BSS 1 
MIND  BSS 1 
M16   DEC -16 
COUNT BSS 1 
SIGNN BSS 1 
RSIGN BSS 1 
      END 
                                                                                                                                                                  