      HED START 
      ORG 2000B 
*     START 
*     INITIALIZES PROGRAM AND STUFFS HALTS INTO LOW CORE
* 
START CLC 0,C       TURN EVERYTHING OFF 
      LDA 106B      LAST WORD OF AVAILABLE MEMROY 
      STA LWAM        STORE IT IN LWAM
      JSB TTYCK     IS TTY AVAILABLE? 
      JMP AGAIN     NO
      CLA 
H0    JSB PRINT     CARTRIDGE DISK MEMORY DIAGNOSTIC
AGAIN EQU * 
      LDB D2        TRAP CELL LOCATION
      LDA THLT2     TRAP CELL HALT
OLP   STA B,I 
      INB 
      INA 
      CPB B100      TRAP CELL HALTS COMPLETE? 
      RSS           YES 
      JMP OLP       NO,REPEAT 
* 
      CLA 
      STA DMSP     SET WORD TO NO-OP
      STA PASS     RESTART
      STA WCNT
      STA CYL 
      STA HEAD
      STA SECTR 
      STA S4BUG 
      LDA BPTR
      STA BUFAD    INITIALIZE BUFAD 
      CLA,INA 
      STA NI
      LDA MM1 
      STA NFFB      RESET STATUS MASK 
      LDA UNITA 
      STA UNIT      UNIT = UNIT TABLE(0)
BGN   EQU * 
      CLA 
      STA ISR       ZERO SWITCH REGISTER SUMMARY
      STA ERR       ZERO NUMBER OF ERRORS 
      STA STEPN     STEP NUMBER = 0 
      CLA,INA      A _ 1
      LDB MDFLG     RESET NI
      CPB B14        IF MULTI-DRIVE CONDITION 
      STA NI          IS TRUE 
      STA SECTN    START WITH SECTION ONE 
      LDA D3
      STA MDFLG 
      LDA UNIT      STUFF 
      ADA ASCZZ      UNIT INTO
      STA P065E,I     PASS MESSAGE
* 
H35   LDA B35       INITIAL STATUS
      STA COPRN 
      LDA DC14      DATA CHANNEL
      JSB CNVS
      LDA CC7       COMMAND CHANNEL 
      JSB CNVS
      CLB 
      STB LOCAL 
      ISZ LOCAL     DELAY,ALLOW FOR 
      JMP *-1        SWITCH THREE TO BE SET 
      LDA UNIT      SAVE
      STA GLOB4      UNIT NUMBER
      CLA 
      STA SHTAS 
* 
*     CLEAR ATTENTION INITIALLY ON ALL DRIVES THAT ARE ONLINE 
* 
      STA UNIT
INST1 EQU * 
      LDA M1024     SET UP FOR 1024 MSEC DELAY
      STA LCNT
INST3 CLA,INA       DELAY 1 MSEC
      JSB TMR,I 
      ISZ LCNT      DONE? 
      RSS           NO
      JMP INST5     YES - GIVE UP 
      JSB STAT      GET STATUS
      AND B104      NRBIT + PBBIT 000104
      CPA PBBIT     IS UNIT READY AND BUSY? 
      JMP INST3     YES - WAIT
INST5 ISZ UNIT      NO - CONTINUE 
      LDA UNIT
      CPA D4        DONE WITH ALL UNITS?
      CLA,RSS       YES 
      JMP INST1     NO - CONTINUE 
HLP2  EQU * 
      STA UNIT      SET UP UNIT NUMBER
      JSB STAT      GET STATUS
      AND NRBIT     IS THIS UNIT READY? 
      SZA           SKIP IF YES 
      JMP HLP3      NO
      JSB SEEK      ISSUE SEEK
      JSB WAITS      TO CLEAR ANY SEEK PROBLEMS 
      JMP HLP1
HLP3  EQU * 
      JSB SEEH      CLEAR STATUS BITS THAT
      JSB WAIH       LATCH
HLP1  LDA UNIT      INCREMENT 
      INA            UNIT NUMBER
      CPA D4        DONE? 
      RSS           YES 
      JMP HLP2      NO,CONTINUE 
      LDA GLOB4 
      STA UNIT
SCALR EQU *         SECTION CALLER
      LDA HDON      SAVE
      STA GLOB2      HEAD ASSIGNMENT
