BDOS:
DO; /* (NORMALLY ORG'ED DIRECTLY AFTER BDOSI AT 3100H IN 16K CP/M) */

/*
               COPYRIGHT (C) 1976,1977,1978
               DIGITAL RESEARCH
               BOX 579, PACIFIC GROVE
               CALIFORNIA, 93950

           USER DEFINED PARAMETERS ARE FOUND AT THE BEGINNING OF
           THE BDOS AREA (SEE THE BDOSI INTERFACE)
           AND CAN BE ALTERED TO FIT A RANGE OF DISK DRIVES
           STARTING WITH THE BASE OF THE BDOS AREA:
           0009 - 000AH PERERR = .PERM ERROR SUBROUTINE
           000B - 000CH SELERR = .SELECT ERROR SUBROUTINE
           000D - 000EH RODERR = .READ ONLY DISK ERROR SUBR

           001A - 0019H TRSECT = SECTOR TRANSLATE SUBROUTINE
           001A - 0039H TRAN   = STANDARD SECTOR TRANSLATE TABLE
           (ACCESS TO TRAN IS ONLY THROUGH TRSECT)
           003AH         SECSIZ = NUMBER OF SECTORS PER TRACK (<=32)
           003BH         DIRMAX = LARGEST DIRECTORY ENTRY NUMBER (0..254)
           THE FOLLOWING VALUES ARE BASED UPON A BLOCK ALLOCATION
           SIZE OF BLKSIZ, WHICH IS USUALLY 1K FOR SINGLE DENSITY,
           2K FOR DOUBLE DENSITY, AND MUST BE COMPUTED IN SUCH A WAY 
           THAT THE MAXIMUM ALLOCATION VALUE IS LESS THAN OR EQUAL TO
           255 (A BYTE QUANTITY).
           003CH         BLKSHF = LOG2 OF BLOCK SIZE (BLKSIZ)
           003DH         BLKMSK = 2**BLKSHF-1
           003EH         MAXALL = MAXIMUM ALLOCATION NUMBER
           003FH         DIRBLK = BIT PATTERN WHICH RESERVES ONE BLOCK
                         FOR EACH DIRECTORY GROUP (4 ENTRIES PER GROUP),
                         BASED UPON BLKSIZ AND DIRMAX
           0040H         OSTRKS = NUMBER OF SYSTEM TRACKS

    AS AN EXAMPLE, GIVEN A STANDARD DISKETTE WITH 77 TRACKS USING 26 SECTORS
    PER TRACK, WITH TWO TRACKS DEDICATED TO THE OPERATING SYSTEM:

           SECSIZ = 26 (SECTORS PER TRACK)
           DIRMAX = 63 (=64 DIRECTORY ENTRIES, FOR EXAMPLE)

    GIVEN TWO SYSTEM TRACKS, WE HAVE A USABLE STORAGE AREA OF

           77-2 TRACKS TIMES 26 SECTORS PER TRACK = 75*26 = 1950 SECTORS

    GIVEN 512 BYTES PER ALLOCATION, WE GET

           1950*128/512 = 487.5 ALLOCATION BLOCKS

    WHICH IS TOO LARGE TO FIT A BYTE VARIABLE.  THUS, USING AN
    ALLOCATION OF 1024 BYTES,

           1950*128/1024 = 243.75 ALLOCATION BLOCKS

    WHICH IS WITHIN THE BYTE VALUE 0-255.  THE BLOCKS ARE NUMBERED FROM
    ZERO THROUGH 242 (THE LAST 3/4 OF AN ALLOCATION BLOCK IS LOST), AND
    THUS THE VALUE

           MAXALL = 242 (MAXIMUM ALLOCATION NUMBER)

    FURTHER, THE VALUE OF BLKSIZ (WHICH IS ONLY USED IN THE FOLLOWING
    COMPUTATIONS) IS ASSUMED TO BE 1024.  AS A RESULT,

           BLKSHF = LOG2 (1024/128) = LOG2 8 = 3 (I.E., 2**3=8), AND
           BLKMSK = 2**BLKSHF-1 = 2**3-1 = 8-1 = 7

    FURTHER, WE ARE USING DIRSIZ = 64 DIRECTORY ENTRIES, AND THUS THE
    DATA AREA CONSUMED BY THE DIRECTORY IS 64/4 = 16 SECTORS
    WHICH USES A TOTAL OF 2 OF THE BASIC BLOCKS (OF 1024 BYTES EACH)
    AND THUS THE AREA RESERVED FOR THE DIRECTORY IS

           DIRBLK = 11000000B = 0C0H = 192 (DECIMAL)

    (I.E., THE FIRST TWO BLOCKS CANNOT BE ALLOCATED TO DATA AREAS)

*/
DECLARE
    TRAN(32) BYTE EXTERNAL,
    SECSIZ   BYTE EXTERNAL,
    DIRMAX   BYTE EXTERNAL,
    BLKSHF   BYTE EXTERNAL,
    BLKMSK   BYTE EXTERNAL,
    MAXALL   BYTE EXTERNAL,
    DIRBLK   BYTE EXTERNAL,
    OSTRKS   BYTE EXTERNAL,
    CURDSK   BYTE EXTERNAL;  /* CURRENT DISK (EXTERN FOR ERRS) */

