seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-22 16:04:18 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity
Files
master
Digital-Research-Source-Code/CPM OPERATING SYSTEMS/CPM 1.X/CPM 1.0/CPM/BDOS.PLM
Sepp J Morris 31738079c4 Upload 
Digital Research
2020-11-06 18:50:37 +01:00

1103 lines
30 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

$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

Reference in New Issue View Git Blame Copy Permalink