SCAL1 EQU * 
* 
      CLA 
      STA STEPN     STEP NUMBER = 0 
      LDA B35 
      STA COPRN     INITIAL STATUS
      JSB SW2       TEST BIT 2 , RETURN IF SET
CTD   EQU *         PREPARE CYLINDER TABLE
      LDA P024A     INITIALIZE
      STA CPNT       POINTER
      LDA MM10      -10 
      STA CSAVE 
CLOOP ADA TRT       CYLINDER TABLE POINTER
      LDA A,I 
      JSB DECIN     CONVERT NUMBER
      LDA CVT1      USE RIGHT 
      AND B377       CHARACTER
      ALF,ALF         OF
      LDB A            CVT1 
      LDA CVT2          AND 
      AND P7400          LEFT 
      ALF,ALF             CHARACTER 
      IOR B              OF CVT2
      STA CPNT,I       FOR FIRST
      ISZ CPNT          WORD
      LDA CVT2      USE 
      AND B377       RIGHT
      ALF,ALF         CHARACTER 
      IOR B54          OF CVT2
      STA CPNT,I        AND 
      ISZ CPNT           ASCII COMMA
      ISZ CSAVE           FOR 
      LDA CSAVE            SECOND WORD
      SSA 
      JMP CLOOP 
      LDB P024A     REMOVE
      ADB D19        LAST 
      LDA B,I         COMMA 
      AND P7400 
      IOR B40 
      STA B,I 
H24   LDA B24       CYLINDER TABLE CONTENTS 
      JSB PRINT 
      JSB ASK       WISH TO CHANGE? 
      JMP PAT       NO
H26   LDA B26       YES,ENTER CYLINDER NUMBERS
*                                    SEPARATED BY COMMAS
      JSB PRINT 
      JSB HIN       INPUT FROM KEYBOARD 
CTS   JSB DCHAR     GET DECIMAL VALUE 
      JMP CTS1      ERROR OR DONE?
      JSB CSTR      STORE IN TABLE
      JMP CTS       CONTINUE
CTS1  LDA CCNT
      SZA,RSS       SKIP IF ERROR 
      JSB CSTR      DONE
      JMP CTD 
PAT   EQU * 
      JSB SW2       TEST BIT 2 , RETURN IF SET
PAT1  LDA MM1       TWO LINES WILL BE USED
      STA PCNTA 
      LDA PATR      ADDRESS 
      ADA MM10       OF FIRST 
      STA PLOAD       PATTERN 
      LDA P027A     ADDRESS 
      STA PSTOR      OF MESSAGE 
PC    LDA MM5       FIVE PATTERNS PER LINE
      STA PCNT
PB    LDB PSTOR 
      LDA PLOAD,I 
      JSB CNVRT     CONVERT TO ASCII
      ISZ PLOAD 
      LDB PSTOR 
      ADB D3
      LDA BB        TWO ASCII BLANKS
      STA B,I 
      INB 
      STB PSTOR 
      ISZ PCNT      HAVE WE DONE 5 YET? 
      JMP PB        NO
      ISZ PCNTA     YES,HAVE WE DONE TEN? 
      JMP PATT1     YES 
      LDA CRLF      06412 
      STA PSTOR,I 
      ISZ PSTOR 
      JMP PC
PATT1 EQU * 
H27   LDA B27       PATTERN TABLE CONTENTS
      JSB PRINT 
      JSB ASK       WISH TO CHANGE? 
      JMP HD        NO
H30   LDA B30       YES,ENTER PATTERN NUMBERS 
*                                    SEPARATED BY COMMAS
      JSB PRINT 
      JSB HIN       INPUT FROM KEYBOARD 
PTS   JSB OCHAR     GET OCTAL VALUE 
      JMP PTS1      ERROR OR DONE?
      JSB PSTR      STORE IN TABLE
      JMP PTS       CONTINUE
PTS1  LDA CCNT
      SZA,RSS       SKIP IF ERROR 
      JSB PSTR      DONE
      JMP PAT1
HD    EQU * 
      JSB SW2       TEST BIT 2 , RETURN IF SET
