ASMB,R,Q,C
* 
* 
*    NAME: &BTXL
*    SOURCE:  92071-18032 
*    RELOC:   92071-16032 
*    PRGMR:   D.L.M 
* 
*  ***************************************************************
*  *  COPYRIGHT 1980 HEWLETT-PACKARD CO. ALL RIGHTS RESERVED.    *
*  *  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, DUPLICATED     *
*  *  OR TRANSLATED INTO ANOTHER PROGRAM LANGUAGE WITHOUT THE    *
*  *  THE EXPRESS WRITTEN CONSENT OF THE HEWLETT-PACKARD CO.     *
*  ***************************************************************
* 
      HED DISC BOOT SYSTEM LOADER FOR RTE-XL
      NAM BTXL,19,90  92071-16032 REV.2041 800902 
      ENT BTXL,UNRER
      EXT $LUTA,$LIBR,$LIBX,OPEN,CLOSE,.MVW,$CDIR,$INTA 
      EXT OPENF,EXEC,READF,WRITF,.MBT,LOCF,.LBT,.SBT
      EXT DD.30,.ENTR,NAMR,RLINK,LIMEM,CNUMD,CREAT,.XBX 
      EXT .CAX,RMPAR,NAM..,.CMW,.P1,.P2,.P3,.P7,CLD.R 
* 
* 
* BTXL IS DESIGNED TO BOOT AN RTE-XL OPERATING SYSTEM OFF OF A DISC.
* 
*   IT PERFORMS THE FOLLOWING OPERATIONS DIRECTED BY A BOOT CONTROL FILE
*   SPECIFIED BY THE USER IN THE BOOT STRING
* 
* 1. OPENS THE SPECIFIED SYSTEM AND SNAP FILES AND VERIFIES THAT THEY 
*    MATCH VIA CHECKSUMS. 
* 
* 2. OPENS THE SNAP AND SCANS FOR NEEDED ENTRY POINTS 
* 
* 3. MOUNTS SPECIFIED DISC LU'S TO THE SYSTEM 
* 
* 4. CREATES MAT TABLE ENTRIES AND PARTITIONS, AND ALSO 
*     DEALLOCATES BAD PAGES FROM THE SYSTEM 
* 
* 5. CREATES THE ID SEGMENTS AND RE-LINKS SPECIFIED PROGRAMS
* 
* 6. SETS UP TIME SLICE PARAMETERS
* 
* 7. SETS MASTER SECURITY CODE
* 
* 8. CREATES AND INITIALIZES THE SWAP AREA
* 
      SKP 
* 
* THIS FIRST SECTION INITIALIZES THE BOOT SYSTEM'S DISC DRIVER
* 
      SUP PRESS EXTRANEOUS LISTING
A     EQU 0 
B     EQU 1 
BTXL  DST ENPRM     SAVE A & B
      JSB $LIBR     GO PRIVILEDGED
       NOP
      CMA,SZA,RSS   IF ITS ZERO - 
      JMP BOTER       HALT!!!!! 
      CLA 
      LIA 3,C       CHECK IF FRONT PANEL
      SZA 
      CLA,INA 
      LIB 1         GET STATUS
      BLF,SLB 
      CLA 
      STA TERM      SAVE TERMINAL LU
      LDB $LUTA     GET THE LU TABLE ADDRESS
      INB           POINT TO THE DISC LU
      LDB B,I       GET THE DVT ADDRESS 
      STB LU2DV 
      LDA 110B      GET THE DRIVER TYPE 
      CLB,CCE 
      CPA =B30      IS IT 30? 
      CLE           YES - SET E 
      LDA ENPRM     GET THE ENTRY PARAMETERS
      RRR 6         SAVE SELECT CODE
      BLF,RBL 
      RBL 
      STB S.C         AND SAVE
      CLB 
      RRR 3         GET UNIT
      BLF,RBR         AND SAVE
      STB UN.HD       SAVE FOR BOOT 
      SEZ,RSS       IS IT FLOPPY? 
      STB 101B      YES - SAVE IT 
      CLB 
      RRR 3         GET ADDRESS 
      BLF,RBR         AND SAVE
      STB 100B
      STB HPIB      SAVE THE ADDRESS
      LDB LU2DV 
      ADB =D13
      LDA 110B
      CPA =B31      IS IT 31? 
      CLE 
      CPA =B32      IS IT 32? 
      CLE 
      LDA DVR30 
      SEZ 
      LDA DVR33 
      STA B,I       STORE IN LOCATION 
      LDB LU2DV     GET THE ENTRY POINT AGAIN 
      ADB B5        POINT TO THE DRIVER PARAMETER AREA
      LDA B,I       GET THE DRIVER TYPE 
      ALF,ALF       CORRECT 
      AND =B177700  MASK OUT OLD TYPE 
      IOR 110B      OR IN NEW TYPE
      ALF,ALF       MOVE BACK 
      STA B,I       AND RESTORE 
      ADB =D17      POINT TO DRIVER PARAMETER AREA
      LDA =B100     THE PARAMETERS ARE AT LOC. 100-107 OCT. 
      JSB .MVW      MOVE THE PARAMATERS 
       DEF B10
       NOP
      LDB $LUTA     GET THE TABLE ADDRESS AGAIN 
      INB 
      LDB B,I       GET THE DEVICE TABLE ADDRES 
      ADB B4        POINT TO IFT
      LDB B,I       GET IFT ADDRESS 
      LDA S.C       GET THE SELECT CODE 
      ADA $INTA     ADD THE INTERRUPT TABLE ADDRESS 
      STB A,I         AND SAVE THE IFT IN INTERRUPT TABLE 
      ADB B5        POINT TO SELECT CODE
      LDA B,I 
      AND =B177700
      IOR S.C       GET THE SELECT CODE AGAIN 
      STA B,I 
* 
      LDA BNAMA     GET THE NAME ADDRESS
      RAL           MAKE BYTE ADDRESS 
      JSB .CAX        AND SAVE
      LDA =D-8      PARSE EIGHT CHARS.
      STA NMCNT       SAVE
      LDB ENPRM+1,I GET THE FIRST WORD
      SZB,RSS       ZERO? 
      JMP MEM       YES - USE DEFAULT 
      LDB ENPRM+1   GET THE SECOND ADDRESS
      CCE,SZB,RSS   IS IT THERE?
      JMP MEM       NO - USE DEFAULT
      RBL           MAKE BYTE ADDRESS 
NMLOP JSB .LBT      GET FIRST CHARACTER 
      SEZ,SZA       IS IT ZERO OR ZERO FOUND? 
      JMP NM1 
      LDA B40       YES 
      CLE 
NM1   JSB .XBX      EXCHANGE
      JSB .SBT      RESAVE
      JSB .XBX        AND EXCHANGE BACK 
      ISZ NMCNT     INCREMENT COUNT 
      JMP NMLOP 
      SKP 
* 
* FIND OUT HOW MUCH MEMORY IS IN THE SYSTEM 
* 
MEM   CLC 5         MAKE SURE PARITY
      CLC 13B         AND MAPPING ARE DISABLED
      LDA B37       GET THE ADDRESS OF THE PAGE 
MPLOP ADA B20       ADD 17B TO POINT TO 
      STA 137B        THE LAST PAGE 
      LDA TSTPT     GET THE TEST PATTERN
      OCT 104413    STORE IT
      OCT 77776       AT THIS POINT 
      CLA           MAKE SURE A IS CLEAR
      OCT 104213    GET IT BACK AGAIN 
      OCT 77776 
      CPA TSTPT     DID IT COME BACK? 
      RSS           YES - KEEP GOING
      JMP NMORE 
      LDA 137B      GET THE MAP AGAIN 
      CPA =B377     IS IT THE LAST ONE? 
      JMP MPSV      YES - SAVE THE VALUE
      JMP MPLOP       AND DO IT AGAIN 
NMORE LDA B20       SUBTRACT 16 
      CMA,INA 
      ADA 137B      MAKE THE CORRECT VALUE
MPSV  INA 
      STA MAXMP       AND SAVE
      STC 5         TURN ON THE PARITY SYSTEM 
      JSB $LIBX     GO UN-PRIVILEDGED 
       DEF *+1
       DEF *+1
      SKP 
* 
* THIS NEXT SECTION OPENS THE BOOT CONTROL FILE.
* 
* 
BEGIN CLA 
      STA BTFLG 
      JSB OPENF     OPEN THE BOOT FILE
       DEF *+5
       DEF BCDCB     BOOT CONTROL FILE DCB
       DEF ERR       ERROR CODE 
       DEF BCNAM     NAME OF FILE 
       DEF OPTN      ECHO OPTION IF TYPE 0
* 
      SSA           WAS THERE AN ERROR
      JMP BOTER     YES - REPORT
      CPA B1        IS IT TYPE ONE? 
      JMP BTTY1     YES - BOOT TYPE ONE FILE!!! 
      SZA           IS IT ZERO? 
      CCA 
      STA TY$FL     YES - INTERACTIVE 
      LDB TERM
      SZA,RSS       ARE WE INTERACTIVE? 
      SZB             AND DO WE HAVE A TERMINAL?
      JMP GETFL     YES - GO FOR IT!! 
* 
BOTER CMA,INA       CONVERT THE NUMBER
      CPA B6        WAS IT NOT FOUND? 
      JMP INTER 
      JSB $LIBR     GO PRIVILEDGED
       NOP
      HLT 1         HALT THE MACHINE
      JMP *-1       MAKE SURE WE NEVER LEAVE
INTER CLA           NOT FOUND 
      STA BCNAM+1     SO TRY TO OPEN
      STA BCNAM+2       LU 1
      INA                 AS AN 
      STA BCNAM             INTERACTIVE FILE
      JMP BEGIN 
ERR   NOP           ERROR CODE
* 
* NO ERROR MESSAGE OCCURS BECAUSE OF A TERMINAL IS NOT
*  DEFINITELY IN THE SYSTEM!!!! 
* 
      SKP 
* 
* HERE IF BOOT CONTROL FILE IS TYPE 1.  GET THE NECESSARY 
* PARAMETERS AND START THE BOOT.
* 
BTTY1 CLB           CLEAR B FOR DIVIDE
      LDA BCDCB+3   GET THE TRACK NUMBER
      DIV 107B        DIVIDE BY NUMBER HEADS FOR CYLINDER 
      ADA 103B      ADD THE STARTING CYLINDER 
      STA CYL         AND SAVE
      RRR 16        GET THE HEAD OFFSET 
      CLB 
      MPY BCDCB+8   MULTIPLY BY SECTORS PER TRACK 
      RAR             AND CORRECT 
      LDB BCDCB+4   GET THE SECTOR OFFSET 
      RBR           CORRECT 
      ADA B           AND MAKE FINAL OFFSET 
      STA DSCAD 
* 
      CCA 
      STA BTFLG     SET THE BOOT FLAG 
      JMP ALDN1     GO TO IT
* 
LU2DV NOP 
BNAMA DEF *+1 
BCNAM ASC 3,SYSTEM
      BSS 1         FOR SUSPEND FLAG
B1    OCT 1 
B2    OCT 2 
B37   OCT 37
B20   OCT 20
OPTN  OCT 410 
ENPRM BSS 2 
TERM  OCT 1 
TY$FL NOP           INTERACTIVE FLAG
TSTPT OCT 125252
S.C   NOP           SELECT CODE 
NMCNT NOP           NAME CHARACTER COUNTER
B40   OCT 40        SPACE 
BTFLG NOP           BOOT FLAG 
      SKP 
* 
*  NOW THAT BOOT CONTROL FILE HAS BEEN OPENED, CONTINUE 
*  GET SNAP AND SYSTEM PARAMETERS 
* 
GETFL LDA SYFL$     GET THE SYSTEM FLAG 
      AND SNFL$       AND WITH THE SNAP FLAG
      SZA           ARE BOTH SET? 
      JMP ENTPT     YES - GO READ ENTRY POINTS
      JSB RDLNE     READ FIRST LINE 
      CPA =AEN      IS IT END?? 
      JMP ALDN      YES - GO CLOSE EVERYTHING 
      CLE           HAS THE SYSTEM FILE BEEN FOUND? 
      CPA =ASY      AND IS THIS A SYSTEM? 
      JMP SYSFN     YES - IT'S THE SYSTEM FILE
      LDB SNFL$     GET THE SNAP FLAG 
      CCE           IS IT ZERO? 
      CPA =ASN
      JMP SYSFN 
      JMP BDCMD     NEITHER SO INDICATE COMMAND ERROR 
* 
SYSFN LDA RBUFR+3   GET THE TYPE FIELD
      AND B3
      CPA B3        IS IT THREE?
      RSS 
      JMP BDCMD     NOT A CORRECT TYPE- KEEP READING
      LDB SYNMA     GET THE SYS NAMR ADDR.
      SEZ           IS E SET? 
      LDB SNNMA     YES - THEN ITS THE SNAP FILE NAMR 
      LDA FILNM       AND THE LOCATION IN THE STRING
      JSB .MVW      DO A MOVE WORD
       DEF B5 
       NOP
      CCA,SEZ       SET THE APPROPRIATE FOUND FLAG
      JMP *+3 
      STA SYFL$ 
      JMP GETFL 
      STA SNFL$ 
      JMP GETFL     GO GET ENTRY POINTS 
* 
NAMAD DEF *+1 
NAMBF BSS 128 
SYNMA DEF *+1 
SYNMR BSS 5 
SNNMA DEF *+1 
SNNMR BSS 5 
FILNM DEF RBUFR 
CMD   NOP           CMD MUST BE BEFORE RBUFR!!! 
RBUFR BSS 33        BUFFER AREA FOR PARSE 
SYFL$ NOP           SYSTEM FOUND FLAG 
SNFL$ NOP           SNAP FOUND FLAG 
B3    OCT 3 
CKSMS BSS 2 
      SKP 