/*

           THE FIRST PAGE OF ROM IS ASSIGNED AS FOLLOWS:
           0000H JMP WBOOT
           0003H IOBYTE   (USED IN BDOS, PIP, AND STAT)
           0004H CDISK    (CURRENT DISK NUMBER, USED IN CCP, ED)
           0005H JMP BDOS (PRIMARY BDOS ENTRY POINT)
           0038H JMP DDT  (RESTART FILLED BY DDT)
           005CH - 007CH  DEFAULT FILE CONTROL BLOCK
           0080H - 00FFH DEFAULT BUFFER AREA
           0100H - CCP    TRANSIENT PROGRAM AREA
     */
DECLARE
    JBOOT LITERALLY '0000H',
    JDDT  LITERALLY '0038H',
    IOLOC LITERALLY '0003H',
    CDLOC LITERALLY '0004H',
    JBDOS LITERALLY '0005H',
    BDOSA LITERALLY '0006H', /* ADDRESS FIELD OF JMP INSTRUCTION */
    TFCB  LITERALLY '005CH',
    TBUFF LITERALLY '0080H';


 
 
 /* THE FOLLOWING SUBROUTINES ARE ASSUMED TO EXIST EXTERNALLY,
    STARTING AT THE ADDRESS 'BASE' (NORMALLY 3E00H IN 16K CP/M), AND
    ARE ACCESSED THROUGH THE BDOS INTERFACE PROGRAM.

 
    00 BASE:     BOOT       SYSTEM REBOOT OPERATION
    01 BASE+3    WBOOT      SYSTEM REBOOT - WARM START
    02 BASE+6    CONSTAT    CONSOLE STATUS - RETURNS
                             0 IN REG-A IF NO CONSOLE DATA READY
                            FF IF CHARACTER IS READY
    03 BASE+9    CONIN      CONSOLE CHARACTER INTO ACCUMULATOR - 0 PARITY
    04 BASE+12   CONOUT     CONSOLE CHARACTER SENT FROM REGISTER C
    05 BASE+15   LIST       SEND CHARACTER FROM REGISTER C TO LIST DEVICE
    06 BASE+18   PUNCH      SEND CHARACTER FROM REGISTER C TO PUNCH DEVICE
    07 BASE+21   READER     READ CHARACTER TO REGISTER A WITH 0 PARITY
    08 BASE+24   HOME       MOVE DISK HEAD TO TRACK 0
    09 BASE+27   SELDSK     SELECT DISK DRIVE GIVEN BY REGISTER C (0,1,..)
    10 BASE+30   SETTRK     SET TRACK (0-76) GIVEN BY REGISTER C
    11 BASE+33   SETSEC     SET SECTOR NUMBER GIVEN BY REG C (1-26)
    12 BASE+36   SETDMA     SET DMA ADDRESS GIVEN BY REG PAIR B,C (INITIALLY
                                 DEFAULTED TO 80H)
    13 BASE+39   READ       READ DISK SECTOR (SETTRK, SETSEC, SELDSK ASSUMED)
                                  A PERMANENT ERROR IS ASSUMED IF THE
                                  LEAST SIGNIFICANT BIT IS NOT ZERO
                                  UPON RETURN FROM THE BIOS.
    14 BASE+42   WRITE      WRITE DISK SECTOR (SETTRK..SELDSK ASSUMED)
                             ERROR RETURNS IN REGISTER A AS ABOVE
    */
 
    /* FUNC IS THE DISK MONITOR FUNCTION NUMBER AS SHOWN BELOW:
        0:   SYSTEM RESET
        1:   READ CONSOLE DEVICE
        2:   WRITE CONSOLE DEVICE
        3:   READ READER DEVICE
        4:   WRITE PUNCH DEVICE
        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 (NOT USED IN CURRENT SYSTEMS)
       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
       25:   RETURN CURRENTLY SELECTED DISK NUMBER
       26:   SET SUBSEQUENT DMA ADDRESS
       27:   RETURN BASE ADDRESS OF ALLOCATION VECTOR
       28:   WRITE PROTECT CURRENTLY SELECTED DISK
       29:   RETURN R/O DISK BIT VECTOR
       30:   SET DMA ADDRESS FOR DIRECTORY OPERATIONS
    */
    
     
