BDOS.PLM

$Q=1
$RIGHTMARGIN=80
/* FDOS LLL V.3  11/21/75
   CON DEVICE 3 IS TI SILENT 700.
   OCT IS READER DEVICE 3 OR 4. */
3200H: DECLARE BOOT LITERALLY '0H';


 /* C P / M   B A S I C   I / O    S Y S T E M    (B I O S)

                    COPYRIGHT (C) GARY A. KILDALL
                             JUNE, 1975

                                                          */

DECLARE CONSOLE LITERALLY '00$00$10$00B'; /* READER IS OCT CHANNEL A. */
DECLARE ECHO BYTE INITIAL (0FFH); /* ECHO CALL NO. 1.  SEE CALL 30 */


DISKMON: PROCEDURE(FUNC,INFO) ADDRESS;
    DECLARE FUNC BYTE,
        LINFO BYTE,       /* LOW ORDER INFO */
       INFO ADDRESS,
       ARET ADDRESS, RET BYTE;

    /* FUNC IS THE DISK MONITOR FUNCTION NUMBER AS SHOWN BELOW:
        0:   SYSTEM RESET
        1:   READ CONSOLE DEVICE
        2:   WRITE CONSOLE DEVICE
        3:   READ OCTOPUS
        4:   WRITE OCTOPUS
        5:   WRITE LIST DEVICE
        6:   INTERROGATE MEMORY SIZE
        7:   INTERROGATE DEVICE STATUS
        8:   CHANGE DEVICE STATUS
        9:   PRINT BUFFER ON CONSOLE
       10:   READ BUFFER FROM CONSOLE
       11:   CONSOLE CHARACTER READY
       12:   LIFT HEAD (NO OPERATION ON CPM 16D2JUN75)
       13:   RESET DISK SYSTEM - SELECT DISK 0
       14:   SELECT DISK 'INFO'
       15:   OPEN FILE
       16:   CLOSE FILE
       17:   SEARCH FOR FIRST OCCURRENCE
       18:   SEARCH FOR NEXT OCCURRENCE
       19:   DELETE A FILE
       20:   READ A FILE
       21:   WRITE A FILE
       22:   CREATE A FILE
       23:   RENAME A FILE
       24:   RETURN LOGIN VECTOR - EACH BIT CORRESPONDS TO
             A DISK NUMBER, FROM LSB TO MSB.  1 INDICATES
             THE DISK IS LOGGED IN.
       25:   RETURN CURRENTLY SELECTED DISK NUMBER
       26:   SET SUBSEQUENT DMA ADDRESS
       27:   RETURN BASE ADDRESS OF ALLOCATION VECTOR
             (USED TO DETERMINE REMAINING SPACE)
       28:   UNUSED
       29:   UNUSED
       30:   CONTROL ECHO FOR CALL 1
    */

 /* CONSOLE COMMUNICATION PROCEDURES */

DECLARE
    /* TELETYPE DECLARATIONS */
    TTI LITERALLY '0',
    TTO LITERALLY '0',
    TTS LITERALLY '1',
    TTC LITERALLY '1',
    /* CRT DECLARATIONS (NOTE CONFLICT WITH OCTOPUS)*/
    CTI LITERALLY '4',
    CTO LITERALLY '4',
    CTS LITERALLY '5',
    /* OCTOPUS DECLARATIONS */
    /* (CHECK WITH TORODE FOR CHANNEL B ASSIGNMENTS) */
    OAI LITERALLY '4',
    OAO LITERALLY '4',
    OAS LITERALLY '5',
    OBI LITERALLY '6',
    OBO LITERALLY '6',
    OBS LITERALLY '7',

    /* SPECIAL CHARACTERS */
    ALT LITERALLY '7DH',
    ESC LITERALLY '1BH',
    TAB LITERALLY '09H',
    BEL LITERALLY '07H',
    LF  LITERALLY '10',
    CR  LITERALLY '13';

DECLARE COLUMN BYTE INITIAL(0); /* CURRENT CONSOLE COLUMN */
DECLARE OCT$TIMEOUT LITERALLY '65000';


DECLARE IOSTAT BYTE INITIAL(CONSOLE);
    /* IOSTAT DEFINES THE CURRENT DEVICE ASSIGNMENT
    0-1 CONSOLE
        0 TTY
        1 CRT
        2 BATCH (USE READER DEFINITION)
        3 USER (1) TI SILENT 700
    2-3 READER
        0 TTY
        1 PTR
        2 USER (1)OCTOPUS CHANNEL A
        3 USER (2)OCTOPUS CHANNEL B
    4-5 PUNCH
        0 TTY
        1 PTP
        2 USER (1)
        3 USER (2)
    6-7 LIST
        0 TTY
        1 CRT
        2 USER (1)
        3 USER (2)
    */

CONSTAT: PROCEDURE BYTE;
    RETURN IOSTAT AND 11B;
    END CONSTAT;

CONBRK: PROCEDURE BYTE;
    /* LOOK FOR CHARACTER AT CONSOLE PORT */
    DECLARE I BYTE;
    IF (I:=CONSTAT) = 0 OR I = 3 THEN RETURN NOT INPUT(TTS);
    RETURN NOT INPUT(CTS);
    END CONBRK;

TTYOUT: PROCEDURE(CHAR);
    DECLARE CHAR BYTE;
        DO WHILE ROR(INPUT(TTS),2);
        END;
    OUTPUT(TTO) = NOT CHAR;
    END TTYOUT;

CRTOUT: PROCEDURE(CHAR);
    DECLARE CHAR BYTE;
        DO WHILE ROR(INPUT(CTS),2);
        END;
    OUTPUT(CTO) = NOT CHAR;
    END CRTOUT;

TTYIN: PROCEDURE BYTE;
        DO WHILE INPUT(TTS);
        END;
    RETURN NOT INPUT(TTI) AND 07FH;
    END TTYIN;