* 
* SEARCH SNAP AND LOOK FOR ENTRY POINT ADDRESSES
*   AND SAVE THE ADDRESSES OF THESE ENTRY POINTS
* 
ENTPT NOP 
      JSB OPEN      OPEN THE SNAPSHOT FILE
       DEF *+6
       DEF SNDCB     SNAP DCB 
       DEF ERR2      ERROR CODE 
       DEF SNNMR     NAME 
       DEF B0        OPTION 
       DEF SNNMR+4   SECURUTY CODE
      SSA           WAS THERE AN ERROR? 
      JMP SNERR     YES - SNAP ERROR
      CPA B3        IS IT A TYPE 3 FILE?? 
      RSS 
      JMP ILSNP     YES - SNAP ERROR
      LDA ETTBN     NUMBER OF ENTRIES TO SEARCH FOR 
      STA ETCTR     SAVE IN COUNTER 
      CCA           SET FIRST READ FLAG 
      STA F1$FL 
LOOP  LDA ETPTA     GET THE NAME POINTER
      STA ETPTR       AND SAVE IN THE COUNTER 
      LDA ETTBA     GET THE TABLE ADDRESS 
      STA ETTBL       AND SAVE
      JSB READF     FILE OPEN SO START READING
       DEF *+6
       DEF SNDCB    SNAP DCB
       DEF ERR2     ERROR CODE
       DEF NAMBF    BUFFER
       DEF B200     MAXIMUM 128 WORD
       DEF LEN
      SSA 
      JMP SNERR     ERROR OUTPUT
      LDB F1$FL     GET THE FIRST FLAG
      CMB,SZB       IS IT CLEAR?
      JMP SRCH      YES - START SEARCHING FOR ENTRIES 
      STB F1$FL     NO - CLEAR IT 
      DLD NAMBF+8   GET THE CHECKSUMS 
      DST CKSMS       AND SAVE THEM 
      LDA LEN       GET RETURNED LENGTH 
      CPA =D20      IS IT 20? 
      JMP LOOP
      JMP ILSNP     NO - ILLEGAL SNAPSHOT 
      SKP 
* 
*  SEARCH THE NAMBF FOR THE CORRECT ENTRY POINTS
* 
SRCH  LDA ETTBN     GET THE TABLE LENGTH
      STA ETLNC       AND LET IT SERVE AS A COUNTER 
      LDB NAMBF     GET FIRST WORD OF BUFFER
      ADB NAMAD     ADD THE ADDRESS OF THE BUFFER 
      INB           ADD ONE 
      LDA B,I         TO GET THE ENTRY TYPE 
      SZA           IS IT MEMORY RESIDENT?
      JMP LOOP      NO - GET NEXT ENTRY 
SRCH1 LDA NAMAD     YES - GET ITS ADDRESS 
      INA 
      LDB ETPTR       AND THE ENTRY POINT TABLE POINTER 
      JSB .CMW        COMPARE IF EQUAL
       DEF B3        SIX BYTES
       NOP          FOR UCODE 
      JMP ETFND     ENTRY POINT FOUND!!!! 
      NOP 
      LDA ETPTR     NOT FOUND SO ADJUST POINTERS
      ADA B3        ADD 3 
      STA ETPTR       AND RESTORE 
      ISZ ETTBL     INCREMNT TO NEXT POSITION 
      ISZ ETLNC     END OF TABLE? 
      JMP SRCH1     NO - TRY NEXT ENTRY 
      JMP LOOP      NOT HERE - TRY AGAIN
* 
*  ENTRY POINT FOUND - UPDATE ENTRY POINT TABLE 
*  AND READJUST POINTERS FOR SEARCH TO THE NEXT ENTRY POINT 
* 
ETFND LDA NAMAD     GET ADDRESS OF BUFFER 
      ADA NAMBF     ADD THE LENGTH
      ADA B2         +2 
      LDA A,I       GET THE VALUE IN THE TABLE
      STA ETTBL,I     AND STORE IT
      ISZ ETCTR     INCREMENT THE COUNTER 
      JMP LOOP      BACK FOR MORE!
      JMP SYSIN     NOW CHECK ENTRY POINTS
      SKP 
* 
*SNAP ERROR ROUTINE 
* 
SNERR CMA,INA       MAKE ERROR POSITIVE 
      CPA =D12      IS IT EOF?
      JMP SNWRN     YES - START READING THE SYSTEM
      STA ERR2      STORE IN FILE 
      JSB CNUMD     CONVERT TO ASCII
       DEF *+3
       DEF ERR2     ERROR CODE
       DEF ERSTG
      LDA MINUS     PUT A MINUS SIGN
      STA ERSTG       IN THE FIRST WORD 
      JSB EXEC      WRITE TO TERMINAL 
       DEF *+5      RETURN
       DEF B2       WRITE 
       DEF TERM      TO TERMINAL
       DEF SNBUF    SNAP ERROR BUFFER 
       DEF SNLN       AND LENGTH
SNER1 JSB CLOSE     CLOSE 
       DEF *+2
       DEF SNDCB    SNAP DCB
      LDA TY$FL     GET THE TERMINAL FLAG 
      CLB 
      STB SNFL$       CLEAR THE SNAP FILE FLAG
      SZA,RSS       ARE WE INTERACTIVE? 
      JMP GETFL     YES - READ TERMINAL AGAIN 
      JSB $LIBR     GO PRIVILEDGED
       NOP
      HLT 2         HALT THE MACHINE
      JMP *-1       MAKE SURE WE NEVER LEAVE
ILSNP JSB EXEC      WRITE ILLEGAL SNAP MESSAGE
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF ILSNM
       DEF B6 
      JMP SNER1     DO CLEANUP
SNWRN JSB EXEC
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF SNWRM
       DEF SNWRL  
      JMP SYSIN 
SNWRM ASC 21,WARNING. ALL SNAP ENTRY POINTS NOT FOUND.
SNWRL ABS *-SNWRN 
ILSNM ASC  6,ILLEGAL SNAP 
SNBUF ASC  5,FMP ERROR
ERSTG BSS 3         ERROR CODE
      ASC 10, ON SNAP FILE SEARCH 
SNLN  ABS *-SNBUF   BUFFER LENGTH 
ERR2  NOP           ERROR CODE
MINUS ASC 1, -
      SKP 
* 
* THIS IS THE ENTRY POINT NAME TABLE AND ADDRESS TABLE,  THESE SHOULD 
* NOT BE MOVED!!!!! 
* 
ETCTR NOP 
B6    OCT 6 
B200  OCT 200 
LEN   NOP 
F1$FL NOP 
ETLNC NOP 
ETPTR NOP           ENTRY POINT POINTER 
ETTBL NOP           ENTRY POINT VALUE ADDRESS 
ETPTA DEF *+1 
      ASC 3,$MATA 
      ASC 3,$MAT# 
      ASC 3,$MATV 
      ASC 3,$CDA
      ASC 3,$CD#
      ASC 3,$IDA
      ASC 3,$IDSZ 
      ASC 3,$ID#
      ASC 3,$LUTA 
      ASC 3,$LUT# 
      ASC 3,$USER 
      ASC 3,$SWLU 
      ASC 3,$BOOT 
      ASC 3,$SWTA 
      ASC 3,$CKSM 
      ASC 3,$SCCK 
      ASC 3,$TSQU 
      ASC 3,$TSPR 
      ASC 3,$BGPR 
      ASC 3,$XECM 
ETTBA DEF *+1 
MATA  NOP           (*)MAT TABLE ADDRESS
MAT#  NOP           (*)NUMBER OF TABLE ENTRIES
MATV  NOP           ADDRESS OF NUMBER OF VALID ENTRIES
CDA   NOP           (*)CARTRIDGE DIRECTORY ADDRESS
CD#   NOP           (*)NUMBER OF ENTRIES
IDA   NOP           (*)ID SEGMENT ADDRESS 
IDSZ  NOP           (*)ID SEGMENT SIZE
ID#   NOP           (*)NUMBER OF ID SEGMENTS
LUTA  NOP           (*)LU TABLE ADDRESS 
LUT#  NOP           (*)  AND LENGTH 
USER  NOP           (*)START OF USER AREA 
SWLU  NOP           SWAPPING TABLE
BOOT  NOP           BOOT PROGRAM ID SEG. ADDR.
SWTA  NOP           (*)SWAP TABLE ADDRESS 
CKSM  NOP           (*)SYSTEM CHECKSUM
SCCK  NOP           (*)SYSTEM COMMON CHECKSUM 
TSQU  NOP           TIME SLICE QUE
TSPR  NOP           TIME SLICE PRIORITY 
BGPR  NOP           BACKGROUND PRIORITY 
XECM  NOP           MASTER SECURITY CODE LOCATION 
ETTBN ABS MATA-*    SIZE OF TABLE 
      SKP 
********************************************************* 
*                                                       * 
* INITIALIZE THE ENTRY POINTS FOR THEIR RELEVENT VALUES * 
*                                                       * 
********************************************************* 
      SPC 1 
SYSIN JSB OPENF     OPEN THE SYSTEM FILE
       DEF *+6
       DEF SYDCB    SYSTEM DCB
       DEF ERR4     ERROR CODE
       DEF SYNMR    SYSTEM NAME 
       DEF B0 
       DEF SYNMR+4
      SSA           WAS THERE AN ERROR? 
      JMP SYERR     ERROR EXIT
* 
* NOW THAT SYSTEM IS OPEN, LETS VERIFY THAT THE SNAP MATCHES THE
*    SYSTEM!!!! 
* 
      LDB CKSM      READ THE SYSTEM CHECKSUM
      JSB RDSYS     READ THE SYSTEM 
      CPA CKSMS     DOES IT MATCH THE SNAP??
      RSS 
      JMP CKERR      NO -ERROR
      STA CKSM      NO - SAVE THE CHECKSUM
      LDB SCCK      GET THE SYSCOM CHECKSUM 
      JSB RDSYS     READ THE SYSTEM 
      CPA CKSMS+1   IS IT CORRECT?? 
      RSS 
      JMP CKERR     NO - ERROR
      STA SCCK      SAVE THE INFORMATION
      CCA 
      STA BTFLG     SET THE BOOT FLAG 
* 
* CORRECT SYSTEM AND SNAP. MODIFY THE (*) ENTRY POINTS
* 
      LDB LUTA      GET THE LU TABLE ADDRESS
      JSB RDSYS     READ THE SYSTEM 
      STA LUTA
* 
      LDB LUT#      GET THE LENGTH OF THE TABLE 
      JSB RDSYS     READ THE SYSTEM 
      CMA,INA 
      STA LUT#        AND SAVE THE VALUE
* 
      LDB CDA       GET THE CARTIDGE DIRECTORY ADDRESS
      JSB RDSYS     READ THE SYSTEM 
      STA CDA 
* 
      LDB CD#       GET THE CARTRIDGE TABLE SIZE
      JSB RDSYS     READ THE SYSTEM 
      CMA,INA       NEGATE
      STA CD#         & RESTORE 
* 
      LDB MAT#      GET THE NUMBER OF MAT ENTRIES 
      JSB RDSYS     READ THE SYSTEM 
      CMA,INA       NEGATE
      STA MAT#        AND RESTORE 
* 
      LDB ID#       GET THE NUMBER OF ID SEGMENTS 
      JSB RDSYS     READ THE SYSTEM 
      STA IDNUM     SAVE IT 
      CMA,INA       NEGATE
      STA ID#         AND RESTORE 
* 
      LDB MATA      GET THE TABLE ADDRESS 
      JSB RDSYS     READ THE SYSTEM 
      STA MATA
* 
      LDB IDA       GET THE ADDRESS OF ID SEGMENTS
      JSB RDSYS     READ IT 
      STA ID#1      FIRST ID SEGMENT ADDRESS
      STA IDA         AND THE RUNNING POINTER 
* 
      LDB IDSZ      GET THE SIZE OF THE ID
      JSB RDSYS 
      STA IDSZ        AND SAVE
* 
      LDB USER      GET THE FIRST WORD USER SYSTEM
      JSB RDSYS     GET IT
      STA USER      AND RESTORE 
* 
      LDB SWTA      GET THE SWAP TABLE ADDRESS
      JSB RDSYS     READ
      STA SWTA        AND SAVE
* 
      CLA           CLEAR THE 
      STA CDT         BOOT STARTUP LOCATION 
      INA           ONE WORD
      LDB BOOT        INTO STARTUP LOCATION 
      JSB WRSYS     WRITE TO SYSTEM 
      SKP 
* 
* INITIALIZE POINTERS AND READ THE CONTROL FILE FOR THE ENTRIES 
* NECESSARY FOR THE CARTRIDEGE DIRECTORY
* 
      LDA TERM      GET THE TERMINAL LU 
      IOR =B2000    OR IN TRANSPARANCY BIT
      STA NCRLF       AND STORE 
      LDA CDLU      GET  THE CARTRIDGE DIRECTORY POINTER
      STA CDLUT       AND SAVE
      LDA TMPR      GET THE ADDRESS OF THE DISC TABLE 
      STA TMPRA       AND STORE AS RUNNING POINTER
      LDA BPTBA     GET THE ADDRESS OF THE BAD PAGE TABLE 
      STA BDPGP       AND START TABLE POINTER 
      STA BPPTR       AND THE RUNNING POINTER 
      CLA           CLEAR 
      STA BDPG# 
      STA NBFL$ 
      STA #DSC        THE DISC NUMBER COUNTER 
      STA NO$MC       AND THE NO MOUNT DISC FLAG
      STA MATNM       AND THE NUMBER OF VALID MAT ENTRIES 
      STA SWFLG       AND THE SWAP FILE FLAG
      LDA =D-32 
      LDB BPTBA 
      JSB CLRBF     CLEAR THE BAD PAGE TABLE
      JSB LIMEM     GET THE RELINK BUFFER 
       DEF *+4
       DEF B1 
       DEF LIBUF
       DEF LILEN
      JSB MSTAT     GET MEMORY STATUS 
      SKP 