DECLARE
      EQU LITERALLY 'LITERALLY',
      FOREVER EQU 'WHILE TRUE',
      TRUE EQU '1',
      FALSE EQU '0',
      /* TRUNCATE EXTERNAL NAMES FOR ASSEMBLER INTERFACE */
      CONCHAR EQU 'CONCHA',
      SELDISK EQU 'SELDIS',
      READ$DISK EQU 'READDI',
      CONECHO EQU 'CONECH',
      PERM$ERROR$SUB EQU 'PERERR',
      SEL$ERROR$SUB EQU 'SELERR',
      RO$ERROR$SUB EQU 'RODERR',
      WRITE$DISK EQU 'WRITED';

 /* EXTERNALLY DEFINED LABELS AND VARIABLES */
DECLARE
    PERM$ERROR$SUB ADDRESS EXTERNAL,
    SEL$ERROR$SUB ADDRESS EXTERNAL,
    RO$ERROR$SUB ADDRESS EXTERNAL,
    MEMSIZE ADDRESS AT(BDOSA),    /* ADDRESS FIELD OF JUMP AT 5 */
    FUNC    BYTE  EXTERNAL,       /* MONITOR FUNCTION NUMBER */
    INFO  ADDRESS EXTERNAL,       /* DATA TO ACT UPON */
    ARET  ADDRESS EXTERNAL,       /* RETURN VALUE */
    RET   BYTE,                   /* SET TO LOW(ARET) */
    LINFO BYTE;                   /* SET TO LOW(INFO) */

BOOT: PROCEDURE EXTERNAL;
    /* WARM START */
    END BOOT;

CONECHO: PROCEDURE BYTE EXTERNAL;
    /* READ CHARACTER, ECHO GRAPHICS */
    END CONECHO;

CONBRK: PROCEDURE BYTE EXTERNAL;
    END CONBRK;
 
LSTOUT: PROCEDURE(CHAR) EXTERNAL;
    DECLARE CHAR BYTE;
    END LSTOUT;
 
PUNOUT: PROCEDURE(CHAR) EXTERNAL;
    DECLARE CHAR BYTE;
    END PUNOUT;
 
READIN: PROCEDURE BYTE EXTERNAL;
    END READIN;
 
TRACK0: PROCEDURE EXTERNAL;
    END TRACK0;
 