CRTIN: PROCEDURE BYTE;
        DO WHILE INPUT(CTS);
        END;
    RETURN NOT INPUT(CTI) AND 07FH;
    END CRTIN;

OCTS: PROCEDURE BYTE;
    /* RETURN OCTOPUS STATUS */
    IF ROR(IOSTAT,2) THEN RETURN INPUT(OBS);
    RETURN INPUT(OAS);
    END OCTS;

OCTO: PROCEDURE(CHAR);
    /* SEND TO SELECTED OCTOPUS CHANNEL */
    DECLARE CHAR BYTE;
    IF ROR(IOSTAT,2) THEN
        OUTPUT(OBO) = CHAR;
    ELSE
        OUTPUT(OAO) = CHAR;
    END OCTO;

OCTI: PROCEDURE BYTE;
    /* GET DATA FROM SELECTED OCTOPUS CHANNEL */
    IF ROR(IOSTAT,2) THEN RETURN INPUT(OBI);
    RETURN INPUT(OAI);
    END OCTI;

OCTIN: PROCEDURE BYTE;
    /* RETURN STATUS OR DATA */
    DECLARE I ADDRESS;
    IF LINFO = 1 THEN RETURN NOT OCTS;
    IF LINFO = 2 THEN RETURN NOT ROR(OCTS,2);
    DO I = 0 TO OCT$TIMEOUT;
        IF NOT OCTS THEN RETURN NOT OCTI;
        END;
    RETURN(0FFH);
    END OCTIN;

OCTOUT: PROCEDURE(CHAR);
    /* OCTOPUS OUTPUT */
    DECLARE CHAR BYTE;
    DO WHILE ROR(OCTS,2); END;
    CALL OCTO(NOT CHAR);
    END OCTOUT;

CONIN: PROCEDURE BYTE;
    /* READ THE CONSOLE DEVICE */
    DECLARE I BYTE;
    IF (I:=CONSTAT) = 0 OR I = 3 THEN RETURN TTYIN;
    IF I = 1 THEN RETURN CRTIN;
    IF I = 2 THEN RETURN OCTIN;
    RETURN 0;
    END CONIN;


LISTOUT: PROCEDURE(CHAR);
    DECLARE (I,CHAR) BYTE;
    IF (I:=ROL(IOSTAT,2) AND 11B) = 0 THEN
        CALL TTYOUT(CHAR); ELSE
    IF I = 1 THEN CALL CRTOUT(CHAR);
    END LISTOUT;

CONOUT: PROCEDURE(CHAR);
    /* OUTPUT TO CONSOLE DEVICE */
    DECLARE (I,CHAR) BYTE;
    DO CASE CONSTAT;
    CALL TTYOUT(CHAR);
    CALL CRTOUT(CHAR);
    CALL LISTOUT(CHAR);
    DO;
        CALL TTYOUT(CHAR);
        IF CHAR = CR THEN
            DO;
            CALL TTYOUT(0); CALL TTYOUT(0); CALL TTYOUT(0); CALL TTYOUT(0);
            END;
        END;
    END;
    END CONOUT;

CONOUTA: PROCEDURE(CHAR);
    DECLARE CHAR BYTE;
    IF ECHO THEN CALL CONOUT(CHAR);
    END CONOUTA;

CRLF: PROCEDURE;
    CALL CONOUT(CR);
    CALL CONOUT(LF);
    END CRLF;

PRINT: PROCEDURE(A);
    DECLARE A ADDRESS, (I, M BASED A) BYTE;
    /* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE NEXT
    OCCURRENCE OF A DOLLAR SIGN */
        DO WHILE (I:=M) <> '$'; CALL CONOUT(I);
        A = A + 1;
        END;
    END PRINT;

READ: PROCEDURE;
    /* READ CHARACTERS FROM THE CONSOLE DEVICE
    INTO THE MEMORY LOCATION GIVEN BY 'INFO',
    UNTIL THE FIRST CARRIAGE RETURN
    IS ENCOUNTERED.  ALLOW BACKSPACE (RUBOUT),
    LINE ELIMINATE (CTL U), AND SYSTEM RE-BOOT
    (CTL C) */
    DECLARE
        SLASH LITERALLY '5CH',
        CTLC  LITERALLY '03H',
        CTLU  LITERALLY '15H',
        CTL   LITERALLY '5EH',
        CTLE  LITERALLY '05H',
        CTLZ  LITERALLY '1AH',
        CTLL  LITERALLY '0CH';

    /*  THE INFO POINTER IS ASSUMED TO ADDRESS AN
    AREA OF MEMORY CONTAINING TWO BYTE QUANTITIES.
    THE FIRST GIVES THE MAXIMUM BUFFER LENGTH, AND
    THE SECOND IS SET TO THE NUMBER OF CHARACTERS
    SCANNED UPON RETURN */

    DECLARE MAXL BASED INFO BYTE,  /* MAX LENGTH */
        COMLEN BYTE,               /* SCANNED LENGTH */
        BUFFER BASED INFO BYTE,    /* BUFFER */
        C BYTE;

    CTLOUT: PROCEDURE;
        /* PRINT UP-ARROW IN FRONT OF LAST CHARACTER READ */
        CALL CONOUT(CTL); CALL CONOUT(C OR 40H);
        END CTLOUT;

    COMLEN = 0;
        DO WHILE COMLEN < MAXL;
        IF (C := CONIN) = CTLC THEN
            DO; CALL CTLOUT; CALL CRLF;
            GO TO BOOT;
            END;
        IF C = CTLE THEN /* PHYSICAL RETURN */
            CALL CRLF; ELSE
        IF C = CR THEN
            DO; BUFFER(1) = COMLEN;
            CALL CONOUT(CR);
            RETURN;
            END;
        IF C = CTLU THEN
            DO; CALL CTLOUT; CALL CRLF; COMLEN=0;
            END; ELSE
        IF C = 7FH THEN /* RUBOUT */
            DO;
            IF COMLEN > 0 THEN
                CALL CONOUT(BUFFER((COMLEN:=COMLEN-1)+2));
            END; ELSE
            DO;
            IF (C AND 01100000B) = 0 THEN /* CONTROL CHARACTER */
                CALL CTLOUT; ELSE
            CALL CONOUT(C);
            BUFFER ((COMLEN:=COMLEN+1)+1) = C;
            END;
        END;
    END READ;

 /*  E N D    B A S I C   I / O   S Y S T E M  */



 /*  B A S I C   D I S K    O P E R A T I N G   S Y S T E M  (B D O S)

                    COPYRIGHT (C) GARY A. KILDALL
                            JUNE, 1975

                                                                 */