* 
* 
*  READ THE CONTROL FILE FOR THE ENTRIES NECESSARY FOR CARTRIDGE
*     DIRECTORY 
* 
SYSOP JSB RDLNE     DO A READ OF THE CONTROL FILE 
      CPA =AMC      MOUNT IT? 
      RSS 
      JMP BDPGE     NO TRY BAD PAGE COMMAND 
      SEZ,RSS       IS IT A NUMBER? 
      JMP MTERR     NO
      SSB           IF ITS NEGATIVE 
      CMB,INB         MAKE IT POSITIVE
MC1   STB #LU       SAVE IT 
      LDA NO$MC     GET THE NO MOUNT DISC FLAG
      SZA           IS IT SET 
      JMP MTERR     YES - KEEP READING FOR SOMETHING ELSE 
      LDA B 
      ADA LUT#      SUBTRACT THE LENGTH FOR LEGALITY
      CMA,INA       NEGATE
      SSA           IS IT NEGATIVE? 
      JMP MTERR     NO - ERROR
      CCB           ADD -1
      ADB LUTA        TO THE TABLE +
      ADB #LU           THE LU
      JSB RDSYS     READ THE SYSTEM 
      SZA,RSS       IS IT A VALID DVT?? 
      JMP MTERR     NO - KEEP READING 
      STA DVTAD     SAVE THE DVT ADDRESS
      ADA B5        INDEX TO START OF DVR PARM AREA 
      STA B         SET ADDRESS 
      JSB RDSYS     READ THE SYSTEM FOR THE VALUES
      ALF,CLE,ALF   SWAP BYTES
      AND =B77      GET DRIVER TYPE 
      CPA =B33      IS IT 33? 
      CCE           YES - COMMAND SET 80 DISC 
      AND =B70      GET REST OF WORD
      CPA =B30      IS IT A REGULAR DISC? 
      RSS 
      JMP MTERR     NO - MOUNT ERROR
      ERA 
      STA C80$      SAVE C80 FLAG 
* 
      LDA #LU       GET THE LU NUMBER 
      CMA,INA       NEGATE IT 
      JSB SRDSK     IS IT IN THE TABLE? 
      RSS           NO - CORRECT
      JMP MTERR     YES 
      SKP 
* 
*  IT'S A DISC!! LET'S MODIFY OUR DRIVER TO MATCH THE L20'S 
*  DISC AND READ IT FOR THE CORRECT VALUES
* 
      LDA #LU       GET LU
      LDB C80$        AND C80 FLAG
      ELB           PULL IT OUT 
      RAL,ERA         AND ADD THE DISC FLAG 
      STA TMPRA,I   SAVE LU IN TABLE
      ISZ TMPRA       AND INCREMENT POINTER 
      LDB =D-8      GET THE COUNT 
      STB CNT9      AND SAVE
      LDB DVTAD     GET THE DVT ADDRESS 
      ADB =D22      GET THE DRIVER PARM ADDRESS 
DV1   JSB RDSYS     READ THE SYSTEM 
      STA TMPRA,I   STORE IN THE TABLE
      ISZ TMPRA     INCREMENT THE TABLE 
      ISZ CNT9          AND THE COUNT 
      JMP DV1 
      LDB DVTAD     GET THE DVT ADDRESS 
      ADB B4        POINT TO IFT ADDRESS
      JSB RDSYS     READ THE SYSTEM 
      LDB B5        ADD FIVE
      ADB A           TO THE ADDRESS
      JSB RDSYS     PICK UP THE SELECT CODE 
      AND =B77      SAVE SELECT CODE
      STA TMPRA,I   SAVE IN TABLE 
      ISZ TMPRA       AND INCREMENT POINTER 
* 
*  NOW THAT TABLE ENTRY HAS BEEN MADE, MOUNT THE DISC!
* 
      JSB MCDSK     MOUNT THE DISC
       DEF *+2
       DEF #LU
      JMP MTER1     ERROR ON MOUNT
      LDA CDT+2     GET THE CRN NUMBER
      JSB SRDSK     MAKE SURE THAT NO OTHER IS THERE
      RSS 
      JMP MTER1     YES - THERE IS - DON'T MOUNT
      ISZ #DSC      DISC MOUNTED. BUMP DISC COUNTER 
      LDA #LU       GET THE LU NUMBER 
      ELA,CLE,ERA   CLEAR THE FLAG
      STA CDT       GET THE CARTRIDGE DIRECTORY ADDRESS 
      LDA B4
      LDB CDA       GET CART DIR ADDR 
      JSB WRSYS     WRITE TO SYSTEM 
      SKP 
* 
* AFTER THE DISC IS MOUNTED SAVE THE CRN NUMBER IN THE LU TABLE 
* 
      LDA CDT       GET THE DISC LU 
      STA CDLUT,I     AND SAVE IN THE TABLE 
      ISZ CDLUT     BUMP TABLE POINTER
      LDA CDT+2     GET THE CRN NUMBER
      STA CDLUT,I     AND SAVE IN THE TABLE 
      ISZ CDLUT       TWICE 
      LDB CDA       GET THE TABLE ADDR. 
      ADB B4          AND INCREMENT TO NEXT ENTRY 
      STB CDA 
      ISZ CD#       INCREMENT THE COUNT 
      RSS           NO MORE DISCS ALLOWED 
      JMP NOMNT     DON'T MOUNT ANY MORE
      LDA DEFMT     GET THE DEFAULT MOUNT FLAG
      CLB 
      STB DEFMT       WHILE CLEARING IT 
      CMA,SZA,RSS   WAS IT SET
      JMP DFDSK,I     YES - SO EXIT THIS WAY INSTEAD
      LDA =D20      MORE THAN TEN DISCS?
      CPA #DSC      ??
      RSS 
      JMP SYSOP     NO - CHECK FOR MORE 
NOMNT CCA           SET THE 
      STA NO$MC       NO MOUNT DISC FLAG
      JMP SYSOP 
      SPC 1 
**************************************************
*  DISC PARAMETERS TABLE - 10 WORDS/ENTRY        *
*                        ----------------------  *
* D -  DISC FLAG         !D!        LU        !  *
*      1 = DD.33         ----------------------  *
*      0 = DD.30         !   DISC             !  *
*                        !     DRIVER         !  *
*                        !       PARMS        !  *
*                        !    (8 WORDS)       !  *
*                        ----------------------  *
*                        !    SELECT CODE     !  *
*                        ----------------------  *
*                                                *
**************************************************
      SPC 2 
TMPR  DEF *+1 
      BSS 200       20 LU'S MAXIMUM 
TMPRA NOP 
C80$  NOP 
DVTAD NOP 
DEFMT NOP           DEFAULT MOUNT 
#DSC  NOP           NUMBER OF DISCS "MOUNTED" 
CNT9  NOP 
NO$MC NOP 
CDTA  DEF CDT       ADDRESS OF THE TABLE
CDT   BSS 40        CARTRIDGE DIRECTORY ENTRY 
B0    NOP 
B4    OCT 4 
B10   OCT 10
* 
**************************************************************
*                                                            *
*                               --------------------------   *
*  CARTRIDGE NUMBER             !     LU NUMBER          !   *
*     LU TABLE FORMAT           --------------------------   *
*                               !      CRN NUMBER        !   *
*                               --------------------------   *
*                                                            *
**************************************************************
      SPC 2 
CDLU  DEF *+1 
      BSS 40
CDLUT NOP 
MTER1 LDA TMPRA     GET THE TABLE ADDRESS 
      ADA =D-10     SUBTRACT TEN
      STA TMPRA       AND RESTORE 
      CLA 
      STA TMPRA,I   CLEAR THE FIRST WORD
MTERR JSB CNUMD     CONVERT TO ASCII
       DEF *+3
       DEF #LU        THE LU NUMBER 
       DEF LUSTG      IN THE STRING 
      JSB EXEC      WRITE MESSAGE TO TERMINAL 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF MTMSG
       DEF MTMSL
      JMP SYSOP     READ THE FILE AGAIN 
MTMSG ASC  9,MOUNT ERROR ON LU
LUSTG BSS 3 
MTMSL ABS *-MTMSG 
#LU   NOP 
      SKP 
* ALLOCATE BAD PAGES IN MEMORY
* 
BDPGE CPA =ABP      IS IT A BAD PAGE COMMAND? 
      RSS 
      JMP MTTBL     NO - CHECK FOR MAT ENTRY
      LDA NBFL$     GET THE COMMAND FLAG
      SZA           ALLOW MORE BAD PAGES? 
      JMP BDCMD     NO - SAY BAD COMMAND
      SEZ,SZB,RSS   IS IT A NUMBER AND NOT ZERO?? 
      JMP QUERR     YES - BAD PARAMETER 
      STB TBDPG     NO - SAVE TEMPORARILY 
      LDA USER      CHECK AGAINST USER VALUE
      CMA,INA 
      ADA B 
      SSA           IS IT IN SYSTEM 
      JMP QUERR     YES - ERROR 
      CMB,INB 
      ADB MAXMP     GET THE LARGEST PAGE
      SZB           IS IT EQUAL OR
      SSB           IS IT LEGAL?
      JMP QUERR     NO - BAD PARAMETER
      LDA LDPGP     GET THE LAST TABLE ENTRY
      CMA,INA       MAKE NEGATIVE 
      ADA TBDPG     GET THE NEW ENTRY 
      SZA           IS IT ZERO? 
      SSA             OR NEGATIVE?
      JMP QUERR     NO - NOT HIGHER VALUE 
      LDA TBDPG     GET THE PAGE NUMBER 
      STA LDPGP       SAVE CURRENT ENTR 
      STA BDPGP,I     AND SAVE IN TABLE 
      LDA BDPGP     GET THE ADDRESS 
      ISZ BDPGP       AND BUMP AGAIN
      CLB 
      CPA BPTBE     IS IT THE LAST ONE
      CCB           YES SO SET FLAG 
      STB NBFL$ 
      LDA USER      GET THE STARTING PAGE 
      CPA LDPGP     IS IT EQUAL TO THE CURRENT PAGE?
      RSS 
      JMP BP1       NO
      ISZ USER      YES - BUMP USER 
      ISZ BPPTR       AND MS'S TABLE POINTER
      RSS 
BP1   ISZ BDPG#     BUMP THE NUMBER OF BAD PAGES
      JSB MSTAT     GET MEMORY STATUS 
      JMP SYSOP 
TBDPG NOP           LAST ENTRY
LDPGP NOP 
NBFL$ NOP           NO MORE BAD PAGE FLAG 
BDPGP NOP           END OF TABLE POINTER
BPTBA DEF *+1 
      BSS 128        128 BAD PAGES MAXIMUM
BPTBE DEF *-1       END OF TABLE
BDPG# NOP           NUMBER OF BAD PAGES 
BPPTR NOP           USER
      SKP 
* 
*  READ THE CONTROL FILE FOR NECESSARY UPDATE FOR MAT ENTRIES 
* 
MTTBL CPA =AMS      IS THIS A SIZE COMMAND? 
      RSS 
      JMP RP        NO - TRY RP ING THE PROGRAM 
      LDA NM$FL     GET THE NO MAT FLAG 
      SZA           IS IT SET?
      JMP MATER     YES - NO MORE ENTRIES 
      SEZ,RSS       IS IT NUMERIC?
      JMP QUERR     NO - ERROR
      SZB           CHECK IF ZERO 
      SSB             OR NEGATIVE 
      JMP QUERR 
      LDA =D-33     CHECK IF > 32 
      ADA B 
      SSA,RSS       IS IT 
      JMP QUERR     YES - ERROR 
* 
      CCA 
      STA NBFL$     SET THE NO BAD PAGE FLAG
      LDA BPPTR,I   GET THE BAD PAGE POINTER
      SZA 
      JMP MT2       YES 
      LDA MAXMP     NO - SAY NON-EXISTANT MAP IS ILLEGAL
      STA BPPTR,I     AND STORE 
MT2   LDA BPPTR,I   GET THE CURRENT BAD PAGE
      CPA USER      ARE THEY THE SAME?? 
      JSB BPUPD     YES - UPDATE THE TABLE!!
      LDA BPPTR,I   GET THE TABLE ENTRY AGAIN 
      CPA MAXMP     IS IT A NON-EXISTANT PAGE?? 
      RSS 
      JMP MT3 
      CCA           SET THE 
      STA NO$MM       NON - EXISTANT MEMORY FLAG
MT3   CLA           STORE 
      STA CDT       ZERO
      LDA USER      GET THE STARTING PAGE 
      STA CDT+2     STORE IN MEMORY 
      ADA B         MAKE THE NEXT ENTRY POINT 
      STA USER        AND SAVE FOR NEXT TIME
* 
      CMA,INA       SUBTRACT THE NEW USER POINTER 
      ADA BPPTR,I     FROM THE CURRENT BAD PAGE 
      STA NWUSR       AND SAVE
      SSA           DID WE CROSS A BOUNDARY?? 
      ADB A         YES - SUBTRACT THE DIFFERENCE 