SELDISK: PROCEDURE(DISK) EXTERNAL;
    DECLARE DISK BYTE;
    END SELDISK;
 
SELTRK: PROCEDURE(TRACK) EXTERNAL ;
    DECLARE TRACK BYTE;
     END SELTRK;
 
SELSEC: PROCEDURE(SECTOR) EXTERNAL ;
    DECLARE SECTOR BYTE;
    END SELSEC;
 
SELDMA: PROCEDURE(DMA) EXTERNAL ;
    DECLARE DMA ADDRESS;
    END SELDMA;
 
READ$DISK: PROCEDURE BYTE EXTERNAL;
    END READ$DISK;
 
WRITE$DISK: PROCEDURE BYTE EXTERNAL;
    END WRITE$DISK;

TRSECT: PROCEDURE(SECTOR) EXTERNAL;
    DECLARE SECTOR BYTE;
    /* TRANSLATE AND SET SECTOR NUMBER */
    END TRSECT;

 
 /* CONSOLE COMMUNICATION PROCEDURES */
 
DECLARE
    /* SPECIAL CHARACTERS */
    CTLC EQU '03H',
    TAB EQU '09H',
    LF  EQU '0AH',
    CR  EQU '0DH';
 
DECLARE
    IOSTAT BYTE AT(IOLOC) ;   /* IO STATUS BYTE */
 
TABOUT: PROCEDURE(CHAR) EXTERNAL;
    DECLARE CHAR BYTE;
    END TABOUT;
 
CRLF: PROCEDURE EXTERNAL;
    END CRLF;
 
PRINT: PROCEDURE(A) EXTERNAL;
    DECLARE A ADDRESS;
    /* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE NEXT
    OCCURRENCE OF A DOLLAR SIGN */
    END PRINT;
 
READ: PROCEDURE EXTERNAL;
    /* 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) */
    /*  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 */
   END READ;
 
 
   DECLARE MAXDSK EQU '3',  /* MAX DISK NUMBER 0,1,... */
       NDISK EQU '4';      /* NUMBER OF DISKS = MAXDSK+1 */
 
   DECLARE (DPTR,DCNT,DREC) BYTE,
       /* DIRECTORY OPERATIONS AND DATA TRANSFERS TAKE PLACE
       AT TBUFF (NORMALLY 80H) UNLESS CHANGED BY SYSTEM CALLS */
       BUFFA ADDRESS INITIAL(TBUFF),
       DMAAD ADDRESS INITIAL(TBUFF),
       BUFF BASED BUFFA (128) BYTE,
       DIRSET BYTE INITIAL(FALSE), /* TRUE IF DIR DMA SET */
       GETBUFF EQU 'BUFF';  /* CAN REPLACE BY FUNCTION */
 
   DECLARE DMX EQU 'DIRMAX',
           /* DMX IS THE LAST DIRECTORY ENTRY NUMBER
           (LISTED AS 0, 1, ... , DMX) */
       CHKSIZ EQU '16',  /* SIZE OF CHECKSUM VECTORS */
       CHKSHF EQU '4',  /* LOG2 CHKSIZ */
       OFFSET EQU 'OSTRKS',  /* NUMBER OF TRACKS USED BY BOOT */
 
       AL1 EQU 'DIRBLK', /* 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 */
       ALLOC2 (32) BYTE,  /* ALLOCATION VECTOR FOR DISK 2 */
       ALLOC3 (32) BYTE,  /* ALLOCATION VECTOR FOR DISK 3 */
       ALLOCA ADDRESS,    /* POINTER TO CURRENTLY REFERENCED ALLOC */
       ALLOC BASED ALLOCA (32) BYTE;  /* ALLOC VECTOR TEMPLATE */
 