DECLARE MAXDSK LITERALLY '1',  /* MAX DISK NUMBER 0,1,... */
    NDISK LITERALLY '2';      /* NUMBER OF DISKS = MAXDSK+1 */

DECLARE (DPTR,DCNT) BYTE,
    TRACKA  ADDRESS INITIAL (7DH),
    SECTORA ADDRESS INITIAL (7EH),
    DATAA  ADDRESS  INITIAL (7FH),

    TRACKV  BASED TRACKA BYTE,
    SECTORV BASED SECTORA BYTE,
    DATAV   BASED DATAA BYTE,
    TRACK BYTE,
    SECTOR BYTE,
    BUFFA ADDRESS INITIAL(80H),
    BUFF    BASED BUFFA (128) BYTE;

DECLARE DMX LITERALLY '63',
        /* DMX IS THE LAST DIRECTORY ENTRY NUMBER
        (LISTED AS 0, 1, ... , DMX) */

    OFFSET LITERALLY '2',  /* NUMBER OF TRACKS USED BY BOOT */

    AL1 LITERALLY '0C0H', /* FIRST ALLOCATION
        VECTOR ELEMENT.  EACH BIT THAT IS '1'  RESERVES
        A 1 K BLOCK FOR THE DIRECTORY.  EACH BLOCK IS
        8 RECORDS BY 128 BYTES PER RECORD  (NOTE THAT
        RESERVATIONS START ON THE LEFT OF THE WORD */

    ALLOC0 (32) BYTE,  /* ALLOCATION VECTOR FOR DISK 0 */
    ALLOC1 (32) BYTE,  /* ALLOCATION VECTOR FOR DISK 1 */
    ALLOCA ADDRESS,    /* POINTER TO CURRENTLY REFERENCED ALLOC */
    ALLOC BASED ALLOCA (32) BYTE;  /* ALLOC VECTOR TEMPLATE */


DECLARE
    EMP LITERALLY '0E5H',

    MRD LITERALLY '10',  /* NUMBER OF READ RE-TRYS */

    FOREVER LITERALLY 'WHILE TRUE',
    TRUE LITERALLY '1',
    FALSE LITERALLY '0',
    MAL LITERALLY '242', /* LARGEST BLOCK NUMBER */
    MRC  LITERALLY '127', /* LARGEST RECORD NUMBER */
    DSF LITERALLY '2',   /* AMOUNT TO SHIFT 128 BYTE RECORD
                          TO GET A SINGLE DISK ENTRY */
    DMK LITERALLY '11B', /* MASK CORRESPONDING TO DSF */
    FLN LITERALLY '32',
    FSL LITERALLY '5', /* AMOUNT TO SHIFT TO MULTIPLY
                          BY THE FCB LENGTH (FLN) */
    FDM LITERALLY '16',  /* BEGINNING OF DISK MAP */
    FRL LITERALLY '32',   /* LOCATION OF REC TO R/W */
    FRC LITERALLY '15',  /* LOCATION OF RECORD COUNT
                         (MUST BE ONE BELOW DISK MAP) */
    FRE LITERALLY '12', /* POSITION OF REEL NUMBER */
    LFB LITERALLY '31',
    FNM LITERALLY '13'; /* LENGTH OF FILE NAME */

    DECLARE S BASED INFO (32) BYTE; /* FILE CONTROL BLOCK
        PASSED TO THE DISK MONITOR FROM THE USER */


    /* THE FILE CONTROL BLOCK FORMAT IS SHOWN BELOW:

       ----------------------------------------------------------
       /  1 BY  /  8 BY  /  3 BY  /  1 BY  /2BY/1 BY/  16 BY    /
       /FILETYPE/  NAME  /  EXT   / REEL NO/XXX/RCNT/DM0 .. DM15/
       ----------------------------------------------------------

        FILETYPE :  0E5H IF AVAILABLE (OTHERWISE UNDEFINED NOW)
        NAME     :  8 CHARACTER PRIMARY NAME
        EXT      :  3 CHARACTER EXTENT
                        COM IMPLIES COMMAND TYPE
                        (OTHERWISE UNDEFINED NOW)
        REEL NO  :  'REEL NUMBER' FIRST REEL IS 0, SECOND IS 1,
                     AND SO FORTH UNTIL 255.
        XXX      :  UNUSED FOR NOW
        RCNT     :  RECORD COUNT IN FILE (0 TO 127)
        DM0 ...  :  DISK ALLOCATION MAP.  255 IF NOT ALLOCATED,
           DM15     OTHERWISE IT POINTS TO ALLOCATED DISK BLOCK

        THE FILE CONTROL BLOCK IS FOLLOWED BY ONE BYTE OF
        INFORMATION WHICH GIVES THE NEXT RECORD TO BE READ
        OR WRITTEN IN AN OPENED FILE.  THIS INFORMATION
        IS NOT A PART OF THE DIRECTORY.  EACH READ OR WRITE
        WILL INCREMENT THIS RECORD COUNT.

        */