HD3   LDA B62       CHOOSE HEAD MODE;A=0,1;B=2,3
*                                    C=0,1 THEN 2,3 
H62   JSB PRINT 
      JSB HIN 
      CLA 
      STA HFLAG 
      LDA BINA,I
      AND P7400 
      XOR HA        =40400
      SZA,RSS 
      JMP HD1 
      XOR HB        =1400 
      SZA,RSS 
      JMP HD2 
      XOR HC        =400
      SZA 
      JMP HD3 
      CLA,INA 
      STA HFLAG 
HD1   CLA,RSS 
HD2   LDA D2
      STA HDON
      JSB SW2       TEST BIT 2 , RETURN IF SET
MAX2  LDA MAX       SET 
      LDB P023A      UP 
      INB             MESSAGE 
      JSB DCIN2 
      LDA CVT3
      STA P023A,I 
      LDA B23 
H23   JSB PRINT     XXXXXX ERRORS/PASS ALLOWED
      JSB ASK       WISH TO CHANGE? 
      JMP MAX3      NO
MAX1  LDA B32 
H32   JSB PRINT     ENTER ERRORS/PASS 
      JSB HIN 
      JSB DCHAR 
      RSS           ERROR OR DONE?
      JMP MAX1      MUST BE DONE
      LDB CCNT
      SZA           MAX MAY NOT BE ZERO 
      SZB           SKIP IF DONE
      JMP MAX1      ERROR 
      STA MAX 
      JMP MAX2
MAX3  EQU * 
      JSB SW2       TEST BIT 2 , RETURN IF SET
*      PREPARE UNIT TABLE 
* 
      LDA UNITC     NUMBER OF UNITS 
      LDB P037A 
      JSB DCIN1     DEPOSIT IN MESSAGE
      LDA UNITC 
      CMA,INA 
      STA CSAVE 
      LDB P037B 
      LDA UNITS 
      STA CPNT
PUNA  LDA CPNT,I    GET UNIT
      ADA B2060     BLANK,0 
      STA B,I       STORE IN MESSAGE
      INB 
      ISZ CPNT
      ISZ CSAVE     DONE? 
      JMP PUNA      NO
      LDA C1440     #,BLANK 
      STA B,I 
      LDA B37 
H37   JSB PRINT     UNIT TABLE/X DRIVE(S);A,B...
      JSB ASK       WISH TO CHANGE? 
      JMP H34H      NO
H34   LDA B34       ENTER UNIT NUMBER(0-3) SEPARATED
*                                    BY COMMAS
      JSB PRINT 
      JSB HIN       INPUT FROM KEYBOARD 
      CLA 
      STA UNITC     NUMBER OF UNITS = 0 
      LDA UNITS 
      STA GLOB3     POINTER FOR UNIT NUMBERS
H34A  JSB OCHAR     GET CHARACTER 
      JMP H34B      ERROR OR DONE 
      JSB H34G      STORE AND CHECK 
      ISZ GLOB3     BUMP POINTER
      LDA UNITC     PROCESS FIRST 
      CPA D4         FOUR ONLY
      JMP H34D      DONE
      JMP H34A      CONTINUE
H34B  LDB CCNT      DONE OR ERROR?
      SZB 
      JMP H34       ERROR (ALREADY REPORTED)
      JSB H34G      STORE AND CHECK 
H34D  EQU * 
      LDA UNITC     SET 
      CMA,INA        UP NUMBER
      STA FL6         OF UNITS
      CLA           ZERO
      STA SHTAS      EXPECTED STATUS
      LDA UNITS     SET 
      STA GLOB4      UP POINTER 
H34F  EQU * 
      LDA GLOB4,I   LOAD UNIT NUMBER
      STA UNIT
      IOR B2060 
      STA PO72A,I 
      JSB STAT      GET STATUS
      AND NRBIT     IS NOT READY BIT SET? 
      SZA           SKIP IF NO
      JSB WCHK      YES,PRINT ERROR 
      LDA STAUS 
      AND PBBIT     IF NOT ONLINE 
      SZA           SKIP IF NO
E72   JSB ERROR     UNIT X NOT READY
      ISZ GLOB4     NEXT UNIT NUMBER
      ISZ FL6       DONE? 
      JMP H34F      NO,CONTINUE 
      LDA UNITA     SWITCH NUMBER 
      STA UNIT
      ADA ASCZZ     SET UP
      STA P065E,I    PASS MESSAGE 
      JMP MAX3
H34H  EQU * 
      JMP SCAL1     CONTINUE