DECLARE
      RODSK BYTE INITIAL(0),/* READ ONLY DISK BIT VECTOR */
      CHECK0 (CHKSIZ) BYTE, /* CHECK SUM VECTOR 0 */
      CHECK1 (CHKSIZ) BYTE, /* CHECK SUM VECTOR 1 */
      CHECK2 (CHKSIZ) BYTE, /* CHECK SUM VECTOR 2 */
      CHECK3 (CHKSIZ) BYTE, /* CHECK SUM VECTOR 3 */
      CHECKA ADDRESS,       /* POINTER TO CURRENT VECTOR */
      CHECK BASED CHECKA (CHKSIZ) BYTE; /* CHECK SUM TEMPLATE */

 
   DECLARE
       EMP EQU '0E5H',
       MAL EQU 'MAXALL', /* LARGEST BLOCK NUMBER */
       MRC  EQU '127', /* LARGEST RECORD NUMBER */
       DSF EQU '2',   /* AMOUNT TO SHIFT 128 BYTE RECORD
                             TO GET A SINGLE DISK ENTRY */
       DMK EQU '11B', /* MASK CORRESPONDING TO DSF */
       FLN EQU '32',
       FSL EQU '5', /* AMOUNT TO SHIFT TO MULTIPLY
                             BY THE FCB LENGTH (FLN) */
       FDM EQU '16',  /* BEGINNING OF DISK MAP */
       FRL EQU '32',   /* LOCATION OF REC TO R/W */
       FRC EQU '15',  /* LOCATION OF RECORD COUNT
                            (MUST BE ONE BELOW DISK MAP) */
       FRE EQU '12', /* POSITION OF REEL NUMBER */
       LFB EQU '31',
       FNM EQU '13'; /* LENGTH OF FILE NAME */
 
       DECLARE S BASED INFO (33) BYTE, /* FILE CONTROL BLOCK
           PASSED TO THE DISK MONITOR FROM THE USER */
               SZ BASED INFO BYTE;   /* SZ = S(0) */
 
 
       /* 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
       OLDDSK BYTE,             /* DISK ON ENTRY TO DOS */
       FCBDSK BYTE,             /* DISK NAMED IN FCB */
       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,  /* CURRENT TRACK 0-76 */
       RCOUNT BYTE,     /* RECORD COUNT IN CURRENTLY
                           ADDRESSED FCB */
       VRECORD BYTE,   /* CURRENT VIRTUAL RECORD */
       ARECORD ADDRESS;  /* CURRENT ACTUAL RECORD */
 
 


HOME: PROCEDURE;
    /* MOVE TO HOME POSITION, THEN OFFSET BY DOS TRACKS */
    CALL TRACK0;   /* AT HOME POSITION */
    CALL SELTRK(OFFSET);  /* SELECT FIRST DIRECTORY POSITION */
    CURREC, CURTRK = 0;
    END HOME;
 
SEEK: PROCEDURE;
    /* SEEK THE TRACK GIVEN BY ARECORD (ACTUAL RECORD) */
    DECLARE T ADDRESS;
 
        DO WHILE ARECORD < CURREC;
        CURREC = CURREC - SECSIZ;
        CURTRK = CURTRK - 1;
        END;
        DO WHILE ARECORD >= (T := CURREC + SECSIZ);
        CURREC = T;
        CURTRK = CURTRK + 1;
        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 */
    CALL SELTRK(CURTRK+OFFSET);
    CALL TRSECT(ARECORD - CURREC);
    END SEEK;
 
WAITIO: PROCEDURE(READING);
    DECLARE READING BYTE;  /* TRUE IF READING, FALSE IF WRITING */
    DECLARE COND BYTE;     /* CONDITION UPON RETURN */
    IF READING THEN COND = READ$DISK; ELSE
                    COND = WRITE$DISK;
    IF COND = 0 THEN RETURN;  /* DISK I/O SUCCESSFUL */
 
    /* ARRIVE HERE AFTER TOO MANY READ WRITE FAILURES */
    CALL PERM$ERROR$SUB;
    END WAITIO;
 
RDBUFF: PROCEDURE;
    /* START AN I/O AND WAIT FOR IO FINISH */
    CALL WAITIO(TRUE);
    END RDBUFF;
 