DECLARE
    DOU  LITERALLY 'OUTPUT(127)', /* DISK OUTPUT PORT  */
    DIN  LITERALLY 'INPUT(127)',  /* DISK INPUT PORT */
    DMAH LITERALLY 'OUTPUT(126)', /* HIGH ORDER DMA ADDR */
    DMAL LITERALLY 'OUTPUT(125)',  /* LOW ORDER DMA */
    CURDSK BYTE INITIAL(0),  /* CURRENTLY ADDRESSED DISK */
    DLOG   BYTE INITIAL(0),   /* BIT VECTOR GIVING LOGGED-IN DISKS */
    CURTRKV(NDISK) BYTE,      /* TRACK VECTOR */
    CURRECV(NDISK) ADDRESS,   /* RECORD VECTOR */
    CURTRKA ADDRESS,          /* POINTS TO CURRENT TRACK NUMBER */
    CURRECA ADDRESS,          /* POINTS TO CURRENT RECORD NUMBER */
    CURREC BASED CURRECA ADDRESS, /* CURRENTLY ADDRESSED RECORD */
    CURTRK BASED CURTRKA BYTE,     /* CURRENTLY ADDRESSED TRACK (0-76)*/
    RCOUNT BYTE,     /* RECORD COUNT IN CURRENTLY
                        ADDRESSED FCB */
    VRECORD BYTE,   /* CURRENT VIRTUAL RECORD */
    ARECORD ADDRESS;  /* CURRENT ACTUAL RECORD */

    /*
        COMMUMICATION BETWEEN THE DISK I/O PROGRAM AND THE DISK CON-
    TROLLER IS THROUGH THE PORTS DESIGNATED

            DIN              DOU
          (INPUT)            (OUTPUT)

    THE BITS OF EACH PORT ARE NUMBERED 0 THROUGH 7 (LSB THROUGH MSB)
    AND ARE LISTED BELOW ALONG WITH THEIR FUNCTIONS

        DIN:
        0    FIF    FILE INOPERATIVE FLAG
        1    SRF    STEP READY FLAG
        2    TZF    TRACK ZERO FLAG
        3    IOF    I/O FINISH FLAG (DEFINED ONLY AFTER RDS OR WRS,
                    AND APPLY TO LAST SUCH OPERATION)
        4    TER    TRACK ERROR OR SECTOR > 26
        5    ICE    ID CRC ERROR
        6    DCE    DATA CRC ERROR
        7    HUL    HEAD UNLOADED

        DOU:
        0    FIR    FILE INOPERATIVE RESET
        1    STT    STEP TRACK STROBE
        2    DIR    DIRECTION (IN IF TRUE, ELSE OUT - TO ZERO)
        3    SDK    SELECT DISK
        4    D0     DISK NUMBER (0 TO 3)
        5    D1     DISK NUMBER (CON'T)
        6    RDS    READ SEGMENT
        7    WRS    WRITE SEGMENT

    ALL DISK TRANSFERS ARE BASED UPON A 131 BYTE AREA AT ADDRESS
    7DH IN MEMORY.  THE FORMAT IS

        (TRACK) (SECTOR) (DEL DATA) (D0) (D1) ... (D127)
          7DH     7EH       7FH      80H  81H ...  80H+7FH

        THE BASED VARIABLES TRACKV, SECTORV, AND DATAV ARE
        SET TO THE FIRST THREE LOCATIONS, WHILE THE
        BASED VECTOR BUFF ADDRESSES THE DATA AREA.

    NOTE THAT TRUE CONDITIONS ARE DEFINED AS 1'S IN THE 8080
    ACCUMULATOR */

DECLARE
    FIF LITERALLY 'DIN',
    SRF LITERALLY 'ROR(DIN,1)',
    TZF LITERALLY 'ROR(DIN,2)',
    IOF LITERALLY 'ROR(DIN,3)',
    TER LITERALLY 'ROR(DIN,4)',
    ICE LITERALLY 'ROL(DIN,3)',
    DCE LITERALLY 'ROL(DIN,2)',
    HUL LITERALLY 'ROL(DIN,1)';

DECLARE
    ZER LITERALLY '0',
    UP  LITERALLY '1H',
    DWN LITERALLY '0FFH',

    FIR LITERALLY '1H',
    STT LITERALLY '2H',
    DIR LITERALLY '4H',
    SDK LITERALLY '8H',
    RDS LITERALLY '40H',
    WRS LITERALLY '80H';


PDISK: PROCEDURE;
    CALL PRINT(.'DISK $');
    CALL CONOUT('A'+CURDSK);
    END PDISK;

DISKRDY: PROCEDURE;
    CALL CRLF; CALL PRINT(.'READY $');
    CALL PDISK;
        DO WHILE FIF;
        DOU = FIR;
        END;
    CALL CRLF;
    END DISKRDY;

CHKRDY: PROCEDURE;
    /* CHECK FOR DISK READY */
    IF FIF THEN /* FILE IS INOPERATIVE */
        CALL DISKRDY;
    END CHKRDY;

MOVETRK: PROCEDURE(N);
    DECLARE N BYTE;
    /* N=0FFH IF TOWARD ZERO, N = 1 IF TOWARD 76 */
        DO WHILE NOT SRF;
        CALL CHKRDY;
        END;
    CURTRK = CURTRK + N;
    DOU = (N := (NOT N) AND DIR);
    DOU = N OR STT;
    DOU = N;
    DOU = ZER;
    /* STEPPED */
    END MOVETRK;

HOME: PROCEDURE;
    /* FIND THE HOME POSITION */
        DO WHILE NOT TZF;
        /* STEP DOWN */
        CALL MOVETRK(DWN);
        END;
    /* OFFSET BY TWO TRACKS */
    CALL MOVETRK(UP);
    CALL MOVETRK(UP);
    CURREC, CURTRK = 0;
    END HOME;