H34G  NOP 
      ISZ UNITC     BUMP COUNT
      STA GLOB3,I   STORE UNIT NUMBER 
      ADA MM4       TEST
      SSA            RANGE 0 LEQ X LEQ 3
      JMP H34G,I    OK,RETURN 
      JSB H31       BAD INPUT 
      JMP H34       TRY AGAIN 
SW2   NOP 
      JSB SWR 
      AND BIT2      IS BIT 2 SET? 
      SZA           BRANCH IF NO
      JMP SW2,I 
      LDA GLOB2     DID HEAD ASSIGNMENT 
      CPA HDON       CHANGE?
      RSS           NO
      JMP BGN       YES - CLEAR LATCHED STATUS BITS 
      JSB SWR 
      AND BIT3
      SZA           IS BIT 3 SET? 
      JMP OPDNI,I   YES 
* 
*     CHECK TO SEE UNIT IS PRESENT
* 
      JSB STAT      IS UNIT 
      AND NRBIT      PRESENT? 
      SZA,RSS 
      JMP UD1       YES 
      LDA UNIT      NO
      STA GLOB1 
      ADA B2060 
      STA P050A,I   SET UP FIRST PART OF MESSAGE
      LDA P050B 
      STA GLOB2 
      LDA NRBIT 
      STA GLOB3 
      CLA 
UD2   EQU * 
      STA UNIT
      CPA GLOB1     LOOK AT ALL OTHER UNITS 
      JMP UD3       NO - SAME UNIT
      JSB STAT      IS THIS 
      AND NRBIT      UNIT PRESENT?
      LDB MM16
      SZA,RSS 
      LDB UNIT      YES 
      AND GLOB3 
      STA GLOB3 
      ADB B2060     B = BLANK,BLANK OR BLANK,UNIT # 
      STB GLOB2,I   SET UP LAST PART
      ISZ GLOB2      OF MESSAGE 
UD3   EQU * 
      CLA,INA 
      ADA UNIT
      CPA D4        DONE? 
      RSS           YES 
      JMP UD2       CONTINUE
      LDA GLOB3 
      LDB BB        BLANK,BLANK 
      SZA,RSS 
      LDB C1440     #,BLANK 
      STB GLOB2,I 
E50   JSB  ERROR         E50  UNIT MISSING - PRESENT ...
      LDA  PASS 
      SZA 
      JMP  UD4        DONT HALT IF PASS <> 0
      HLT 6 
      JMP START 
UD4   EQU  *
      LDA  GLOB1
      STA  UNIT 
UD1   EQU * 
      LDA SECTN    LOAD SECTION NUMBER
      ADA SECT     ADD ON POINTER 
      JMP A,I       CALL SECTION
SKIP  EQU * 
      LDA HLTC      =102010 
      IOR SECTN     SECTION NUMBER
      STA SHLT      HALT BETWEEN SECTIONS 
      JSB SWR       CHECK FOR HALT AT END OF SECTION
      AND BIT9
      SZA 
SHLT  NOP 
      JSB SWR       CHECK FOR TEST REPEAT 
      AND BIT7
      SZA          SKIP IF NO REPEAT
      JMP SCALR    REPEAT LAST TEST 
THRU  EQU *         ENTRY POINT FROM SECTION 5
      LDB SECTN    COUNT UP SECTION NUMBER
      INB 
      STB SECTN 
      CPB D6        FIVE SECTIONS 
      CLA,INA,RSS 
      JMP SCALR 
      ADA PASS      INCREMENT PASS NUMBER 
      STA PASS
      LDA ERR 
      SZA,RSS 
      JMP PS1 
      JSB SWR 
      AND A2400 
      CPA A2400     BOTH SET? 
      JMP PS2       YES 
PS1   EQU * 
      JSB TTYCK 
      JMP ECHOS 
PS2   EQU * 
      LDA PASS
      LDB P065A     CONVERT PASS
      JSB DCIN2      NUMBER 
      LDA ERR 
      LDB P065B     CONVERT NUMBER
      JSB DCIN2      OF ERRORS
      LDA MM3 
      STA TEMP1 
      LDB LONG
      LDA ISR 
      AND B142
      SZA           SKIP IF LONG PASS 
      LDB SHORT 
      STB LOCAL 
      LDB P065A 
      ADB MM4 