* 
      ADB =D-1      SUBTRACT ONE
      STB CDT+1     AND RESTORE 
      INB           RESTORE B 
      STB A           AND SAVE
      CMB,INB       MAKE NEGATIVE 
      ADB MAXPT     COMPARE TO LARGEST PARTITION
      SSB           IS IT NEGATIVE? 
      STA MAXPT     YES - SAVE NEW SIZE!
      LDB MATA      GET THE ADDRESS 
      LDA B         GET THE ADDRESS 
      ADA B3        ADD THREE 
      STA MATA      SAVE THE NEXT ENTRY POINT 
      ISZ MATNM     INCREMENT THE NUMBER OF ENTRIES 
      ISZ MAT#      INCREMENT  AND
      JMP MTDN      YES - CONTINUE
      CCA           SET THE NO MAT FLAG 
      STA NM$FL 
MTDN  LDA B3        WRITE SIX WORDS 
      JSB WRSYS       WRITE TO SYSTEM 
* 
* NOW THAT FILE MAT ENTRY HAS BEEN CREATED, UPDATE BAD
*  PAGE STATUS
* 
      LDA NWUSR     GET THE DIFFERENCE AGAIN
      SSA,RSS       IF POSITIVE 
      JMP ALLOW      WE STILL HAVE ROOM 
      ISZ CDT+1     NO - SHOW HIM THE SIZE WE USED
      LDA NO$MM     GET THE NON - EXISTANT MEMORY FLAG
      SZA,RSS       MEMORY EXHAUSTED??
      JMP MT5       NO - UPDATE 
* 
      JSB CNUMD 
       DEF *+3
       DEF CDT+1
       DEF MM#3 
      JSB EXEC      PRINT NON-EXISTANT MEMORY MESSAGE 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF MM#3M
       DEF MM#3L
      JMP ALLOW-1 
* 
MT5   JSB CNUMD 
       DEF *+3
       DEF CDT+1
       DEF MM#1     STORE IN STRING 
      JSB EXEC
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF MM#1M
       DEF MM#1L
      CLA 
ALLOW SZA,RSS       IF ZERO UPDATE THE POINTERS 
      JSB BPUPD 
      JSB MSTAT     UPDATE STATUS 
      JMP SYSOP     AND RETURN
* 
* PRINT THE MAT ERROR MESSAGE IF NECESSARY
* 
MATER JSB EXEC      PRINT THE ERROR MESSAGE 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF MATMS
       DEF MATSL
* 
       JMP SYSOP
* 
MATMS ASC 12,ILLEGAL PARTITION ENTRY
MATSL ABS *-MATMS 
MAXMP NOP 
NO$MM NOP           NON-EXISTANT MEMORY FLAG
MM#3M ASC 13,END OF MEMORY ENCOUNTERED. 
      ASC 12,  PARTITION DEFINED WITH 
MM#3  BSS 3 
      ASC  4, PAGES.
MM#3L ABS *-MM#3M 
      SKP 
* 
* THIS SUBROUTINE UPDATES THE POINTERS. IT PRESERVES B
* 
BPUPD NOP 
      STB BSAV      SAVE B
      LDA BPPTR,I   GET THE CURRENT BAD PAGE
      CPA MAXMP     IS IT THE LAST PAGE?? 
      JMP NMEM
NXBP1 INA           POINT TO NEXT PAGE
      LDB BPPTR     GET THE TABLE POINTER 
      CLE 
      CPB BPTBE     IS IT THE LAST ENTRY IN TABLE?? 
      CCE,RSS       YES - DON'T ISZ 
      ISZ BPPTR     POINT TO NEXT BAD PAGE
      LDB BPPTR,I   GET NEXT ENTRY
      SZB,RSS       DOES IT EXIST?
      CCE 
      LDB MAXMP     GET THE MAXIMUM PAGE
      SEZ 
      STB BPPTR,I   AND STORE IF LAST ENTY
      LDB BDPG#     GET THE NUMBER OF BAD PAGES 
      ADB =D-1      SUBTRACT ONE
      SSB,RSS       IF NEGATIVE DON'T UPDATE
      STB BDPG#     RESAVE
      CPA MAXMP     DOES IT EXIST?
      JMP NMEM      NO - INDICATE 
      CPA BPPTR,I   IS IT BAD ALSO? 
      JMP NXBP1     YES - GO TO NEXT ONE
      STA USER      NO - MAKE IT THE NEXT PARTITION 
      LDB BSAV
      JMP BPUPD,I 
* 
* 
BSAV  NOP 
NM$FL NOP           NO MAT ENTRY FLAG 
MATNM NOP           NUMBER OF VALID ENTRIES 
MM#1M ASC 22,BAD PAGE ENCOUNTERED. PARTITION DEFINED WITH 
MM#1  BSS 3 
      ASC 4, PAGES. 
MM#1L ABS *-MM#1M 
NWUSR NOP 
NMEM  CCA 
      STA NM$FL     SET THE NO MAT FLAG 
      JMP SYSOP 
      SKP 
************************************************* 
* MSTAT CALCULATES FREE MEMORY STATUS           * 
************************************************* 
MSTAT NOP 
      LDA USER      GET THE CURRENT VALUE OF USER 
      CMA,INA       NUMBER OF PAGES 
      ADA MAXMP     SUBTRACT FROM MAXIMUM LOCATION
      LDB BDPG#     GET THE NUMBER OF BAD PAGES 
      CMB,INB 
      ADA B         NUMBER OF PAGES 
      STA MEMSZ     SAVE MEMORY SIZE
      LDA USER      GET USER AGAIN
      CMA,INA 
      LDB BPPTR,I   GET BAD PAGE ADDRESS
      SZB,RSS       IS IT ZERO? 
      LDB MAXMP     YES - GET MAXIMUM SIZE AGAIN
      ADA B 
      STA MBKSZ       GET MAXIMUM BLOCK SIZE
      JSB CNUMD 
       DEF *+3
       DEF MEMSZ
       DEF M#2.1
      JSB CNUMD 
       DEF *+3
       DEF MBKSZ
       DEF M#2.2
      LDA TY$FL     GET THE INTERACTIVE FLAG
      SZA           ARE WE? 
      JMP MSTAT,I   NO - FORGET IT
      JSB EXEC
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF M#2.M
       DEF M#2.L
      JMP MSTAT,I 
M#2.M ASC 10, AVAILABLE PAGES  =
M#2.1 BSS 3 
      ASC 15, ,CURRENT CONTIGUOUS BLOCK = 
M#2.2 BSS 3 
M#2.L ABS *-M#2.M 
MEMSZ NOP 
MBKSZ NOP 
      SKP 
*************************************************************** 
*                                                             * 
*   NOW OPEN TYPE SIX FILES AND OBTAIN THE TRACK AND SECTOR   * 
*     ADDRESSES.  CREATE THE ID SEGMENT IN THE FILE AND       * 
*     CALL THE RE-LINKING SUBROUNTINE GIVING THE NAME OF      * 
*     OF THE SNAP AND TYPE SIX FILE.                          * 
*                                                             * 
*************************************************************** 
* 
RP    CPA =ARP      IS THIS AN RP COMMAND?
      JMP RP1       YES 
      CPA =ALK      OR RELINK?
      JMP RP1 
      JMP QUEUE     CHECK FOR QUEUING 
* 
RP1   STA RP?       SAVE THE COMMAND
      LDA =AEN      GET THE "EN" COMMAND FOR NOW
      STA CMD 
      CLA           SET  FOR DEFAULT
      STA PRIOR       PRIORITY
      STA PGSZE        AND SIZE 
      LDA FILNM     GET FILE NAME 
      LDB ERNMA 
      JSB .MVW
       DEF B3 
       NOP
      LDA =D-5
      LDB APARM     CLEAR THE 
      JSB CLRBF       PARAMETER BUFFER
      LDA =D-32     FAKE A FMP -32 ERROR IF 
      STA ERR5        AND ERROR OCCURS
      DLD RBUFR+4   SAVE THE SECURITY 
      DST SC/CR       AND CRN NUMBERS 
      JSB NAMR      PARSE AGAIN 
       DEF *+5
       DEF PGNMR    FOR THE PROGRAM NAME
       DEF NAMBF
       DEF RTLEN
       DEF CHRPS
      LDA PGNMR+3   CHECK IF ASCII
      AND B3
      CPA B3        IS IT?
      JMP RP2       YES 
      LDA PRNMA     NO TAKE CURRENT NAME
      LDB PGNMA 
      JSB .MVW
       DEF B3 
       NOP
* 
* MOUNT THE CORRECT DISC THAT THE PROGRAM IS ON 
* 
RP2   JSB DFDSK     MOUNT A DISC IF REQUIRED
      LDA =D-32     FAKE AN FMP -32 ERROR 
      STA ERR5        IF NECESSARY
      LDA SC/CR+1   GET THE CRN NUMBER
      JSB SRDSK     SEARCH FOR IT!
      JMP PGMER     NOT FOUND 
      STA CHR 
      STA PGMLU 
      JSB MCDSK     GO MOUNT THE DISC!!!! 
       DEF *+2
       DEF CHR      LU NUMBER 
      JMP PGMER     DISC NOT FOUND
* 
* NOW THAT THE DISC IS "MOUNTED" OPEN THE FILE
* 
      STA CHR       SAVE IT AWAY AGAIN
      JSB OPEN
       DEF *+7
       DEF PRDCB    PROGRAM DCB 
       DEF ERR5     ERROR 
PRNMA  DEF RBUFR    FILENAME
       DEF B4       FORCE TO TYPE ONE 
       DEF SC/CR    SECURITY CODE 
       DEF CHR      NEGATIVE LU 
      SSA           WAS THERE AN ERROR? 
      JMP PGMER     YES 
* 
* START READING FOR PROGRAM MODIFIERS 
* 
PGMMD JSB RDLNE     GET THE FIRST MODIFIER
      ERA           SAVE E
      STA ENUM
      ELA           RESTORE 
      CPA =ASZ      IS IT SIZE? 
      JMP PGMSZ     YES 
      CPA =AST      IS IT START?
      JMP PGMST     YES 
      CPA =APR      IS IT PRIORITY??
      JMP PGMPR     YES 
      CPA =ARP      IS IT ANOTHER RP? 
      JMP LK
      CPA =ALK      OR RL?
      JMP LK
      CPA =AEN      OR END? 
      JMP LK
      CPA =ASW      OR SWAP?
      JMP LK
BDCMP JSB EXEC      WRITE BAD COMMAND 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF PGBDC
       DEF PGBDL
      JMP PGMMD     NEXT ONE? 
PGBDC ASC 12,BAD RP/LK MODE COMMAND.
      OCT 6412
      ASC 20,USE "EN","RP","LK", OR "SW" TO TERMINATE 
      ASC 10, THIS RP/LK PHASE