RESET: PROCEDURE;
    /* RESET THE DISK SYSTEM */

    /* WE ASSUME THE PROPER DISK IS SELECTED */
    /* STROBE THE FILE INOP RESET LINE */
    CALL CHKRDY;
    /* GO TO THE HOME POSITION */
    CALL HOME;
    END RESET;

SEEK: PROCEDURE;
    /* SEEK THE TRACK GIVEN BY ARECORD (ACTUAL RECORD) */
    DECLARE TRAN DATA /* SECTOR NUMBER TRANSLATE TABLE */
    (01H,07H,0DH,13H,  19H,05H,0BH,11H,  17H,03H,09H,0FH,
     15H,02H,08H,0EH,  14H,1AH,06H,0CH,  12H,18H,04H,0AH,
     10H,16H);

    DECLARE T ADDRESS;

        DO WHILE ARECORD < CURREC;
        CURREC = CURREC - 26;
        CALL MOVETRK(DWN);
        END;
        DO WHILE ARECORD >= (T := CURREC + 26);
        CURREC = T;
        CALL MOVETRK(UP);
        END;

    /* WE ARE NOW POSITIONED OVER THE TRACK CONTAINING THE ACTUAL
    RECORD.   THE SECTOR TO BE READ IS ARECORD - CURREC + 1.  THE
    TRACK NUMBER IS CURTRK */
    TRACK = CURTRK + OFFSET;
    SECTOR = TRAN(ARECORD - CURREC);
    END SEEK;

WAITIO: PROCEDURE(RW);
    DECLARE (S, I) BYTE,
        RW BYTE,  /* READ OR WRITE SIGNAL */
        (TR, SE, DA) BYTE;  /* TEMP TRACK, SECTOR, DATA */

    RESTORE: PROCEDURE;
        /* RESTORE T,S,D */
        TRACKV = TR; SECTORV = SE; DATAV = DA;
        END RESTORE;


    /* SAVE CONTROLLER COMMUNICATION AREA AHEAD OF BUFFER, AND
    SET CONTROLLER PARAMETERS FOR THE READ OR WRITE OPERATION */
    TR = TRACKV; SE = SECTORV; DA = DATAV;
    TRACKV = TRACK;
    SECTORV = SECTOR;
        DO I = 1 TO MRD;
        /* SELECT NON DELETED DATA */
        DATAV = 0FBH;
        /* SEND DMA ADDRESS */
        DMAH = HIGH(TRACKA); DMAL = LOW(TRACKA);
        /* START I/O */
        DOU = RW;
        /* WAIT FOR HUL, DCE, ICE, TER, IOF, OR FIF */
            DO WHILE (DIN AND 0F9H) = 0;
            END;

        IF DIN THEN CALL DISKRDY; ELSE
        IF (S := ROL(DIN,4) AND 0FH) = 0 THEN  /* I/O FINISH */
            DO;
            CALL RESTORE; /* RESTORE TRACK/SECTOR/DATA */
            RETURN;
            END; ELSE
        IF S THEN /* TRACK ERROR */
            DO; CALL HOME; CALL SEEK;
            END; /* OTHERWISE MUST BE HUL, OR CRC ERROR */
        END;

    /* ARRIVE HERE AFTER 'MRD' READ/WRITE FAILURES */
    CALL CRLF; CALL PRINT(.'PERM ERR $');
    CALL PDISK; IF CONIN THEN ;
    CALL RESTORE;
    CALL CRLF;
    END WAITIO;

RDBUFF: PROCEDURE;
    /* START AN I/O AND WAIT FOR IO FINISH */
    CALL WAITIO(RDS);
    END RDBUFF;

WRBUFF: PROCEDURE;
    /* WRITE THE BUFFER, SELECT NON-DELETED DATA */
    CALL WAITIO(WRS);
    END WRBUFF;


INDEX: PROCEDURE;
    /* COMPUTE DISK BLOCK NUMBER FROM CURRENT
        FCB ADDRESSED BY INFO */

    ARECORD = S(FDM+SHR(VRECORD,3));
    END INDEX;

ATRAN: PROCEDURE;
    /* COMPUTE ACTUAL TRACK ADDRESS (ASSUMES A
       PREVIOUS CALL TO INDEX */
    ARECORD = SHL(ARECORD,3) OR (VRECORD AND 111B);
    END ATRAN;

GETFCB: PROCEDURE;
    /* SET VARIABLES FROM CURRENTLY ADDRESSED FCB */

    VRECORD = S(FRL);
    RCOUNT  = S(FRC);
    END GETFCB;

SETFCB: PROCEDURE;
    /* PLACE VALUES BACK INTO CURRENTLY ADDRESSED
    FCB, AND INCREMENT THE RECORD COUNT */

    S(FRL) = VRECORD + 1;
    S(FRC) = RCOUNT;
    END SETFCB;

READ$DIR: PROCEDURE;
    /* READ NEXT DIRECTORY ENTRY (SET DCNT=255 INITIALLY)*/
    IF (DCNT:=DCNT+1) > DMX THEN
        DO; DCNT = 255; RETURN;
        END;
    IF (DPTR:=SHL(DCNT AND DMK,FSL)) = 0 THEN
        DO; ARECORD = SHR(DCNT,DSF);
        CALL SEEK;
        CALL RDBUFF;
        END;
    END READ$DIR;

GET$ALLOC: PROCEDURE(I) BYTE;
    DECLARE I BYTE;
    RETURN ALLOC(I);
    END GET$ALLOC;

PUT$ALLOC: PROCEDURE(I,X);
    DECLARE (I,X) BYTE;
    ALLOC(I) = X;
    END PUT$ALLOC;