LPASS EQU * 
      LDA LOCAL,I   MOVE STRING 
      STA B,I        INTO 
      ADB MM1         MESSAGE 
      ISZ LOCAL 
      ISZ TEMP1 
      JMP LPASS 
      LDB P065B     CHECK 
      ADB D5         FOR
      LDA B,I         MULTI-DRIVE 
      AND MM16      =177760B
      IOR MDFLG 
      STA B,I 
      LDA B65 
H65   JSB PRINT     PASS XXXX 
ECHOS JMP BGN      RUN TEST OVER
      SKP 
FRSTA DEF *+1 
      DEF CH1 
      DEF CH2 
      DEF CH3 
      DEF CH4 
      DEF CH5 
      DEF CH6 
      DEF CH7 
      DEF CH8 
      DEF CH9 
      DEF CH10
      DEF CH13
      DEF CH15
LASTA DEF *-1 
* 
*     CNVS
*      CONVERT CHANNEL NUMBER TO ASCII AND STORE IN 
*      MESSAGES M2 THROUGH M7. INITIALIZE CH1 
*      THROUGH CH13 TO CHANNEL SELECT CODE
* 
CNVS  NOP 
      STA LOCAL     SAVE SELECT CODE
      LDB CVT       TEMPORARY STORAGE BUFFER
      JSB CNVRT     CONVERT TO OCTAL
      LDA WD3       GET LEAST SIGNIFICANT PART
      STA P002A,I   STORE 
      STA P003A,I    INTO 
      STA P004A,I     MESSAGES
      STA P005A,I 
      STA P057A,I 
      LDB FRSTA 
      STB GLOB2     SAVE FIRST POINTER
CLB   LDB GLOB2,I   LOAD POINTER
      LDA B,I       LOAD WORD 
      AND P7700     MASK OUT SELECT CODE
      IOR LOCAL     STUFF IN NEW SELECT CODE
      STA B,I       STORE BACK
      CPB LASTA,I   DONE? 
      JMP CTEST     YES 
      ISZ GLOB2 
      JMP CLB 
* 
* 
*     CTEST 
*      TEST CHANNEL 
* 
CTEST EQU * 
      CLC 0,C      INITIALIZE I/O SYSTEM
      LDA M1024     PUT ILLEGAL DISC
CH15  OTA CH         COMMAND IN A 
CH1   CLF CH        CLEAR CHANNEL FLAG
CH2   SFS CH
      RSS 
E2    JSB ERROR     CLF OR SFS FAILED ON CHANNEL X
CH3   CLF CH        TRY AGAIN 
CH4   SFC CH
E3    JSB ERROR     SFC FAILED WITH FLAG CLEAR-CH. X
CH5   STF CH
CH6   SFC CH
      RSS 
E4    JSB ERROR     STF OR SFC FAILED ON CHANNEL X
CH7   STF CH        TRY AGAIN 
CH8   SFS CH
E5    JSB ERROR     SFS FAILED WITH FLAG SET - CH. X
* 
*     SCREEN TEST 
* 
      LDA B10      START AT SELECT CODE 10
C1    STA GLOB3 
      CPA CH13      SAME AS THIS SELECT CODE? 
      JMP C2        YES - SKIP TEST 
      IOR STF0      NO - SET UP STF X 
      STA C3
CH9   CLF CH        CLEAR CH
C3    STF CH        STF   X 
CH10  SFS CH        SKIP  CH
      JMP C2        OK
E57   JSB ERROR     SCREEN TEST ERROR 
      JSB ERHTI,I   HALT? 
C2    EQU * 
      LDA GLOB3 
      INA 
      CPA B100      DONE? 
      RSS           YES 
      JMP C1        NO
*     TEST INTERRUPT CAPABILITY 
* 
      LDA CH13      EXIT IF DATA CHANNEL
      CPA DC14
      JMP CNVS,I
      LDA CH13,I
      STA GLOB1 
      LDA JSB1      SET UP INTERRUPT TRAP CELL
      STA CH13,I
      LDA JE6 
CC16  STC CC        SET CHANNEL TO REQUEST
CC17  STF CC        AN INTERRUPT
STF0  STF 0         ENABLE INTERRUPTS 
      STC 1         * INTERRUPTS
      STF 1           SHOULD
      CLC 1           BE
      CLF 1           DELAYED 
      JMP *+1,I       UNTIL 
      DEF *+1         . 
      JSB *+1,I       . 
      DEF *+1         . 
      NOP             . 