PGBDL ABS *-PGBDC 
* 
* THE FOLLOWING ROUTINES MODIFY THE ID SEGMENT: (CON'T NEXT PAGE) 
      SKP 
* START SETS THE STARTUP PROGRAM AND INSTALLS THE PARAMETERS
*  INTO THE ID SEGMENT FOR THE INITIAL RMPAR CALL BY THE PROGRAM
* 
PGMST LDA RP? 
      CPA =ARP      WAS THIS AN RP? 
      RSS 
      JMP PGMMD     NO - FORGET ABOUT IT
      STB PARM      SAVE FIRST PARAMETER
      LDA =D-4      PARSE 4 MORE TIMES
      STA PMRCT      SAVE 
      LDA APARM     GET THE ADDRESS OF THE BUFFER 
      INA           SAVE IT 
      STA PMPTR 
RDPAR JSB NAMR      READ THE PARAMETERS 
       DEF *+5
       DEF PRMBF
       DEF NAMBF
       DEF RTLEN
       DEF CHRPS
      SSA           IF END OF STRING
      CLA,RSS         INSTALL ZERO
      LDA PRMBF     GET THE FIRST WORD
      STA PMPTR,I     AND SAVE IT 
      ISZ PMPTR     INCREMENT POINTER 
      ISZ PMRCT       AND THE COUNT 
      JMP RDPAR     READ SOME MORE
* 
      LDA CDT       GET THE FIRST WORD
      STA FSTWD       AND SAVE
      LDA IDA       GET THE CURRENT IDA 
      STA CDT       AND SAVE
      LDB BOOT      GET THE ADDRESS 
      CLA,INA       ONE WORD
      JSB WRSYS     SAVE IT 
      LDA FSTWD     GET THE ORIGINAL WORD 
      STA CDT       AND SAVE
      LDB IDA       GET THE CURRENT SEGMENT ADDRESSED 
      LDA STID      GET THE LAST PROGRAM ST'ED
      SZA,RSS       WAS THERE ONE?
      STB STID      NO - SAVE THE CURRENT ONE 
      CPB STID      WERE THEY THE SAME
      JMP PGMMD     BACK FOR NEXT COMMAND!
      LDA =D-5      CLEAR FIVE WORDS
      LDB CDTA        IN CDTA 
      JSB CLRBF     CLEAR THE BUFFER
      LDB STID      GET THE OLD ID
      INB           POINT TO SECOND WORD
      LDA B5        FIVE WORD 
      JSB WRSYS     CLEAR OLD SEGMENT 
      LDA IDA       SAVE THE CURRENT ID SEG. ADDR.
      STA STID        AS THE STARTING ID
      JMP PGMMD     AND RETURN
FSTWD NOP 
STID  NOP 
      SKP 
* 
* PGMPR CHANGES THE PROGRAM'S PRIORITY
* 
PGMPR SEZ,SZB       IS IT A NUMBER,  NOT ZERO,
      SSB            AND NOT NEGATIVE?
      JMP BDPRI 
      STB PRIOR     SAVE THE NEW VALUE!!
      JMP PGMMD     READ NEXT 
PRIOR NOP 
* 
* PGMSZ CHANGES THE SIZE ALLOCATION FOR THE PROGRAM 
* 
PGMSZ SEZ,SZB       IS THE SIZE A NUMBER, NOT NEGATIVE? 
      SSB             AND NOT ZERO? 
      JMP SZERR     NO
      LDA B         SAVE PARAMETER
      ADB =D-33 
      SSB,RSS       IS IT IN RANGE? 
      JMP SZERR     YES - ERROR 
      STA PGSZE     SAVE THE SIZE!
      CMA,INA       NEGATE
      ADA MAXPT     ADD THE MAXIMUM PARTITION 
      SSA           IS IT NEGATIVE? 
      JMP SZERR     YES - SIZE ERROR!!! 
      JMP PGMMD     BACK FOR MORE 
* 
* 
SZERR JSB EXEC
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF SZERM
       DEF SZERL
      CLA           SET FOR ORGINAL 
      STA PGSZE       DEFAULT 
      JMP PGMMD 
SZERM ASC 12,ILLEGAL SIZE FOR PROGRAM 
SZERL ABS *-SZERM 
* 
BDPRI JSB EXEC      WRITE BAD PARAMETER MESSAGE 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF QUERM
       DEF QUERL
      JMP PGMMD     AND BACK FOR MORE 
      SKP 
* 
*  MODIFICATION OF PROGRAM COMPLETE. LET'S START CHANGING 
*  THE PROGRAM FILE, AND CREATING THE ID SEGMENT
* 
* CALL THE RELINK SUBROUTINE TO RELINK THE FILES
* 
LK     JSB RLINK    RE-LINK THE CODE
        DEF *+9 
        DEF SNDCB   SNAP DCB
        DEF PRDCB   PROGRAM DCB 
        DEF LIBUF   BUFFER
        DEF LILEN     AND LENGTH
        DEF PRIOR   NEW PRIORITY
        DEF PGSZE    SIZE 
        DEF B0      DON'T WORRY ABOUT DEBUG 
        DEF B1      RE-LINK ONLY IF NEEDED
      SZA           ERROR?
      JSB RLERR     YES - INDICATE
* 
      LDA RP?       GET THE COMMAND 
      CPA =ARP      WAS IT AN RP? 
      RSS 
      JMP PRGCL     NO - CLOSE THE FILE 
* 
*   MAKE SURE WE CAN CREATE THE ID SEGMENT
* 
      LDA NORP$     GET THE NO RP FLAG
      SZA           IS IT SET?
      JMP NOID      DO NO MORE
      SKP 
* 
* FIRST CHECK THAT NO OTHER ID SEGMENT HAS THE SAME NAME! 
*    AND THAT NAME IS LEGAL 
* 
      JSB NAM..     IS IT A LEGAL NAME? 
       DEF *+2
       DEF PGNMR    PROGRAM NAME
      STA ERR5      SAVE ERROR
      SZA           IS IT ZERO? 
      JMP PGMER     NO
      LDA =D23     FAKE A FMP -23 ERROR 
      STA ERR5
      LDB ID#1      GET THE ADDRESS OF FIRST ID 
      CPB IDA       ARE THEY THE SAME?
      JMP CRTID 
      ADB =D12      POINT TO NAME 
IDLOP JSB RDSYS     READ THE SYSTEM 
      CPA PGNMR     IS IT EQUAL?
      RSS 
      JMP NXTI2     NO
      JSB RDSYS     READ THE NEXT WORD
      CPA PGNMR+1   IS IT CORRECT?
      RSS 
      JMP NXTI1 
      JSB RDSYS     READ THE NEXT WORD
      AND =B177400
      STA CDT       SAVE
      LDA PGNMR+2   GET THE THIRD WORD= 
      AND =B177400
      CPA CDT       ARE THEY THE SAME?
      JMP PGMER     YES -SAME NAME SO ERROR 
      JMP *+3 
NXTI2 INB           MAKE
NXTI1 INB            THE POINTER
      ADB =D27       TO THE NEXT ID SEGMENT NAME
      LDA IDA 
      CMA,INA 
      ADA B 
      SSA           POSITIVE MEANS THE SEARCH HAS ENDED 
      JMP IDLOP 
* 
CRTID JSB READF     READ FOR THE ID SEGMENT 
       DEF *+7
       DEF PRDCB    PROGRAM DCB 
       DEF ERR5     ERROR CODE
       DEF CDT      BUFFER ADDRESS
       DEF .36        AND LENGTH TO READ
       DEF PRLEN    LENGTH RETURNED 
       DEF B1       FIRST RECORD
      SSA           ERROR 
      JMP PGMER 
      SKP 
* 
******************************************************
* CREATE THE ID SEGMENT                              *
******************************************************
      LDB CDTA      THE ADDRESS OF THE SEGMENT
      INB             SECOND WORD 
      LDA APARM     GET THE PARAMETERS SPECIFIED
      JSB .MVW      MOVE THEM IN
       DEF B5       FIVE WORDS
       NOP
      LDA PGNMA     GET THE PROGRAM NAME
      ADB B6        ADD SIX MORE TO GET ID SEGMENT NUMBER 
      RRL 1         MAKE BYTE ADDRESS 
      JSB .MBT      MOVE NAMR 
       DEF B5       FIVE CHR. 
       NOP
      INB           MAKE IT SIX BYTES 
      RBR             AND CONVERT 
      ADB =D10      POINT TO WORD 26
      STB IDPTR     SAVE IT 
      LDA =D99      A DEFAULT PRIORITY
      LDB CDT+6       AND THE PRIORITY ASSIGNED 
      SZB,RSS       IS IT ZERO? 
      STA CDT+6     YES - SO STORE A DEFAULT
      LDA PRDCB+4   GET THE DISC ADDRESSES
      ADA B2        BUMP TO START OF MAIN 
      CLB           CLEAR B FOR DIVIDE
      DIV PRDCB+8   DIVIDE BY SECTOR/PER TRACK
      SWP 
      ADB PRDCB+3   ADD STARTING TRACK NUMBER 
      ARS           CONVERT SECTOR TO BLOCKS
      ALF,ALF       MOVE TO UPPER BYTE
      STA IDPTR,I   STORE 
      ISZ IDPTR     POINT TO WORD 27
      STB IDPTR,I   STORE 
      ISZ IDPTR     POINT TO WORD 28
      LDA PGMLU     GET THE DISC LU 
      STA IDPTR,I   STORE LU
      CLA,INA       PUT A ONE 
      ISZ IDPTR     POINT TO WORD 29
      STA IDPTR,I   STORE 
      CLA           CLEAR WORD
      ISZ IDPTR       30
      STA IDPTR,I 
      LDA CDT+24    GET THE NUMBER OF PAGES 
      ALF,ALF 
      RAR,RAR       PUT IN PROPER POSITION
      AND =B77
      INA           MAKE NUMBER OF PAGES
      CMA,INA       MAKE NEGATIVE 
      ADA MAXPT     GET THE CURRENT LARGEST PARTITION 
      SSA,RSS       IS IT NEGATIVE
      JMP WRID      NO - WRITE TO SYSTEM
      SKP 
* 
* WRITE THE ERROR MESSAGE IF NECESSARY
* 
      JSB EXEC      WRITE ERROR MESSAGE 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF SWWRM
       DEF SWWRL
      JMP WRID
SWWRM ASC 27,WARNING! PROGRAM SIZE EXCEEDS LARGEST PARTITION SIZE 
SWWRL ABS *-SWWRM 
* 
* THE ID SEGMENT IS DONE. WRITE IT INTO THE SYSTEM
* 
**
WRID  LDA IDSZ      THIRTY WORD 
      LDB IDA       ADDRESS OF SEGMENT
      JSB WRSYS     WRITE TO SYSTEM 
      LDA IDA       ADD 30
      ADA IDSZ        TO THE ID SEGMENT ADDRESS 
      STA IDA            AND RESTORE
      ISZ ID#       INCREMENT THE NUMBER
      JMP PRGCL       AND START LINKING!!!! 
      CCA           NO MORE IDS 
      STA NORP$     SO NO MORE RP OF PROGRAMS 
PRGCL JSB CLOSE     CLOSE THE PROGRAM FILE
       DEF *+3
       DEF PRDCB
       DEF ERR5 
      LDA CHR       GET THE +CRN/-LU
      JSB DCDSK     DISMOUNT THE DISC 
PRGC1 LDA ENUM      GET THE E-BIT 
      ELA           AND REPLACE 
      LDA CMD       GET THE COMMAND AGAIN 
      CPA =AEN      WAS IT AN END?
      JMP SYSOP 
      CPA =ASW      WAS IT SWAP?
      JMP SWAP1 
      JMP RP1       YES - SO END
      SKP 
* 
* CONSTANTS AND ERROR ROUTINES
* 
RP?   NOP 
APARM DEF *+1 
PARM  BSS 5 
ENUM  NOP 
PMRCT NOP           COUNTER 
PMPTR NOP           POINTER 
PRMBF BSS 10
PGNMA DEF PGNMR 
PGNMR BSS 10
ID#1  NOP 
.36   DEC 36
IDPTR NOP           "ID SEGMENT" POINTER
PRLEN NOP 
NORP$ NOP           NO RP PROGRAM FLAG
CHR   NOP 
B5    OCT 5 
SC/CR BSS 2 
PGSZE NOP 
NCRLF NOP 
LIBUF NOP           FIRST WORD BACKGROUND 
LILEN NOP             AND NUMBER OF WORDS 
PGMLU NOP           PROGRAM LU
ERNAM BSS 3         CURRENT FILE NAME FOR ERRORS
* 
* ERROR ROUTINES FOR THE PROGRAM INITIALIZATION 
* 
PGMER LDA ERR5      MAKE THE ERROR POSITIVE 
      SSA           IS IT NEGATIVE? 
      CMA,INA 
      STA ERRT        AND RESTORE 
      JSB CNUMD 
       DEF *+3
       DEF ERRT 
       DEF PGSTG
      LDA ERR5
      LDB MINUS 
      SSA 
      STB PGSTG 
      JSB EXEC      WRITE TO TEMINAL
       DEF *+5
       DEF B2       WRITE 
       DEF NCRLF
       DEF PRMSG    MESSAGE 
       DEF PRMSL
PROG  JSB EXEC      WRITE THE FILE NAME 
       DEF *+5
       DEF B2       WRITE 
       DEF TERM     TO TERMIMAL 
       DEF ERNAM    FILE NAME 
       DEF B3       3 WORDS 
      JSB CLOSE     CLOSE THE FILE
       DEF *+2
       DEF PRDCB    PROGRAM DCB 
      LDA CHR       GET THE CRN/LU
      JSB DCDSK       AND DISOMUNT THE DISC 
      JMP PRGC1 
PRMSG ASC 5,FMP ERROR 
PGSTG BSS 3 
      ASC 5, ON FILE
PRMSL DEF *-PRMSG 
ERR5  NOP 
ERRT  NOP 
* 
* RE-LINK ERROR HANDLER 
* 
RLERR NOP 
      STA B 
      CPB =D16      WAS THIS A WARNING? 
      JMP LKWN      YES - ISSUE THE WARNING 
      CPA =D18      IS WAS IT ILLEGAL SIZE? 
      JMP FORSZ     YES - INDICATE
      JSB EXEC
       DEF *+5
       DEF B2 
       DEF NCRLF
       DEF RLMSG
       DEF RLMSL
      JSB EXEC      NOW WRITE PROGRAM NAME
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF ERNAM
       DEF B3 
      JMP PRGCL     AND COMPLETE THIS WAY 
RLMSG ASC 14,ERROR ON RELINK OF PROGRAM 
RLMSL ABS *-RLMSG 
LKWN  JSB EXEC      PRINT WARNING 
       DEF *+5
       DEF B2 
       DEF NCRLF
       DEF LKWRM
       DEF LKWRL
      JMP EXEC        AND PROGRAM NAME
       DEF *+5
       DEF B2 
       DEF TERM 
ERNMA  DEF ERNAM
       DEF B3 
      JMP RLERR,I   RETURN TO PROGRAM 
* 
LKWRM ASC 20,WARNING!! RPL CHECKSUM ERROR ON PROGRAM
LKWRL ABS *-LKWRM 
NOID  JSB EXEC      PRINT ERROR MESSAGE 
       DEF *+5
       DEF B2 
      DEF TERM
       DEF NIDMS
       DEF NIDML
      JMP PRGCL     EXIT NORMALLY 
NIDMS ASC 25,WARNING!! NO MORE ID SEGMENTS. PROGRAM RE-LINKED.
NIDML ABS *-NIDMS 
      SKP 
* 
*     PRINT MESSAGE FOR SIZE ERROR
* 
FORSZ JSB EXEC
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF WRSZM
       DEF WRSZL
      CLA 
      STA PGSZE 
      JMP LK        TRY IT AGAIN
WRSZM ASC 28,ERROR. SPECIFIED SIZE IS SMALLER THAN MINIMUM REQUIRED.
      ASC  7, DEFAULT USED
WRSZL ABS *-WRSZM 
*************************************** 
* SET UP TIME SLICE PARAMETERS        * 
*************************************** 
QUEUE CPA =AQU      IS THIS FOR TIME SLICE MODIFICATION?
      RSS 
      JMP BCKGR     NO - CHECK BACKGROUND PRIORITY
      SEZ,SZB       IS IT A NUMBER AND NOT ZERO?
      SSB              AND NOT NEGATIVE?
      JMP QUERR     NO - SAY BAD PARAMTER 
      LDA B         SAVE NUMBER 
      CLB             AND PREPARE TO DIVIDE 
      DIV =D10      DIVIDE BY TEN 
      CMA,INA         AND NEGATE
      STA QU        AND SAVE
      JSB NAMR      PARSE FOR SECOND PARAMETER
       DEF *+5
       DEF CDT
       DEF NAMBF
       DEF RTLEN
       DEF CHRPS
      LDA CDT+3      CHECK THE TYPE 
      AND B3
      SZA,RSS       IS IT NULL? 
      JMP UPQU      YES 
      CPA B3        IS IT ASCII?
      JMP QUERR     YES - ERROR 
      LDA CDT       GET THE PARMETER
      SZA           IS IT ZERO? 
      SSA             OR NEGATIVE?
      JMP QUERR     YES - BAD PARAMETER 
      CLA,INA       ONE WORD
      LDB TSPR        HERE
      JSB WRSYS     DO IT!! 
UPQU  LDA QU        GET THE QU PARAMTER 
      STA CDT 
      CLA,INA 
      LDB TSQU
      JSB WRSYS     WRITE TO SYSTEM 
      JMP SYSOP     BACK FOR MORE 
QU    NOP 
      SKP 
BCKGR CPA =ABG      IS IT A BACKGROUND COMMAND? 
      RSS 
      JMP SECUR 
      SEZ,SZB       IS IT A NUMBER OR ZERO? 
      SSB           OR NEGATIVE?? 
      JMP QUERR 
      STB CDT 
      CLA,INA       ONE WORD
      LDB BGPR        INTO
      JSB WRSYS         THE SYSTEM
      JMP SYSOP 
* 
SECUR CPA =ASS      CHANGE SECURITY CODE
      RSS 
      JMP SWAP
      STB CDT       SAVE IT 
      LDB XECM      GET THE LOCATION
      CLA,INA       ONE WORD
      JSB WRSYS     WRITE TO SYSTEM 
      JMP SYSOP     BACK FOR MORE 
* 
* ERROR MESSAGE FOR BAD PARAMETER 
* 
QUERR JSB EXEC
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF QUERM
       DEF QUERL
      JMP SYSOP 
QUERM ASC  7,BAD PARAMETER
QUERL ABS *-QUERM 
      SKP 
****************************************
* THE PROGRAM PREPARATION PROCESS IS   *
* FINISHED.  INITIALIZE THE SWAP AREA! *
****************************************
      SPC 2 
SWAP  CPA =ASW      DECLARE A SWAP LU?
SWAP1 CCA,RSS       YES - SET THE SWAP FLAG 
      JMP DONE
      STA SWFLG       TO INDICATE AN ATTEMPT
      LDB SWLU      CHECK THAT SWAPPING CAN BE
      JSB RDSYS       BY READING THE SWAP LU TABLE
      CPA =D-1      DOES THE TABLE EXIST
      JMP NOSWP     NO - NO SWAPPING ALLOWED!!! 
      LDA MAXPT     GET THE CURRENT MAXIMUM PARTITION 
      SZA,RSS       IS IT ZERO? 
      JMP SWERR     YES - ILLEGAL AT THIS TIME
      JSB DFDSK     CHECK THAT A DISC IS MOUNTED
      LDB RBUFR     GET THE SECOND PARAMETER AGAIN
      SZB           IS IT ZERO??? 
      JMP SWPRS 
      LDA SWAPN     YES - GET DEFAULT NAME
      LDB PRNMA       AND TARGET BUFFER 
      JSB .MVW      MOVE IT 
       DEF B3 
       NOP
      LDA =ASW      GET THE SWAP FILE SECURITY CODE 
      STA RBUFR+4   SECURITY CODE 
      LDA CDLU+1    GET THE FIRST LU
      SZA,RSS       IS IT ZERO? 
      JMP DONE      YES - QUIT WHILE WE'RE AHEAD
* 
SWPRS LDA RBUFR+5   GET THE CRN 
      JSB SRDSK     GET THE DISC LU 
      JMP SWERR     CARTRIDGE NOT MOUNTED 
      STA CHR       AND SAVE
      STA RBUFR+5 
      JSB MCDSK     MOUNT THAT DISC!!!
       DEF *+2
       DEF CHR      THIS LU 
* 
      JMP SWERR 
      STA CHR 
      SKP 
* 
* TRY TO OPEN THE SWAP FILE 
* 
      CCA           SET THE FILE EXIST
      STA FLEXT       FLAG
      JSB OPENF     TRY OPENING THE SWAP FILE 
       DEF *+7
       DEF PRDCB    DCB 
       DEF ERR5     ERROR CODE
       DEF RBUFR    SWAP NAME 
       DEF B0       NO OPTION 
       DEF RBUFR+4  SECURITY CODE 
       DEF CHR      LU
* 
      CPA =D-6      FILE NOT FOUND??
      JMP SWPCR     YES - CREATE IT 
      SSA           WAS THERE ANOTHER ERROR?
      JMP SWERR     YES - ERROR 
      CPA B1        IS IT TYPE ONE? 
      JMP SWTBL     YES - GENERATE THE TABLE
      JMP SWERR     NO - ERROR
* 
SWPCR LDA RBUFR+7   GET SIZE
      CCB           MINUS ONE IN CASE 
      SZA,RSS       IS IT ZERO? 
      STB RBUFR+7 
      JSB CREAT     CREATE THE FILE 
       DEF *+8
       DEF PRDCB
       DEF ERR5 
       DEF RBUFR    NAME
       DEF RBUFR+7  SIZE OF FILE
       DEF B1       TYPE ONE
       DEF RBUFR+4  SECURITY CODE 
       DEF CHR      CRN/LU
* 
      SSA           WAS THERE AN ERROR? 
      JMP SWERR 
      CLA 
      STA FLEXT     CLEAR THE FILE CREATE FLAG
      SKP 
* 
*  START BUILDING THE SWAP TABLE
* 
SWTBL LDA RBUFR+5   GET THE SWAP LU 
      STA CDT         AND SAVE
      DLD PRDCB+3   GET THE TRACK & SECTOR
      DST CDT+1       AND SAVE
      RBR           STARTING BLOCK
      STB SCR         SAVE TEMPORARILY
      LDA PRDCB+8   GET THE NUMBER OF SECTORS/TRACK 
      RAR           CONVERT TO BLOCKS 
      STA CDT+6       AND SAVE
      MPY PRDCB+3   MULTIPLY BY NUMBER OF TRACKS
      CLE 
      ADA SCR       CONVERT TO STARTING BLOCK 
      SEZ 
      CLE,INB 
      DST CDT+8     AND SAVE IN THE TABLE 
      LDA MAXPT     GET THE MAXIMUM PARTITION 
      ALF,RAR       MULTIPLY BY 8 
      STA CDT+7      AND SAVE 
      LDA PRDCB+5   GET THE FILE SIZE 
      RAR           CONVERT TO BLOCKS 
      CLB           PREPARE FOR DIVIDE
      DIV CDT+7     DIVIDE BY BLK/PART
      STA B         SAVE IN B 
      CMA,INA       NEGATE A
      ADA IDNUM 
      SSA 
      LDB IDNUM     DO NOT EXCEED SIZE OF SWAP TABLE
      SZB,RSS       IS THERE ROOM?
      JMP SWERR     YES - ERROR 
      STB CDT+3     NO - SAVE IT
      LDA SWTA      GET THE TABLE ADDRESS 
      ADB A         ADD TO B
      DST CDT+4       AND STORE 
      LDA =D10      TEN WORDS 
      LDB SWLU        AND THE ADDRESS 
      JSB WRSYS     WRITE TO SYSTEM 
      LDA CDT+3     GET THE NUMBER OF ENTRIES 
      MPY CDT+7       MULTIPLY BY NUMBER OF ENTRIES 
      STA SWSZ      AND SAVE
      SKP 
* 
* NOW THAT SWAP ENTRY HAS BEEN MADE, CALL LOCF TO GET FILE
*    SIZE IF WE CREATED THE FILE
* 
      LDB FLEXT     DID THE FILE EXIST? 
      CMB,SZB,RSS   WAS IT SET? 
      JMP SWCLS     YES - CLOSE THE FILE
      JSB LOCF      GET FILE PARAMETERS 
       DEF *+7
       DEF PRDCB
       DEF ERR5 
       DEF SCR
       DEF SCR+1
       DEF SCR+2
       DEF SWFSZ    FILE SIZE IS ALL WE NEED
      SSA 
      JMP SWERR 
      LDB SWFSZ     GET THE SIZE IN SECTORS 
      RBR           CONVERT TO BLOCKS 
      LDA SWSZ      GET THE FILE SIZE 
      CMA,INA       SUBTRACT FROM 
      ADB A 
SWCLS STB SWFSZ     NUMBER OF BLOCKS TO DELETE
      JSB CLOSE     CLOSE THE SWAP FILE!!!!!
       DEF *+4
       DEF PRDCB
       DEF ERR5 
       DEF SWFSZ    TRUNCATE THIS MANY BLOCKS 
      LDA CHR       GET THE CRN/LU
      JSB DCDSK      AND DISMOUNT IT
      SKP 
* 
* PRINT SWAP MESSAGE FOR USER 
* 
      JSB CNUMD     CONVERT THE SWAP NUMBER 
       DEF *+3
       DEF CDT+3
       DEF SWMSG
      JSB EXEC
       DEF *+5
       DEF B2       WRITE 
       DEF TERM 
       DEF SWMSG
       DEF SWMSL
* 
      LDA IDNUM     GET THE NUMBER OF IDS 
      CMA,INA       MAKE NEGATIVE 
      ADA CDT+3     ADD TO NUMBER OF ENTRIES
      SSA,RSS       IS IT NEGATIVE? 
      JMP SWCMP     NO - ALL DONE 
      JSB EXEC      YES - WRITE WARNING MESSAGE 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF WRNMG
       DEF WRMML
      JMP SWCMP 
SWMSG BSS 3 
      ASC 11, SWAP AREAS AVAILABLE
SWMSL ABS *-SWMSG 
WRNMG ASC 20,WARNING!! NUMBER OF ID SEGMENTS EXCEEDS
      ASC 11,NUMBER OF SWAP AREAS!
WRMML ABS *-WRNMG 
      SKP 
* 
* SWAP ERROR MESSAGES 
* 
NOSWP LDA CMD       GET THE COMMAND 
      CPA =AEN      WAS IT END? 
      JMP ALDN      YES 
      JSB EXEC      NO - WRITE MESSAGE
       DEF *+5
       DEF B2       WRITE 
       DEF TERM       TO TERMINAL 
       DEF NOSWM
       DEF NOSWL
      JMP SYSOP 
NOSWM ASC 16,SWAPPING NOT ALLOWED IN SYSTEM 
NOSWL ABS *-NOSWM 
* 
SWERR JSB EXEC      WRITE ERROR MESSAGE 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF SYEMS
       DEF SYEML
      CLA,RSS 
SWCMP CCA           SET THE NO MAT FLAG 
      STA NM$FL       SO NO MORE MATS MAY BE CREATED
      LDA CMD       GET THE COMMAND AGAIN 
      CPA =AEN      IS IT AN END
      JMP ALDN      YES - COMPLETE
      JMP SYSOP     NO - READ NEXT COMMAND
SYEMS ASC 15,SWAP FILE INITIALIZATION ERROR 
SYEML ABS *-SYEMS 
IDNUM NOP           NUMBER OF IDS 
SCR   BSS 5         SCRATCH AREA
SWSZ  NOP           SWAP SIZE 
SWFSZ NOP 
MAXPT NOP 
FLEXT NOP           FILE EXIST FLAG 
SWFLG NOP           SWAP FLAG 
SWAPN DEF *+1 
      ASC 3,SWAP
      SKP 
**************************************
*  ZERO OUT ALL UNUSED TABLES BEFORE *
*     CLOSING THE SYSTEM FILE        *
**************************************
      SPC 2 
DONE  CPA =AEN      END 
      RSS 
      JMP BDCMD     MUST BE BAD COMMAND 
DONE2 LDA =D-30     CLEAR 30 WORDS
      LDB CDTA        IN THE WRITE BUFFER 
      JSB CLRBF     DO IT 
      LDA CD#       GET THE NUMBER OF CARTRIDGE 
      SZA,RSS       IS IT FULL? 
      JMP IDDN      YES - FINISH ID SEGMENTS
      LDB CDA       ADDRESS 
DONE3 LDA B4          AND FOUR WORDS
      JSB WRSYS     WRITE TO THE SYSTEM 
      LDB CDA       BUMP TO NEXT
      ADB B4           ENTRY
      STB CDA 
      ISZ CD#       BUMP THE NUMBER 
      JMP DONE3 
IDDN  LDA ID#       NUMBER OF ID SEGMENTS 
      SZA,RSS       ALL FILLED? 
      JMP MTADN 
IDDN1 LDB IDA 
      LDA IDSZ      THIRTY WORDS
      JSB WRSYS     WRITE IT
      LDA IDA       GET THE ADDRESS AGAIN 
      ADA IDSZ      ADD THIRTY
      STA IDA 
      ISZ ID#       ALL DONE? 
      JMP IDDN1 
MTADN LDA MATNM     GET THE NUMBER VALID
      STA CDT         AND SAVE IT 
      CLA,INA       ONE WORD
      LDB MATV        AT THIS LOCATION
      JSB WRSYS     WRITE IT
      LDA MAT#      MAT ENTRIES DONE? 
      SZA,RSS       ALL FULL? 
      JMP ALDN      YES ALL DONE
      CCB           FIRST WORD = -1 
      STB CDT          SAVE 
MTAD1 LDA B3        NO - THREE WORDS
      LDB MATA        AND THE ADDRESS 
      JSB WRSYS 
      LDA MATA      BUMP MAT ADDRESS BY 
      ADA B3          THREE 
      STA MATA
      ISZ MAT#      ALL TABLE ENTRIES FULL? 
      JMP MTAD1     NO - BACK FOR MORE
* 
*  (CON'T)
      SKP 
* 
      LDA SWFLG     WAS A SWAP FILE CREATED 
      CMA,SZA,RSS   ??
      JMP ALDN      YES - GO FINISH IT OFF
      CLA 
      STA RBUFR     CLEAR THESE LOCATIONS 
      STA RBUFR+1     TO
      STA RBUFR+2       FORCE 
      STA RBUFR+4         DEFAULT 
      STA RBUFR+5           VALUES
      JMP SWAP1 
      SPC 1 
*********************************** 
*  NOW CLOSE ALL THE WORK FILES   * 
*    AND START THE BOOT           * 
*********************************** 
      SPC 2 
ALDN  CLB           CLEAR B FOR DIVIDE
      LDA SYDCB+3   GET THE TRACK NUMBER
      DIV 107B        DIVIDE BY NUMBER HEADS FOR CYLINDER 
      ADA 103B      ADD THE STARTING CYLINDER 
      STA CYL         AND SAVE
      RRR 16        GET THE HEAD OFFSET 
      CLB             PREPARE FOR MULTIPLY
      MPY SYDCB+8 
      RAR           DIVIDE BY TWO TO CORRECT
      LDB SYDCB+4   GET SECTOR OFFSET 
      RBR           DIVIDE BY TWO TO CORRECT
      ADA B         ADD TO OFFSET 
      STA DSCAD       AND SAVE
ALDN1 JSB CLOSE     DONE SO CLOSE 
       DEF *+2
       DEF SYDCB      BOOT CONTROL FILE 
      JSB CLOSE     AND THE 
       DEF *+2
       DEF SNDCB      SNAP DCB
      JSB CLOSE 
       DEF *+2
       DEF BCDCB     AND THE
      JSB EXEC      WRITE COMPLETION MESSAGE
       DEF *+5
       DEF B2       WRITE 
       DEF TERM       TO TERMINAL 
       DEF ENMSG    ALL DONE
       DEF ENMSL
* 
      LDB BTFLG     GET THE BOOT FLAG 
      LDA =D-12      AND THE ERROR COD
      SZB,RSS       MAKE SURE WE'RE BOOTABLE
      JMP BOTER     NO - ERROR
      JSB $LIBR     GO PRIVILEDGED
       NOP
      CLC 6,C       TURN OFF RTE!!! 
      LDA BCNAM+3   GET THE SUSPEND FLAG
      CPA =ASS      SUSPEND?
      CCE,RSS 
      CLE 
      LDA =B400     SET THE START 
      OTA 1           FOR VCP 
      LDA S.C       GET THE SELECT CODE 
      OTA 2,C         AND ENABLE GLOBAL REGISTER
      CLA,INA       ONE 
      CLC 2         ENABLE VCP
      JSB B         GO LOAD IT!!!!!!
HPIB  NOP 
UN.HD NOP 
DSCAD NOP 
CYL   NOP 
      NOP           FOR FUTURE USE
      NOP 
      NOP 
ENMSG ASC 11,BOOT PROCESS COMPLETE
ENMSL ABS *-ENMSG 
BDCMD JSB EXEC      BAD COMMAND MESSAGE 
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF BDMSG
       DEF BDMSL
      LDA SYFL$     GET THE SYSTEM FLAG 
      AND SNFL$       AND WITH SNAP FLAG
      SZA           ARE THEY SET??
      JMP SYSOP       YES - READ FOR COMMANDS 
      JMP GETFL       NO - READ FOR SYS/SNP 
BDMSG ASC 11,COMMAND NOT RECOGNIZED 
BDMSL ABS *-BDMSG 
      SKP 
************************************************************
*  THESE SUBROUTINES PERFORM VARIOUS REDUNDANT OPERATIONS  *
*     TO THE SYSTEM IN THE PROCESS OF BEING BOOTED         *
************************************************************
CLRBF NOP           CLEAR THE WRITE BUFFER
      STA CLRCT       WORDS 
      CLA           CLEAR 
CLRLP STA B,I         BUFFER
      INB           MAKE NEXT ADDRESS 
      ISZ CLRCT     INCREMENT 
      JMP CLRLP 
      JMP CLRBF,I   ALL DONE
CLRCT NOP 
**************************************************
*  RDSYS READS ONE WORD OUT OF THE SYSTEM FILE   *
**************************************************
RDSYS NOP 
      STB ADDR      SAVE THE CURRENT ADDRESS
      LDA B         GET BLOCK NUMBER
      CLB           SET UP FOR DIVIDE 
      DIV B200      DIVIDE TO GET BLOCK+OFFSET
      STB OFST        SAVE OFFSET 
      INA           INCREMENT TO CORRECT BLOCK NUMBER 
      CPA BLK       IS IT IN CORE?
      JMP RD3       YES - GO GET DATA 
      STA BLK       NO - SAVE NEW BLOCK 
RD1   JSB READF     READ THE BUFFER 
       DEF *+7
       DEF SYDCB    SYSTEM DCB
       DEF ERR4 
       DEF SYBUF    SYSTEM BUFFER 
       DEF B200     TWO WORDS 
       DEF LEN      LENGTH
       DEF BLK      BLOCK NUMBER
      SSA           WAS THERE AN ERROR? 
      JMP SYERR     YES - GO REORT IT 
RD3   LDB SYSBA     GET THE SYSTEM BUFFER ADDRESS 
      ADB OFST      ADD THE OFFSET
      LDA B,I       GET THE DATA
      LDB ADDR      GET THE ORIGINAL ADDRESS
      INB           INCREMENT AND 
      JMP RDSYS,I     RETURN
* 
ADDR  NOP 
      SKP 
* 
* 
*  WRSYS WRITES THE DATA BUFFER INTO THE SYSTEM.
*  THE SOURCE DATA BUFFER IS AT CDT, A = DATA COUNT 
*  B = ADDRESS
* 
WRSYS NOP 
      CMA,INA       NEGATE &
      STA DTACT       SAVE BUFFER COUNT 
      LDA CDTA      GET DATA BUFFER ADDRESS 
      STA BFADR     AND SAVE
      RRR 16        PREPARE TO GET BLOCK & OFFSET 
      CLB           CLEAR B 
      DIV B200      DIVIDE TO GET BLOCK & OFFSET
      STB OFSTW       AND OFFSET
      RRR 16        DO A ONE WORD READ
      BLF,BLF 
      RBR           MULTIPLY BY 200B
      CLA,INA         TO ESTABLISH CORRECT BUFFER 
NXBLK JSB RDSYS     READ IT 
      LDB SYSBA     GET THE SYSTEM BUFFER ADDRESS 
      ADB OFSTW     ADD THE OFFSET
NXT   LDA BFADR,I   GET THE DATA
      STA B,I       AND STORE IN BLOCK
      INB           POINT TO NEXT ADDRESS 
      ISZ BFADR       AND NEXT DATA BUFFER
      LDA OFSTW     GET THE OFFSET
      INA           INCREMENT IT
      CPA B200      IS IT LAST WORD IN BUFFER?
      JMP WRBLK     YES - WRITE THE BLOCK 
      STA OFSTW     NO - RESTORE POINTER
      ISZ DTACT     INCREMENT COUNT 
      JMP NXT 
* 
WRBLK JSB WRITF     RE-WRITE THE DATA ONTO THE DISC 
       DEF *+6
       DEF SYDCB
       DEF ERR4 
       DEF SYBUF
       DEF B200 
       DEF BLK
* 
      SSA           ERROR?
      JMP SYERR     YES 
      LDA DTACT     GET THE DATA COUNT
      SZA,RSS       ALL DONE? 
      JMP WRSYS,I   YES - RETURN
      LDA BLK       MAKE THE NEXT ADDRESS 
      ALF,ALF       MULTIPLY BY B200
      RAR 
      LDB A         PUT IN B
      CLA           CLEAR 
      STA OFSTW     AND SAVE
      INA 
      JMP NXBLK     NEW BLOCK 
      SKP 
* 
* 
*  RDLNE GETS A STRING FROM THE CONTROL FILE AND PARSES IT FOR
*    THE BOOT PROGRAM.  THIS ROUTINE READS ONE RECORD AND 
*    PUTS THE FIRST TWO CHARACTERS IN THE A REGISTER.  THE REST OF
*    THE STRING IS IN NAMBF, AND THE FILE NAME STRING IS IN RBUFR 
* 
RDLNE NOP 
RDLN0 LDA TY$FL     GET THE TELETYPE FLAG 
      SZA           IS IT ZERO? 
      JMP RDLN1     NO - JUST READ THE FILE 
      JSB EXEC      YES - WRITE PROMPT
       DEF *+5
       DEF B2       WRITE 
       DEF TERM       TO TERMINAL 
       DEF PRMPT    THE PROMPT
       DEF B5        AND ITS LENGTH 
* 
RDLN1 JSB READF     READ THE CONTROL FILE 
       DEF *+6
       DEF BCDCB    BOOT CONTROL DCB
       DEF ERR      ERROR CODE
       DEF NAMBF    BUFFER ADDRESS
       DEF B200     LENGTH
       DEF RTLEN    RETURNED LENGTH 
      SSA           WAS THERE AN ERROR? 
      JMP BOTER     YES - INDICATE
      LDA RTLEN     GET LENGTH
      CMA,SZA,RSS   EOF?
      JMP EOF       YES - ALL DONE
      LDA ECHO      GET THE ECHO FLAG 
      CMA,SZA       IS IT SET?
      JMP NOEC      YES - REWRITE IT
      JSB EXEC
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF NAMBF
       DEF RTLEN
NOEC  LDA RTLEN     GET THE WORD LENGTH 
      RAL           MULTIPLY BY TWO 
      STA RTLEN       AND RESTORE 
      CLA 
      STA CMD       CLEAR COMMAND 
      INA           START AT 1
      STA CHRPS       AND SAVE
RDL2  JSB NAMR      PARSE THE STRING
       DEF *+5
       DEF RBUFR
       DEF NAMBF    NAME OF BUFFER
       DEF RTLEN    NO. OF CHR. 
       DEF CHRPS    OUTPUT BUFFER 
      LDB CMD       GET COMMAND 
      SSA           END OF STRING?
      SZB             AT BEGINNING? 
      JMP RDL5      NO
      LDA =AZZ      YES - FAKE AN UNKNOWN COMMAND 
      JMP EOF+1       AND JUMP
RDL5  LDA RBUFR+3   LOOK AT THE TYPE
      AND B3        GET IT
      CPA B1        IS IT A NUMBER
      CCE,RSS       YES - IT IS 
      CLE 
      DLD CMD 
      SZA 
      JMP RDL4
      STB CMD 
      RRL 8         GET THE FIRST CHARACTER 
      CPA STAR      IS IT A COMMENT?? 
      JMP RDLN0     YES - RE-READ THE LINE
      JMP RDL2
RDL4  CPA =AEC      IS IT AN ECHO COMMAND 
      RSS 
      JMP RDLNE,I 
      LDB ECHO      YES - FLIP THE FLAG 
      CCB 
      STB ECHO
      JMP RDLN0 
* 
ECHO  NOP           ECHO FLAG 
STAR  OCT 52        '*' 
CHRPS NOP 
EOF   LDA =AEN      INDICATE END
      STA CMD         AND SAVE COMMAND
      JMP RDLNE,I     AND EXIT
* 
RTLEN NOP           LENGTH PARAMETER
PRMPT ASC 5,BOOTEX:  _X 
      SKP 
***************************************************** 
* MCDSK MOUNTS A DISC FOR THE BOOT SYSTEM SO THE    * 
*  RE-LINK PROGRAM CAN WORK.                        * 
***************************************************** 
* 
*  THIS ROUTINE MOUNTS A DISC BY SEARCHING THROUGH A TABLE FOR THE
*    CORRECT SYSTEM LU, AND COPYING ITS DRIVER PARAMETERS INTO
*    ITS OWN SPARE DVT (LU 3).  IT THEN READS THE LAST TRACK OF THE 
*    DISC FOR THE CRN NUMBER
**
LU    NOP 
MCDSK NOP 
      JSB .ENTR 
       DEF LU 
      LDA #DSC      GET THE NUMBER OF DISCS 
      CMA           NEGATE AND ADD ONE
      STA DSC#
      LDB TMPR        GET THE TABLE ADDRESS 
DSCTS LDA B,I       GET THE LU NUMBER 
      AND =B77      MASK IT OUT 
      SZA,RSS       IS IT ZERO? 
      JMP MCDSK,I   YES - NO MORE ENTRIES IN TABLE
      CPA LU,I      IS THIS THE CORRECT LU? 
      JMP LUFND     YES - THE LU IS FOUND 
      ADB =D10      NO INDEX TO NEXT ENTRY
      ISZ DSC#      INCREMENT 
      JMP DSCTS     TRY - AGAIN 
      JMP MCDSK,I   NOT FOUND 
* 
LUFND LDA B,I       GET THE DISC TYPE 
      SSA           IS IT A COMMAND SET 80 DISC?
      JMP C80DS     YES - SET UP DVT FOR CORRECT DRIVER 
      LDA DVR30     GET THE AMIGO DISC DRIVER 
      RSS 
C80DS LDA DVR33     GET THE CMD 80 DISC DRIVER
      STB TBLA        AND SAVE THE TABLE ADDRESS (TEMP) 
      ADB =D9       POINT TO SELECT CODE
      LDB B,I       GET IT
      CPB S.C       COMPARE WITH HOME SELECT CODE 
      CLB,RSS       EQUAL - POINT TO LU 3 
      CLB,INB       NOT EQUAL - POINT TO 4
      ADB B2        MAKE LU-1 
      STB CDT       SAVE THE LU-1 
      ISZ CDT         AND INCREMENT IT TO LU
      ADB $LUTA     GET THE LU TABLE ADDRESS
      LDB B,I       GET THE DVT ADDRESS 
      STB TGDVT       AND SAVE IT 
      ADB =D13      ADD THIREEN TO GET THE DRIVER ADDRESS 
      JSB $LIBR     GO PRIVILEDGED
       NOP
      STA B,I       SET THE DRIVER ADDRESS
      ADB B6        POINT TO FIRST TIME BIT 
      LDA B,I       GET WORD 20 
      CCE 
      RAL,ERA       SET THE FIRST TIME BIT
      STA B,I 
      ADB B3        POINT TO DVTP AREA
      LDA TBLA      GET THE TABLE ADDRESS AGAIN 
      INA 
      JSB .MVW      MOVE THE DRIVER PARAMETERS
       DEF B10      EIGHT WORDS 
       NOP
      LDA A,I       GET THE SELECT CODE 
      STA SCR         AND SAVE
      CPA ENPRM     ARE THEY THE SAME?
      JMP NOIFT 
      LDB TGDVT     GET THE TARGET DVT
      ADB B4        POINT TO IFT ADDRESS
      LDB B,I       GET THE IFT ADDRESS 
      ADA $INTA     STORE IT IN 
      STB A,I         THE INTERRUPT TABLE 
      ADB B5        POINT TO SELECT CODE
      LDA B,I       GET THE ENTRY 
      AND =B177700  MASK OUT
      IOR SCR 
      STA B,I         AND SAVE THE NEW SELECT CODE
NOIFT JSB $LIBX     GO UN-PRIVILEDGED 
       DEF *+1
       DEF *+1
* 
* NOW THAT DISC IS SET UP, READ THE LAST TRACK FOR THE CRN LABEL
* 
      LDA TBLA      GET THE TABLE ADDRESS AGAIN 
      ADA B6        GET THE # OF TRACKS 
      LDA A,I       GET IT
      ADA =D-1      AND SUBTRACT OME
      STA LSTRK       AND SAVE
      LDA =D-3      THREE RETRIES 
      STA RETRY 
      LDA CDT       GET THE LU NEEDED 
      IOR =B27700   OR IN FUNCTION BITS 
      STA EXCLU     AND SAVE
RDDSC JSB EXEC
       DEF *+7
       DEF B1       READ
       DEF EXCLU    LU NUMBER 
       DEF NAMBF    BUFFER
       DEF B200 
       DEF LSTRK    LAST TRACK
       DEF B0         AND FIRST SECTOR
* 
      JSB RMPAR     GET THE RESULT OF THE CALL
       DEF *+2
       DEF SCR
      LDA SCR       GET THE ERROR CODE
      AND =B77       AND MASK IT OUT '
      SZA,RSS       ERROR?
      JMP NEXER     NO - CONTINUE]
      CPA =B77      RETRY?
      RSS 
      JMP MCDSK,I   NO MOUNT
      ISZ RETRY     INCREMENT RETRY COUNT 
      JMP RDDSC     TRY AGAIN 
      JMP MCDSK,I 
* 
* NOW THAT LAST TRACK HAS BEEN READ, VERIFY VALID DIRECTORY 
*  AND OBTAIN VALUES NEEDED FOR THE CARTRIDGE DIRECTORY 
* 
NEXER LDA NAMBF     GET FIRST WORD
      SSA,RSS       SIGN BIT SET? 
      JMP MCDSK,I   NO
      LDA NAMBF+3   GET CRN NUMBER
      SSA,RSS       POSITIVE
      SZA,RSS         AND NONE ZERO 
      JMP MCDSK,I   NO
      LDB NAMBF+8   DIRECTORY TRACKS
      SSB,RSS         MUST BE NEGATIVE
      JMP MCDSK,I   NO
      LDB NAMBF+7   GET THE LAST TRACK
      CMB,INB       MAKE NEGATIVE 
      ADB NAMBF+4     AND ADD TO FIRST TRACK
      SSB,RSS       RESULT MUST BE NEGATIVE 
      JMP MCDSK,I   NO
      LDB NAMBF+9   GET NEXT AVAIL. TRACK 
      SSB           MUST BE POSITIVE
      JMP MCDSK,I 
      CMB,INB       AND <= LOWEST DIRECTORY TRACK 
      ADB NAMBF+7 
      SSB 
      JMP MCDSK,I   NO
* 
      STA CDT+2 
      LDA LSTRK     GET THE LAST TRACK
      STA CDT+1        AND SAVE 
      CLA 
      STA CDT+3     LOCK FLAG 
      LDA CDTA      GET THE DUMMY TABLE ADDRESS 
      LDB $CDRA     GET THE CARTRIDGE DIRECTORY ADDRESS 
      ADB B4        POINT TO THE SECOND ENTRY 
      JSB $LIBR     GO PRIVILEDGED (AGAIN!!!!)
       NOP
      JSB .MVW      MOVE THE NEW ENTRY
       DEF B4       FOUR WORDS
       NOP
      JSB $LIBX 
       DEF *+1
       DEF *+1
      LDA CDT       GET THE LU
      CMA,INA         NEGATE IT 
      ISZ MCDSK     ALL DONE!!!!
      JMP MCDSK,I 
$CDRA DEF $CDIR 
TGDVT NOP 
RETRY NOP 
EXCLU NOP 
      SKP 
************************************************************
*                                                          *
* SRDSK SEARCHES FOR THE CORRECT LU TO MOUNT GIVEN THE     *
*    CORRECT CRN NUMBER                                    *
*                                                          *
************************************************************
SRDSK NOP 
      SZA,RSS       IS IT ZERO? 
      LDA CDLU+2    YES - LOAD FIRST CRN NUMBER 
      SZA,RSS       IS IT STILL ZERO!?!?
      JMP SRDSK,I   YES - MUST BE AN ERROR
      LDB =D-10     TEN ENTRIES MAX 
      STB #DSK        TO SERVE AS COUNTER 
      LDB CDLU      START OF TABLE ADDRESS
      SSA           IS IT NEGATIVE? 
      CMA,CCE,INA,RSS  YES MAKE POSITIVE AND SET E
      CLE,INB       INCREMENT TO POINT TO CRN 
SRLP1 CPA B,I       IS THIS THE ONE?
      JMP CRNFD     YES 
      ADB B2        NO ADD 2
      ISZ #DSK      AND INCREMENT 
      JMP SRLP1 
      JMP SRDSK,I   NO - NOT FOUND
* 
* 
CRNFD SEZ,RSS       DON'T SUBTRACT IF LU
      ADB =D-1      SUBTRACT ONE
      LDA B,I       GET THE DISC
      ISZ SRDSK     INCREMENT RETURN
      JMP SRDSK,I   AND GO
* 
* THIS ROUTINE DISMOUNTS THE SPECIFIED DISC 
* 
DCDSK NOP 
      STA .P2       -LU TO DISMOUNT 
      LDA =B7       DISMOUNT COMMANDD 
      STA .P1 
      CLA 
      STA .P3 
      STA .P7 
      JSB CLD.R     CALL D.RTR
      JMP DCDSK,I     AND RETRUN
      SKP 
* THIS ROUTINE WILL MOUNT THE BOOT DISC INTO THE SYSTEM 
* 
DFDSK NOP 
      LDA #DSC      GET THE NUMBER MOUNTED
      SZA           IS IT ZERO? 
      JMP DFDSK,I   NO - RETURN 
      CCA 
      STA DEFMT     INDICATE A DEFAULT MOUNT
      LDB LUTA      GET THE ADDRESS 
      STB LUPTR     SAVE IN THE LU COUNTER
      CLA,INA 
      STA LUCTR     START AT LU 1 
DC0   LDB LUPTR 
      JSB RDSYS     READ THE FIRST TABLE ENTRY
      ADA =D22        POINT TO DRIVER PARAMETER AREA
      STA B 
      LDA CDTA      GET THE ADDRESS OF THE BUFFER 
      STA DCPTR      AND SAVE 
      LDA =D-8      READ EIGHT WORDS
      STA DCCTR     SAVE
DC1   JSB RDSYS 
      STA DCPTR,I   SAVE IN TABLE 
      ISZ DCPTR     INCREMENT THE POINTER 
      ISZ DCCTR      AND THE COUNTER
      JMP DC1 
      LDA =B100     GET THE START OF THE TABLE
      LDB CDTA
      JSB .CMW      COMPARE THE TWO 
       DEF B10
       NOP
       JMP DKFND    DISC FOUND
       NOP
* 
* ITS NOT THIS ONE
* 
DKNFD LDB LUT#      GET THE NUMBER OF LU'S
      CMB,INB         MAKE POSITIVE 
      LDA =D-32     AND THE ERROR 
      CPB LUCTR     END OF TABLE??
      JMP BOTER     YES 
      ISZ LUPTR     BUMP THE LU POINTER 
      ISZ LUCTR       AND THE LU COUNTER
      JMP DC0       AND TRY AGAIN 
DKFND LDB LUPTR     GET THE TABLE POINTER AGAIN 
      JSB RDSYS 
      LDB A 
      ADB B4        GET THE IFT ADDRESS 
      JSB RDSYS     GET THE ADDRESS 
      ADA B5        GET THE SELECT CODE 
      STA B 
      JSB RDSYS     GET IT
      AND =B77      AND IT OUT
      CPA S.C       IS IT THE CORRECT ONE?? 
      RSS 
      JMP DKNFD     NO  - BAD DISC!!!!
      SKP 
* 
* SAY THE DISC IS MOUNTED 
* 
      JSB CNUMD     CONVERT TO DECIMAL
       DEF *+3
       DEF LUCTR
       DEF SYDK#
      JSB EXEC
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF SYDKM
       DEF SYDKL
      LDB LUCTR     GET THE COUNTER FOR THE LU
      JMP MC1         AND GO MOUNT IT!!!
LUPTR NOP 
LUCTR NOP 
DCCTR NOP 
DCPTR NOP 
SYDKM ASC 12,NO DISC MOUNTED. DISC LU 
SYDK# BSS 3 
      ASC 9, MOUNTED BY BOOTEX
SYDKL ABS *-SYDKM 
* 
************* 
* CONSTANTS * 
************* 
#DSK  NOP 
BFADR NOP 
DTACT NOP 
OFSTW NOP 
BLK   NOP 
OFST  NOP 
DVR33 DEF DD.33 
DD.33 EQU DD.30     TEMPORARY UNTIL DRIVER IS WRITTEN 
* 
* CHANGE DD.33 TO AN EXTERNAL WHEN DRIVER IS WRITTEN AND ADDED
* 
DVR30 DEF DD.30 
DSC#  NOP           RUNNING DISC COUNTER
TBLA  NOP           TEMP STORAGE
LSTRK NOP           LAST TRACK OF LU
      SKP 
* 
* SYSTEM ERROR ROUTINE
**
SYERR CMA,INA       MAKE POSITIVE 
      STA ERR4
      JSB CNUMD     CONVERT TO ASCII
       DEF *+3
       DEF ERR4 
       DEF SYSTG
      LDA MINUS 
      STA SYSTG 
      JSB CLOSE     CLOSE THE FILE
       DEF *+2
       DEF SYDCB
      JSB EXEC      WRITE THE STRING
       DEF *+5
       DEF B2 
       DEF TERM 
       DEF SYMSG
       DEF SYMSL
      LDA TY$FL     GET THE INTERACTIVE FLAG
      CLB 
      STB SYFL$       AND SAVE
      STB BLK       CLEAR THE BLOCK 
      SZA,RSS       ARE WE INTERACTIVE??
      JMP GETFL     YES - JUMP
HALT2 JSB $LIBR 
       NOP
      HLT 2 
      JMP *-1       MAKE SURE WE NEVER LEAVE
SYMSG ASC  5,FMP ERROR
SYSTG BSS 3 
      ASC  8, ON SYSTEM FILE
SYMSL ABS *-SYMSG 
CKERR JSB EXEC      WRITE ERROR MESSAGE 
       DEF *+5
       DEF B2       WRITE 
       DEF TERM 
       DEF CKERM
       DEF CKERL
      CLA           CLEAR 
      STA SYFL$     SYSTEM FLAG 
      STA SNFL$       AND SNAP FLAG 
      STA BLK         AND THE BLOCK FLAG
      LDA TY$FL     ARE WE INTERACTIVE? 
      SZA 
      JMP HALT2     NO - HALT THE MACHINE 
      JSB CLOSE     CLOSE 
       DEF *+2           SYSTEM 
       DEF SYDCB
      JSB CLOSE      AND SNAP DCB 
       DEF *+2
       DEF SNDCB
      JMP GETFL     TRY FOR TWO NEW FILES 
CKERM ASC 15,SYSTEM NOT FOR THIS SNAPSHOT 
CKERL ABS *-CKERM 
* 
ERR4  NOP 
UNER1 BSS 2 
UNRER NOP           DUMMY ROUTINE FOR RELINK
      JSB .ENTR 
       DEF UNER1
      JMP UNRER,I 
**********************************
*     DCB AND BUFFER AREA        *
**********************************
      SPC 2 
BCDCB BSS 144       BOOT CONTROL DCB
SNDCB BSS 144       SNAP DCB
SYDCB BSS 144       SYSTEM DCB
SYSBA DEF SYDCB+16  STARTING ADDRESS OF DATA BUFFER 
SYBUF EQU SYDCB+16  DATA BUFFER 
PRDCB BSS 144       PROGRAM BUFFER DCB
      SKP 
      UNS 
      END BTXL
                                                    