GET$ALLOC$BIT: PROCEDURE(I) BYTE;
    /* RETURN THE I-TH BIT OF ALLOC */
    DECLARE I BYTE;
    RETURN ROL(ALLOC(SHR(I,3)), (I AND 111B)+1);
    END GET$ALLOC$BIT;

SET$ALLOC$BIT: PROCEDURE(I,B);
    /* SET THE I-TH BIT OF ALLOC TO THE LSB OF B */
    DECLARE (I,B) BYTE;
    CALL PUT$ALLOC(SHR(I,3),
        ROR((GET$ALLOC$BIT(I) AND 0FEH) OR B, (I AND 111B) + 1));
    END SET$ALLOC$BIT;


GETBUFF: PROCEDURE(I) BYTE;
    DECLARE I BYTE;
    RETURN BUFF(I);
    END GETBUFF;

PUTBUFF: PROCEDURE(I,X);
    DECLARE (I,X) BYTE;
    BUFF(I) = X;
    END PUTBUFF;

SCANDM: PROCEDURE(BIT);
    DECLARE (BIT, I, K) BYTE;
    /* SCANDM SCANS THE DISK MAP ADDRESSED BY DPTR FOR NON-ZERO ENTRIES
    -- THE ALLOCATION VECTOR ENTRY CORRESPONDING TO A NON-ZERO ENTRY
    IS SET TO THE VALUE OF 'BIT' */
        DO I = DPTR+FDM TO DPTR+LFB;
        IF (K := GETBUFF(I)) <> 0 THEN
            CALL SET$ALLOC$BIT(K,BIT);
        END;
    END SCANDM;

INITIALIZE: PROCEDURE;
    DECLARE I BYTE;
    /* INITIALIZE THE DISK SYSTEM */

    ALLOC = AL1;
        DO I=1 TO 31; CALL PUT$ALLOC(I,0);
        END;
    CALL RESET;
    DCNT = 255;
        DO FOREVER;
        CALL READ$DIR;
        IF DCNT = 255 THEN RETURN;
        IF GETBUFF(DPTR) <> EMP THEN
        /* SET ALLOC BIT TO 1 FOR EACH NON-ZERO DM ENTRY */
        CALL SCANDM(1);
        END;
    END INITIALIZE;


DECLARE SEARCHL BYTE,     /* SEARCH LENGTH SET BY SEARCH */
    SEARCHA ADDRESS;      /* SEARCH ADDRESS SET BY SEARCH */

SEARCHN: PROCEDURE;
    /* SEARCH FOR THE NEXT DIRECTORY ELEMENT, ASSUMING A PREVIOUS
    CALL ON SEARCH WHICH SETS SEARCHA AND SEARCHL */
    DECLARE (I,C) BYTE;
    INFO = SEARCHA;
        DO FOREVER;
        CALL READ$DIR;
        IF (RET := DCNT) = 255 THEN RETURN;
        I = 0;
            DO WHILE (I < SEARCHL) AND
            /* MATCH OR QUESTION MARK */
            ((C := S(I)) = GETBUFF(DPTR+I) OR C = 63);
            I = I + 1;
            END;
        IF I = SEARCHL THEN RETURN;
        END;
    END SEARCHN;

SEARCH: PROCEDURE(XL);
    DECLARE XL BYTE;
    SEARCHL = XL;
    SEARCHA = INFO;
    DCNT = 255;
    CALL HOME;
    /* NOW READY TO READ THE DISK */
    CALL SEARCHN;
    END SEARCH;

DELETE: PROCEDURE;
    DECLARE (I,J,K) BYTE;
    /* SEARCH ONLY UP THROUGH THREE CHARACTER EXTENT */
    CALL SEARCH(FRE);
      DO FOREVER;
      IF DCNT = 255 THEN /* NO MORE ENTRIES MATCH */ RETURN;
        /* SET EACH NON-ZERO DISK MAP ENTRY TO 0 IN ALLOC VECTOR */
        CALL SCANDM(0);
        CALL PUTBUFF(DPTR,EMP);
        /* ARECORD HAS BEEN PREVIOUSLY SOUGHT BY READDIR */
        CALL WRBUFF;
      CALL SEARCHN;
      END;
    END DELETE;

GET$BLOCK: PROCEDURE(L) BYTE;
    /* FIND A BLOCK WHICH IS AVAILABLE ON THE DISK AND IS CLOSEST
    TO THE BLOCK 'L'.  RETURN A 0 IF NO BLOCK IS AVAILABLE */
    DECLARE (L, R) BYTE;
        R = L;
        DO WHILE (R < MAL) OR (L > 0);
        L = L - (1 AND L > 0);
        R = R + (1 AND R < MAL);
        IF NOT GET$ALLOC$BIT(R) THEN RETURN R;
        IF NOT GET$ALLOC$BIT(L) THEN RETURN L;
        END;
    RETURN 0;
    END GET$BLOCK;

COPY$DIR: PROCEDURE(B,L);
    DECLARE (B,L) BYTE;
    /* COPY FCB INFORMATION STARTING AT BYTE B FOR L BYTES INTO
    BEGINNING OF CURRENTLY ADDRESSED DIRECTORY ENTRY */
        DO WHILE (L:=L-1) <> 255;
        CALL PUTBUFF(L+DPTR,S(B+L));
        END;
    ARECORD = SHR(DCNT,DSF);
    CALL SEEK;
    CALL WRBUFF;
    END COPY$DIR;

COPY$FCB: PROCEDURE;
    /* COPY THE ENTIRE FILE CONTROL BLOCK */
    CALL COPY$DIR(0,FRL);
    END COPY$FCB;