INTPT NOP           * HERE
E6    JSB ERROR     NO INTERRUPT ON CHANNEL X 
      JMP CC18
RETRN NOP           INTERRUPT SUBROUTINE
      CLF 0         DISABLE INTERRUPTS
      LDA GLOB1     TRAP CELL HALT
      STA CH13,I
      STF 0         TEST INTERRUPT ACKNOWLEDGE
      NOP           * SHOULD NOT
      NOP             INTERRUPT HERE
      CLF 0         DISABLE INTERRUPTS
      LDA RETRN     DID INTERRUPT OCCUR AT THE
      CPA ADDRS      CORRECT MEMORY LOCATION
      RSS 
E7    JSB ERROR     INCORRECT RETURN ADDRESS - CH. X
CC18  STC CC        SET CONTROL 
CC19  STF CC
      CLC 0         SHOULD CLEAR ALL CONTROL BITS 
      STF 0         ENABLE INTERRUPTS 
      NOP           ** SHOULD NOT INTERRUPT 
      NOP              HERE 
      CLC 0         TURN EVERYTHING OFF 
      LDA GLOB1 
      STA CH13,I
* 
      CLF 0 
      JMP CNVS,I    YES 
      HED WADR,DGEN1,CSTR,PSTR
* 
*     WADR
*      USE DMA TO WRITE ADDRESSES ON THE DISC 
* 
WADR  NOP 
      JSB FSEEH     RESET RAR 
      LDA WPCYL 
      STA WCNT      SET UP WORD COUNT 
      JSB WADRI,I   WRITE ADDRESS 
      JSB WCHK      CHECK FOR ERRORS
      JMP WADR,I    EXIT
* 
*     DGEN1 
*      LIMIT WORD COUNT TO 1024.
* 
DGEN1 NOP 
      STA WRSP
      LDA D1024 
      STA WCNT      WCNT = 1024 
      JSB DGEN      FILL WRITE BUFFER WITH RANDOM 
      JMP DGEN1,I    DATA 
* 
CSTR  NOP 
      LDA TRT 
CSTR1 STA CPONT     SET POINTER 
      ADA MM2       PUSH CYLINDER 
      STA CLOAD       TABLE 
      INA              DOWN ONE 
      STA CSTOR         AND 
MOVE  LDA CLOAD,I        PLACE
      STA CSTOR,I         NEW 
      LDA CLOAD            ENTRY
      STA CSTOR             ON
      ADA MM1                TOP
      STA CLOAD 
      ADA D11 
      CPA CPONT 
      RSS 
      JMP MOVE
      LDA VALUE 
      STA CSTOR,I 
      JMP CSTR,I
* 
PSTR  NOP 
      LDA PSTR
      STA CSTR      SET UP RETURN 
      LDA PATR
      JMP CSTR1 
      HED FCYCK,WEND,SEND,DEND
*     FCYCK 
*      PERFORM COMPLETE CYCLIC CHECK OPERATION,INCLUDING SEEK.
*      A = NUMBER OF SECTORS ON ENTRY.
* 
FCYCK NOP 
      STA WCNT      SAVE NUMBER OF SECTORS
      JSB FSEEK     SEEK
      LDA WCNT
      JSB CYCK      ISSUE CYCLIC CHECK
      JSB WCHK      CHECK STATUS
      JMP FCYCK,I   RETURN
* 
*     WEND
*      JSB WCHK     CHECK STATUS
*      JSB ENDST    END STEP
* 
WEND  NOP 
      JSB WCHK
      JSB ENDST 
      JMP WEND,I
* 
*     SEND
*      CLA
*      STA SHTAS
*      JSB ENDST
* 
SEND  NOP 
      CLA 
      STA SHTAS     EXPECTED STATUS = 0 
      JSB ENDST 
      JMP SEND,I
* 
*     DEND
*      JSB READ 
*      JSB DCHK 
*      JSB ENDST
* 
DEND  NOP 
      JSB READ
      JSB DCHK      VERIFY DATA READ
      JSB ENDST 
      JMP DEND,I
                                                                                                                                          