WRBUFF: PROCEDURE;
    /* WRITE THE BUFFER, SELECT NON-DELETED DATA */
    CALL WAITIO(FALSE);
    END WRBUFF;
 
 
INDEX: PROCEDURE;
    /* COMPUTE DISK BLOCK NUMBER FROM CURRENT
        FCB ADDRESSED BY INFO */
    ARECORD =  S(FDM+SHR(VRECORD,BLKSHF));
    END INDEX;
 
ATRAN: PROCEDURE;
    /* COMPUTE ACTUAL TRACK ADDRESS (ASSUMES A
       PREVIOUS CALL TO INDEX */
    ARECORD = SHL(ARECORD,BLKSHF) OR (VRECORD AND BLKMSK);
    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;
 
SEEK$DIR: PROCEDURE;
    /* SEEK THE RECORD CONTAINING THE CURRENT DIRECTORY ENTRY */
    ARECORD = DOUBLE(DREC := SHR(DCNT,DSF));
    CALL SEEK;
    END SEEK$DIR;
 
COMPUTE$CS: PROCEDURE BYTE;
    /* COMPUTE CHECKSUM FOR CURRENT DIRECTORY BUFFER */
    DECLARE (I,CS) BYTE;
    CS = 0;
        DO I = 0 TO LAST(BUFF);
        CS = CS + GETBUFF(I);
        END;
    RETURN CS;
    END COMPUTE$CS;

SET$CDISK: PROCEDURE(MASK) BYTE;
    /* SET A '1' VALUE IN CURDSK POSITION OF MASK */
    DECLARE MASK BYTE;
    RETURN MASK OR ROR(ROL(1,CURDSK+1),1);
    END SET$CDISK;

NOWRITE: PROCEDURE BYTE;
    /* RETURN TRUE IF DIR CHECKSUM DIFFERENCE */
    RETURN ROL(ROR(RODSK,CURDSK+1),1);
    END NOWRITE;

SET$RO: PROCEDURE;
    /* SET CURRENT DISK TO READ ONLY */
    RODSK = SET$CDISK(RODSK);
    END SET$RO;

CHECK$WRITE: PROCEDURE;
    /* CHECK FOR WRITE PROTECTED DISK */
    IF NOWRITE THEN
        CALL RO$ERROR$SUB;
    END CHECK$WRITE;

CHECKSUM: PROCEDURE(INIT);
    DECLARE INIT BYTE;
    /* COMPUTE CURRENT CHECKSUM RECORD AND
    UPDATE THE DIRECTORY ELEMENT IF INIT, OR CHECK
    FOR EQUALITY IF NOT */
    IF DREC >= CHKSIZ THEN RETURN; /* SKIP IF BEYOND CHECKED AREA */
    IF INIT THEN /* SET CHECKSUM VALUE */
        CHECK(DREC) = COMPUTE$CS; ELSE
    IF CHECK(DREC) <> COMPUTE$CS THEN /* CHECKSUM ERROR */
        CALL SET$RO; /* DISK SET TO READ ONLY */
    END CHECKSUM;

WRDIR: PROCEDURE;
    /* WRITE THE CURRENT DIRECTORY ENTRY, SET CHECKSUM */
    CALL CHECKSUM(TRUE); /* INITIALIZE ENTRY */
    CALL WRBUFF; /* WRITE THE BUFFER */
    END WRDIR;