RENAME: PROCEDURE;
    /* RENAME THE FILE DESCRIBED BY THE FIRST HALF OF THE CURRENTLY
    ADDRESSED FILE CONTROL BLOCK.  THE NEW NAME IS CONTAINED IN THE
    LAST HALF OF THE CURRENTLY ADDRESSED FILE CONTROL BLOCK.  THE
    FILE TYPE, FILE NAME, AND FILE EXT ARE CHANGED, BUT THE REEL
    NUMBER FIELD IS IGNORED */

    /* SEARCH UP TO THE REEL NUMBER FIELD */
    CALL SEARCH(FRE);
        DO WHILE DCNT <> 255; CALL COPY$DIR(FDM,FRE);
        CALL SEARCHN;
        END;
    END RENAME;

OPEN: PROCEDURE;
    DECLARE I BYTE;
    /* SEARCH FOR DIRECTORY ENTRY, COPY TO FCB */
    CALL SEARCH(FNM);
    IF DCNT <> 255 THEN
        DO I=FNM TO LFB;
        S(I) = GETBUFF(DPTR+I);
        END;
    END OPEN;

CLOSE: PROCEDURE;
    /* LOCATE THE DIRECTORY ELEMENT AND RE-WRITE */
    CALL SEARCH(FNM);
    IF DCNT <> 255 THEN
        CALL COPY$FCB;
    END CLOSE;

MAKE: PROCEDURE;
    /* CREATE A NEW FILE; FIRST CREATE ENTRY IN
    THE DIRECTORY.  FILE IS OPENED UPON RETURN */
    DECLARE I BYTE,
        FCB ADDRESS;

    FCB = INFO; INFO = .EMP;
    /* LOOK FOR AN EMPTY DIRECTORY ENTRY */
    CALL SEARCH(1);
    IF DCNT <> 255 THEN
        DO; /* SET ELEMENTS TO ZERO */
        INFO = FCB;
            DO I=FNM TO LFB;
            S(I) = 0;
            END;
        /* COPY INTO DIRECTORY ENTRY */
        CALL COPY$FCB;
        END;
    END MAKE;

OPEN$REEL: PROCEDURE(READING);
    DECLARE READING BYTE;
    /* CLOSE CURRENT REEL AND OPEN THE NEXT ONE, IF POSSIBLE
    READING IS TRUE IF WE ARE IN READ MODE */
    CALL CLOSE;
    /* RET REMAINS AT 255 IF WE CANNOT OPEN THE NEXT REEL */
    IF DCNT = 255 THEN RETURN;
    /* INCREMENT THE REEL NUMBER */
    S(FRE) = S(FRE) + 1;
    CALL SEARCH(FNM);
    IF DCNT = 255 THEN
        DO; IF READING THEN RETURN;
        CALL MAKE;
        END; ELSE
    CALL OPEN;
    IF DCNT = 255 THEN
        DO; RET = 1; /* END OF FILE IN DISK READ */
        RETURN;
        END;
    CALL GETFCB;
    RET = 0;
    END OPEN$REEL;

DISKREAD: PROCEDURE;
    CALL GETFCB;

    IF RCOUNT <= VRECORD THEN
        DO; RET = 1;
        IF VRECORD = 128 THEN CALL OPEN$REEL(TRUE);
        VRECORD = 0;
        IF RET <> 0 THEN RETURN;
        END;
        DO; CALL INDEX;

        /* ERROR 2 IF READING UNWRITTTEN DATA */
        IF LOW(ARECORD) = 0 THEN RET = 2; ELSE
            DO;  CALL ATRAN;
            /* ARECORD IS NOW ACTUAL DISK ADDRESS */
            CALL SEEK;
            /* NOW READ THE BUFFER */
            CALL RDBUFF;
            CALL SETFCB;
            END;
        END;
    END DISKREAD;

DISKWRITE: PROCEDURE;
    DECLARE (I,L) BYTE;
    CALL GETFCB;

    IF VRECORD > MRC THEN /* PAST EOF, NEXT REEL NOT OPENED */
        RET = 1; ELSE
        DO; CALL INDEX;
        IF LOW(ARECORD) = 0 THEN /* NOT ALLOCATED */
            DO; /* THE ARGUMENT TO GET$BLOCK IS THE STARTING POSITION
            FOR THE DISK SEARCH - THIS SHOULD BE THE LAST ALLOCATED
            BLOCK FOR THIS FILE, OR THE VALUE 0 IF NO SPACE HAS BEEN
            ALLOCATED TO THIS FILE */
            I = 0;
            IF (L := FDM + SHR(VRECORD,3)) > FDM THEN
            /* THERE IS A PREVIOUS BLOCK ALLOCATED */ I = S(L-1);
            IF (I := GET$BLOCK(I)) = 0 THEN /* NO MORE SPACE */
                RET = 2; ELSE
                DO; CALL SET$ALLOC$BIT(I,1);
                /* BLOCK IS ALLOCATED */
                ARECORD, S(L) = I;
                END;
            END;
        /* CONTINUE IF NO ERROR IN ALLOCATION */
        IF RET = 0 THEN
            DO; CALL ATRAN;
            CALL SEEK;
            CALL WRBUFF;
            IF RCOUNT <= VRECORD THEN RCOUNT = VRECORD+1;
            /* CHECK FOR END-OF-REEL, IF FOUND ATTEMPT TO OPEN
            NEXT REEL IN PREPARATION FOR THE NEXT WRITE  */
            IF VRECORD = MRC THEN
                DO;
                /* UPDATE CURRENT FCB BEFORE GOING TO THE NEXT REEL */
                CALL SETFCB; CALL OPENREEL(FALSE);
                /* VRECORD REMAINS AT MRC CAUSING END-OF-FILE
                IF NO MORE DIRECTORY SPACE IS AVAILABLE */
                IF RET = 0 THEN VRECORD = 255; /* GOES TO ZERO */
                RET = 0;
                END;
            CALL SETFCB;
            END;
        END;
    END DISKWRITE;