READ$DIR: PROCEDURE(INIT);
    DECLARE INIT BYTE; /* TRUE IF INITIALIZING SYSTEM */
    /* 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; CALL SEEK$DIR;
        CALL RDBUFF;
        CALL CHECKSUM(INIT); /* CHECKSUM OPERATION */
        END;
    END READ$DIR;
 
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;
    ALLOC(SHR(I,3)) =
        ROR((GET$ALLOC$BIT(I) AND 0FEH) OR B, (I AND 111B) + 1);
    END SET$ALLOC$BIT;
 
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 */
    RET = FALSE; /* SET TO TRUE IF $ FILE EXISTS */
 
    RODSK = 0; /* NO READ ONLY DISKS AT THIS POINT */
    ALLOC(0) = AL1;
        DO I=1 TO LAST(ALLOC); ALLOC(I)=0;
        END;
    CALL HOME;
    DCNT = 255;
        DO FOREVER;
        CALL READ$DIR(TRUE);
        IF DCNT = 255 THEN RETURN;
        IF GETBUFF(DPTR) <> EMP THEN
            DO; /* CHECK FOR $ FILE (IN CASE OF SUBMIT) */
            RET = RET OR GETBUFF(DPTR+1) = '$';
            /* SET ALLOC BIT TO 1 FOR EACH NON-ZERO DM ENTRY */
            CALL SCANDM(1);
            END;
        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(FALSE);
        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;
    CALL CHECK$WRITE; /* WRITE PROTECTED? */
    /* 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);
        BUFF(DPTR) = EMP;
        /* ARECORD HAS BEEN PREVIOUSLY SOUGHT BY READDIR */
        CALL WRDIR; /* WRITE DIRECTORY ENTRY */
        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;
        BUFF(L+DPTR) = S(B+L);
        END;
    CALL SEEK$DIR;
    CALL WRDIR; /* WRITE DIR ENTRY */
    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 */
 
    CALL CHECK$WRITE; /* IN CASE WRITE PROTECTED */
    /* SEARCH UP TO THE REEL NUMBER FIELD */
    CALL SEARCH(FRE); S(FDM) = SZ;
    /* ASSUME SAME DISK DRIVE FOR NEW NAMED FILE */
        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 */
    RET = 0;
    IF NOWRITE THEN RETURN; /* SKIP CLOSE IF WRITE PROTECTED */
    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;
 
    CALL CHECK$WRITE; /* MAY BE WRITE PROTECTED */
    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;
 
SETDMA: PROCEDURE;
    /* SELECT DATA DMA ADDRESS */
    IF DIRSET THEN CALL SELDMA(DMAAD);
    END SETDMA;

RESETDMA: PROCEDURE;
    /* RESELECT ORIGINAL DMA ADDRESS */
    IF DIRSET THEN CALL SELDMA(BUFFA);
    END RESETDMA;

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 = 1; ELSE
            DO;  CALL ATRAN;
            /* ARECORD IS NOW ACTUAL DISK ADDRESS */
            CALL SEEK;
            /* NOW READ THE BUFFER */
            CALL SETDMA; /* SELECTS DATA DMA ADDRESS */
            CALL RDBUFF;
            CALL RESETDMA; /* SELECTS DIR DMA ADDRESS */
            CALL SETFCB;
            END;
        END;
    END DISKREAD;
 
DISKWRITE: PROCEDURE;
    DECLARE (I,L) BYTE;
    CALL CHECK$WRITE; /* IN CASE WRITE PROTECTED */
    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 SETDMA;
            CALL WRBUFF;
            CALL RESETDMA;
            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 EXTENT */
                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 */
        CALL SEL$ERROR$SUB;
    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)) */
    CHECKA = .CHECK0(SHL(CURDSK,CHKSHF));
    CURTRKA = .CURTRKV(CURDSK);
    CURRECA = .CURRECV(CURDSK);
 
    /* SET CONTROLLER */
    CALL SELDISK(CURDSK);
 
    /* CHECK TO INSURE THAT DISK IS LOGGED IN */
    IF NOT ROR(ROL(DLOG,1),CURDSK+1) THEN
        DO;
        DLOG = SET$CDISK(DLOG);
        CALL INITIALIZE;
        END;
    END SELECT;
 
CURSELECT: PROCEDURE;
    IF LINFO <> CURDSK THEN
        DO; CURDSK = LINFO; CALL SELECT;
        END;
    END CURSELECT;
 