SELECT: PROCEDURE;
    /* SELECT DISK 'INFO' FOR SUBSEQUENT
    INPUT OR OUTPUT OPERATIONS */

    IF CURDSK > MAXDSK THEN /* SELECTION ERROR */
        DO; CALL CRLF; CALL PRINT(.'SELECT ERROR $');
        CALL PDISK; CALL CRLF; GO TO PERR;
        END;
    ALLOCA = .ALLOC0(SHL(CURDSK,5));
    /* NOTE THAT THIS ASSUMES THERE ARE NO MORE
    THAN 8 DISKS ON THE SYSTEM - OTHERWISE
    REPLACE BY .ALLOC0(SHL(DOUBLE(CURDSK),5)) */

    CURTRKA = .CURTRKV(CURDSK);
    CURRECA = .CURRECV(CURDSK);

    /* SET CONTROLLER */
    DOU = ROL(CURDSK,4) OR SDK;

    /* CHECK TO INSURE THAT DISK IS LOGGED IN */
    IF NOT ROR(ROL(DLOG,1),CURDSK+1) THEN
        DO;
        DLOG = DLOG OR ROR(ROL(1,CURDSK+1),1);
        CALL INITIALIZE;
        END;
    END SELECT;

SETDMA: PROCEDURE(A);
    DECLARE A ADDRESS;
    DATAA=(SECTORA:=(TRACKA:=(BUFFA:=A)-3)+1)+1;
    END SETDMA;

  /* ARRIVE HERE UPON ENTRY TO THE DISK MONITOR.
  SAVE THE STACKPOINTER, PERFORM THE DESIRED FUNCTION,
  RESTORE THE STACKPOINTER, AND RETURN TO THE CALLING
  PROGRAM. */
  DECLARE STACK (16) ADDRESS,
      OLDSP ADDRESS;

  OLDSP = STACKPTR;
  STACKPTR = .STACK(LENGTH(STACK));
  /* CALLING PROGRAM'S STACK TOP ADDRESS NOW SAVED */

  LINFO = LOW(INFO);
  ARET, RET = 0;

    DO CASE FUNC;
    /* 0: SYSTEM RE-BOOT */
    GO TO BOOT;
    /* 1: READ CONSOLE */
    DO; RET = CONIN; CALL CONOUTA(RET);
        END;
    /* 2: WRITE CONSOLE */
    CALL CONOUT(LINFO);
    /* 3: READ OCTOPUS (INFO=0), OR RETURN STATUS (INFO=1,2) */
    RET = OCTIN;
    /* 4: WRITE OCTOPUS */
    CALL OCTOUT(LINFO);
    /* 5: WRITE LIST DEVICE */
    CALL LISTOUT(LINFO);
    /* 6: INTERROGATE MEMORY SIZE */
    ARET = 2900H;
    /* 7: INTERROGATE DEVICE STATUS */
    ARET = IOSTAT;
    /* 8: CHANGE DEVICE STATUS */
    IOSTAT = INFO;
    /* 9: PRINT BUFFER AT THE CONSOLE  */
    CALL PRINT(INFO);
    /* 10: READ BUFFER FROM THE CONSOLE */
    CALL READ;
    /* 11: CHECK FOR CONSOLE INPUT READY */
    RET = CONBRK;
    /* 12: */
    ;
    /* 13: RESET DISK SYSTEM, INITIALIZE TO DISK 0 */
        DO; CURDSK,DLOG = 0;
        CALL SETDMA(80H);
        CALL SELECT;
        END;
    /* 14: SELECT DISK 'INFO' */
        DO; CURDSK = LINFO;
        CALL SELECT;
        END;
    /* 15: OPEN */
    CALL OPEN;
    /* 16: CLOSE */
    CALL CLOSE;
    /* 17: SEARCH FOR FIRST OCCURRENCE OF A FILE */
    CALL SEARCH(FNM);
    /* 18: SEARCH FOR NEXT OCCURRENCE OF A FILE NAME */
    CALL SEARCHN;
    /* 19: DELETE A FILE */
    CALL DELETE;
    /* 20: READ A FILE */
    CALL DISKREAD;
    /* 21: WRITE A FILE */
    CALL DISKWRITE;
    /* 22: CREATE A FILE */
    CALL MAKE;
    /* 23: RENAME A FILE */
    CALL RENAME;
    /* 24: RETURN THE LOGIN VECTOR */
    RET = DLOG;
    /* 25: RETURN SELECTED DISK NUMBER */
    RET = CURDSK;
    /* 26: SET THE SUBSEQUENT DMA ADDRESS TO INFO */
    CALL SETDMA(INFO);
    /* 27: RETURN THE LOGIN VECTOR ADDRESS  */
            ARET = ALLOCA;
    /* 28: UNUSED */
    ;
    /* 29: UNUSED */
    ;
    /* 30: ECHO CALL NO. 1 IF ARGUMENT IS TRUE */
    ECHO = LINFO;


    END; /* OF CASES */



  GOBACK:
  /* RESTORE THE USER'S STACK AREA */
  STACKPTR = OLDSP;

  /* RETURN A SINGLE OR DOUBLE BYTE VALUE */
  RETURN ARET OR RET;

  /* ENTER HERE ON EXCEPTION CONDITIONS */
  PERR:
      /* PERMANENT DISK ERROR */
      DATAV = DIN;
      /* STORES INPUT PORT FROM CONTROLLER INTO MEMORY */
      HALT;
      /* RE-BOOT AFTER INTERRUPT WITH NOP */
      GO TO BOOT;

  BREAK:
      /* USER DEPRESSED BREAK KEY */
      ARET = 0FFFFH; GO TO GOBACK;

  END DISKMON;
  /* <><><><><><><><><>  END OF DISK MONITOR <><><> */

;
EOF