RESELECT: PROCEDURE;
    /* CHECK CURRENT FCB TO SEE IF RESELECTION NECESSARY */
    IF (LINFO := (SZ AND 1$1111B) -1) < 30 THEN
        DO; OLDDSK = CURDSK; FCBDSK = SZ; SZ = SZ AND 1110$0000B;
        CALL CURSELECT;
        END;
    END RESELECT;
 
SELBUFFA: PROCEDURE;
    /* SELECT DMA BUFFER ADDRESS */
    CALL SELDMA(BUFFA := INFO);
    END SELBUFFA;

DSKMON: PROCEDURE PUBLIC;
  LINFO = LOW(INFO);
  ARET, RET, FCBDSK = 0;
 
    DO CASE FUNC;
    /* 0: SYSTEM RE-BOOT */
        CALL BOOT;
    /* 1: READ CONSOLE */
        RET = CONECHO;
    /* 2: WRITE CONSOLE */
        CALL TABOUT(LINFO);
    /* 3: READ READER DEVICE */
        RET = READIN;
    /* 4: WRITE PUNCH DEVICE */
        CALL PUNOUT(LINFO);
    /* 5: WRITE LIST DEVICE */
        CALL LSTOUT(LINFO);
    /* 6: INTERROGATE MEMORY SIZE */
        ARET = MEMSIZE;
    /* 7: INTERROGATE DEVICE STATUS */
        ARET = IOSTAT;
    /* 8: CHANGE DEVICE STATUS */
        IOSTAT = LINFO;
    /* 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,DIRSET = 0;
        INFO = TBUFF; CALL SELBUFFA;
        CALL SELECT;
        END;
    /* 14: SELECT DISK 'INFO' */
        CALL CURSELECT;
    /* 15: OPEN */
        DO; CALL RESELECT;
        CALL OPEN;
        END;
    /* 16: CLOSE */
        DO; CALL RESELECT;
        CALL CLOSE;
        END;
    /* 17: SEARCH FOR FIRST OCCURRENCE OF A FILE */
        DO; CALL RESELECT;
        CALL SEARCH(FNM);
        END;
    /* 18: SEARCH FOR NEXT OCCURRENCE OF A FILE NAME */
        DO; INFO = SEARCHA; CALL RESELECT;
        CALL SEARCHN;
        END;
    /* 19: DELETE A FILE */
        DO; CALL RESELECT;
        CALL DELETE;
        END;
    /* 20: READ A FILE */
        DO; CALL RESELECT;
        CALL DISKREAD;
        END;
    /* 21: WRITE A FILE */
        DO; CALL RESELECT;
        CALL DISKWRITE;
        END;
    /* 22: CREATE A FILE */
        DO; CALL RESELECT;
        CALL MAKE;
        END;
    /* 23: RENAME A FILE */
        DO; CALL RESELECT;
        CALL RENAME;
        END;
    /* 24: RETURN THE LOGIN VECTOR */
        RET = DLOG;
    /* 25: RETURN SELECTED DISK NUMBER */
        RET = CURDSK;
    /* 26: SET THE SUBSEQUENT DMA ADDRESS TO INFO */
        DO;
        IF DIRSET THEN DMAAD = INFO; ELSE
        CALL SELBUFFA;
        END;
    /* 27: RETURN THE LOGIN VECTOR ADDRESS  */
        ARET = ALLOCA;
    /* 28: WRITE PROTECT CURRENT DISK */
        CALL SET$RO;
    /* 29: RETURN R/O BIT VECTOR */
        RET = RODSK;
    /* 30: SET DIRECTORY DMA */
        DO; DIRSET = TRUE; /* MARK AS SEPARATE DIR AREA */
        CALL SELBUFFA;
        END;
    END; /* OF CASES */
  GOBACK:
    IF FCBDSK <> 0 THEN  /* RESTORE DISK NUMBER */
        DO; SZ = FCBDSK; LINFO = OLDDSK; CALL CURSELECT;
        END;
