DECLARE FDOS LITERALLY '3200H';
/* CP/M BDOS
   COPYRIGHT (C) 1976
   DIGITAL RESEARCH
   BOX 579, PACIFIC GROVE
   CALIFORNIA,	93950
   */
FDOS:	DECLARE BOOT LITERALLY 'WBOOT';


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


DECLARE BASE LITERALLY '3B00H';  /* DISK INTERFACE AND CONSOLE IO */
/* THE FOLLOWING SUBROUTINES ARE ASSUMED TO EXIST,
   STARTING AT THE ADDRESS 'BASE'
   
   BASE	BOOT		SYSTEM REBOOT OPERATION
   BASE+3	WBOOT		SYSTEM REBOOT - WARM START
   BASE+6	CONSTAT 	CONSOLE STATUS - RETURNS
   0 IN REG-A IF NO CONSOLE DATA READY
   FF IF CHARACTER IS READY
   BASE+9	CONIN		CONSOLE CHARACTER INTO ACCUMULATOR - 0 PARITY
   BASE+12	CONOUT		CONSOLE CHARACTER SENT FROM REGISTER C
   BASE+15	LIST		SEND CHARACTER FROM REGISTER C TO LIST DEVICE
   BASE+18	PUNCH		SEND CHARACTER FROM REGISTER C TO PUNCH DEVICE
   BASE+21	READER		READ CHARACTER TO REGISTER A WITH 0 PARITY
   BASE+24	HOME		MOVE DISK HEAD TO TRACK 0
   BASE+27	SELDSK		SELECT DISK DRIVE GIVEN BY REGISTER C (0, 1, ..)
   BASE+30	SETTRK		SET TRACK (0-76) GIVEN BY REGISTER C
   BASE+33	SETSEC		SET SECTOR NUMBER GIVEN BY REG C (1-26)
   BASE+36	SETDMA		SET DMA ADDRESS GIVEN BY REG PAIR B, C (INITIALLY
   DEFAULTED TO 86H)
   BASE+39	READ		READ DISK SECTOR (SETTRK, SETSEC, SELDSK ASSUMED)
   ERROR RETURNS IN REGISTER A IN THREE
   LEAST SIGNIFICANT BITS (2, 1, AND 0)
   BIT		ERROR
   0		HARDWARE MALFUNCTION
   1		DRIVE NOT READY
   2		COMMAND SEQUENCE ERROR
   BASE+42	WRITE		WRITE DISK SECTOR (SETTRK...SELDSK ASSUMED)
   ERROR RETURNS IN REGISTER A AS ABOVE
   
   CP/M ALSO PROVIDES A TEN BYTE AREA IMMEDIATELY AHEAD OF THE
   DISK AND CONSOLE INTERFACE FOR TEMPORARY STORAGE IN CASE THE
   INTERFACE IS IMPLEMENTED IN ROM
   */




DISKMON: PROCEDURE(FUNC,INFO)	ADDRESS;
	DECLARE COPYRIGHT DATA(
		'COPYRIGHT (C) 1976, DIGITAL RESEARCH');
	
	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:		REAL 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 (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)
	   */
	
	DECLARE
	EQU		LITERALLY 'LITERALLY',
	BOOTF	EQU '3E$00H',
	PROOT	EQU '3E$03H',
	CONSF	EQU '3E$06H',
	CONIF	EQU '3E$09H',
	CONOF	EQU '3E$0CH',
	LISTF	EQU '3E$0FH',
	PUNF	EQU '3E$12H',
	READF	EQU '3E$15H',
	HOMF	EQU '3E$19H',
	SELF	EQU '3E$1BH',
	TRKF	EQU '3E$1EH',
	SECF	EQU '3E$21H',
	DMAF	EQU '3E$24H',
	DRDF	EQU '3E$27H',
	DWRF	EQU '3E$2AH';
	
	DECLARE	TRUE LITERALLY '1',
		FALSE	LITERALLY '0';
	
	DECLARE		CHAR$RDY BYTE INITIAL(FALSE), /* TRUE IF CHAR READ */
		KB$CHAR		BYTE, /* VALUE OF CHARACTER WHEN CHAR$RDY IS TRUE */
		LISTCOPY	BYTE; /* TRUE IF COPYING TO LIST DEVICE */
	
	CONRDY: PROCEDURE	BYTE;
		/* RETURN TRUE IF CHAR READY AT CONSOLE */
		GO TO CONSF;
		END CONRDY;
	
	CONIN: PROCEDURE	BYTE;
		/* READ NEXT CONSOLE CHARACTER */
		IF CHAR$RDY THEN /* CHARACTER IS READY */
			DO; CHAR$RDY = FALSE; RETURN KB$CHAR;
			END;
		/* OTHERWISE READ THE CHARACTER */
		GO TO CONIF;
		END CONIN;
	
	CONBRK: PROCEDURE	BYTE;
		DECLARE	CTLC LITERALLY '03H';
		DECLARE	CTLS LITERALLY '13H';
		IF CHAR$RDY THEN RETURN TRUE; /* CHARACTER ALREADY READ */
		IF CONRDY THEN /* CHECK FOR TYPE TERMINATION FUNCTION */
			DO;
			IF (KB$CHAR:= CONIN) = CTLS THEN /* STOP TYPE */
				DO; IF CONIN = CTLC THEN GO TO SOOT;
				RETURN	FALSE;
				END;
			RETURN (CHAR$RDY:= TRUE);
			END;
		RETURN FALSE;
		END CONBRK;
	
	CONCHAR: PROCEDURE(CHAR);
		DECLARE	CHAR BYTE;
		GO TO CONCF;
		END CONCHAR;
	
	CONOUT: PROCEDURE(CHAR);
		DECLARE	CHAR BYTE;
		/* CHECK FOR BREAK CHARACTER */
		IF CONBRK THEN;
		/* SEND CONSOLE CHARACTER */
		CALL CONCHAR(CHAR);
		END CONOUT;
	
	LSTOUT: PROCEDURE(CHAR);
		DECLARE	CHAR BYTE;
		GO TO LISTF;
		END LSTOUT;
	
	^PUNOUT: PROCEDURE(CHAR);
		DECLARE	CHAR BYTE;
		GO TO PUNF;
		END PUNOUT;
	
	READIN: PROCEDURE	BYTE;
		GO TO READF;
		END READIN;
	
	TRACK0: PROCEDURE;
		GO TO HOMF;
		END TRACK0;
	
	SELDISK: PROCEDURE(DISK);
		DECLARE	DISK BYTE;
		GO TO SELF;
		END SELDISK;
	
	SELTRK: PROCEDURE(TRACK);
		DECLARE	TRACK BYTE;
		GO TO TRKF;
		END SELTRK;
	
	SELSEC: PROCEDURE(SECTOR);
		DECLARE	SECTOR BYTE;
		GO TO SECF;
		END SELSEC;
	
	READ$DISK: PROCEDURE	BYTE;
		GO TO DRDF;
		END READ$DISK;
	
	WRITE$DISK: PROCEDURE	BYTE;
		GO TO DWRF;
		END WRITE$DISK;
	
	/* CONSOLE COMMUNICATION PROCEDURES */
	
	DECLARE
	/* SPECIAL CHARACTERS */
	ALT		EQU '7DH',
	ESC		EQU '1BH',
	TAB		EQU '0SH',
	BEL		EQU '07H',
	LF		EQU '10',
	CR		EQU '13';
	
	DECLARE	COLUMN BYTE INITIAL(0), /* CURRENT CONSOLE COLUMN */
		
		DECLARE	IOSTATA ADDRESS INITIAL(3), /* IO STATUS BYTE LOCATION */
			IOSTAT	BASED IOSTATA BYTE; /* VALUE OF STATUS BYTE */
		/* IOSTAT DEFINES THE CURRENT DEVICE ASSIGNMENT
		   0-1		CONSOLE
		   0 TTY
		   1 CRT
		   2 BATCH (USE READER DEFINITION)
		   3 USER (1)
		   2-3		READER
		   0 TTY
		   1 PTR
		   2 USER (1)
		   3 USER (2)
		   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)
		   */
		
		TABOUT: PROCEDURE(CHAR);
		DECLARE	(I, CHAR) BYTE;
		I = (CHAR = TAB AND (7 - (COLUMN AND 7)));
		IF CHAR = TAB THEN CHAR = ' ';
		DO WHILE (I:= I - 1) <> 254;
			IF CHAR = CR THEN COLUMN = 0;
			IF CHAR >= ' ' THEN COLUMN=COLUMN+1;
			CALL CONOUT(CHAR);
			IF LISTCOPY THEN CALL LSTOUT(CHAR);
			END;
		END TABOUT;
	
	
	CRLF: PROCEDURE;
		CALL TABOUT(CR);
		CALL TABOUT(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 TABOUT(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	EQU '5CH',
		CTLC	EQU '03H',
		CTLU	EQU '15H',
		CTL		EQU '5EH',
		CTLE	EQU '05H',
		CTLP	EQU '10H',
		CTLZ	EQU '1AH',
		CTLL	EQU '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 TABOUT(CTL); CALL TABOUT(C OR 40H);
			END CTLOUT;
		
		COMLEN = 0;
		DO WHILE COMLEN < MAXL;
			/* MAKE ALPHABETICS UPPER CASE */
			IF (C := CONIN) = CTLC THEN
				DO; CALL CTLOUT; CALL CRLF;
				GO TO BOOT;
				END; ELSE
				IF C = CTLE THEN /* PHYSICAL RETURN */
				CALL CRLF; ELSE
				IF C = CTLP THEN LISTCOPY = NOT LISTCOPY; ELSE
			IF C = CR THEN
				DO; BUFFER(1) = COMLEN;
				CALL TABOUT(CR);
				RETURN;
				END; ELSE
				IF C = CTLU THEN
				DO; CALL CTLOUT; CALL CRLF; COMLEN=B;
				END; ELSE
				IF C = 7FH THEN /* RUBOUT */
				DO;
				IF COMLEN > 0 THEN
					CALL TABOUT(BUFFER((COMLEN = COMLEN-1)+2));
				END; ELSE
				DO;
				IF (C AND 01100000B) = 0 THEN /* CONTROL CHARACTER */
					CALL CTLOUT; ELSE
					IF C = TAB THEN CALL TABOUT(TAB); ELSE
				CALL TABOUT(C);
				BUFFER((COMLEN := COMLEN+1)+1) = C;
				END;
			END;
		END READ;
	
	DECLARE	MAXDSK EQU '1',		/* MAX DISK NUMBER 0, 1, ...*/
		NDISK	EQU '2';		/* NUMBER OF DISKS = MAXDSK+1 */
	
	DECLARE	(DPTR, DCNT) BYTE,
		BUFFA	ADDRESS INITIAL(60H),
		BUFF	BASED BUFFA (128) BYTE;
	
	DECLARE	DMX EQU '63',
		/* DMX IS THE LAST DIRECTORY ENTRY NUMBER
		   (LISTED	AS B, 1, ... , DMX) */
		
		OFFSET	EQU '2',	/* NUMBER OF TRACKS USED BY BOOT */
		
		AL1		EQU '0C0H', 	/* FIRST ALLOCATION
								   VECTOR ELEMENT, EACH BIT THAT IS '1' RESERVES
			                       A 1 K BLOCK FOR THE DIRECTORY, EACH BLOCK IS
			                       8 RECORDS BY 12S 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		EQU '0E5H',
	
	MRD		EQU MB '10', /* NUMBER OF READ RE-TRYS */
	
	FOREVER	EQU 'WHILE TRUE',
	MAL		EQU '242',	/* 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 '118', 	/* 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 */
	
	/* THE FILE CONTROL BLOCK FORMAT IS SH0WN BELOW:
	   --------------------------------------------------------
	   /		1 BY / 8 BY / 3 BY / 1 BY /2BY/1 BY/ 16 BY /
	   /F1LETYPE/	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 TQ DOS */
	FCBDSK	BYTE,					/* DISK NAMED IN FCB */
	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 */
	CUPTRK	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 */
	
	PDISK: PROCEDURE;
		CALL PRINT(.'DISK $');
		CALL TABOUT('A'+CURDSK);
		END PDISK;
	
	HOME: PROCEDURE;
		/* MOVE TO HOME POSITION, THEN OFFSET BY DOS TRACKS */
		CALL TRACK0;			/* AT HOME POSITION */
		CALL SELTRK(OFFSET);	/* SELECT FIRST DIRECTRY POSITION */
		CURREC,	CURTRK = 0;
		END HOME;
	
	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,BEH,	14H, 1AH, 06H, BCH,	12H, 18H, 04H, 0AH,
			10H,16H);
			
			DECLARE	T ADDRESS;
			
			DO WHILE ARECORD < CURREC;
			CURREC = CURREC - 26;
			CURTRK = CURTRK - 1;
			END;
		DO WHILE ARECORD >= (T := CURREC + 26);
			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 SELSEC(TRAN(ARECORD - CURREC));
		END SEEK;
	
	WAITIO: PROCEDURE(READING);
		DECLARE	READING BYTE;		/* TRUE IF READING, FALSE IF WRITING */
		DECLARE	COND BYTE;			/* CONDITION UPON RETURN */
		DECLARE	CTLC LITERALLY '03H';
		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 CRLF; CALL PRINT(.'PERM ERR $');
		CALL PDISK; IF CONIN = CTLC THEN GO TO BOOT;
		/* ENSURE NOT BATCH PROCESSING */
		
		IF (IOSTAT AND 11B) > 1 THEN HALT;
		CALL CRLF;
		END WAITIO;
	
	RDBUFF: PROCEDURE;
		/* START AN I/O AND WAIT FOR 10 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 HUMBER FROM CURRENT
		   FCB ADDRESSED BY INFO */
		ARECORD = S(FDM+SHR(VRECORD, 3));
		END INDEX;
	
	ATRAN: PROCEDURE;
		/* COMPUTE ACTUAL TRACK ADDRESS (ASSUMES
		   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;
	
	SEEK$DIR: PROCEDURE;
		/* SEEK THE RECORD CONTAINING THE CURRENT DIRECTORY ENTRY */
		ARECORD = SHR(DCRT, DSF);
		CALL SEEK;
		END SEEK$DIR;
	
	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; CALL SEEK$DIR;
			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 1118);
		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$SIT;
	
	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 */
		RET = FALSE; /* SET TO TRUE IF $ FILE EXISTS */
		ALLOC = AL1;
		DO I=1 TO 31; CALL PUT$ALLOC(I,0);
			END;
		CALL HOME;
		DCNT = 255;
		DO FOREVER;
			CALL READ$DIR;
			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;
			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;
		CALL SEEK$DIR;
		CALL WRBUFF;
		END COPY$DIR;
	
	COPY$FCB: PROCEDURE;
		/* COPY THE ENTIRE FILE CONTROL BLOCK */
		CALL COPY$DIR(O, 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(I);
		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 HEXT 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 = 1; 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 > MRG 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) = 1;
					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 BOOT;
			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 */
		CALL SELDISK(CURDSK);
		
		/* 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;
	
	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 := (S AND 1$1111B) -1) < 30 THEN
			DO; OLDDSK = CURDSK; FCBDSK = S; S = S AND 1110*0000B;
			CALL CURSELECT;
			END;
		END RESELECT;
	
	SETDMA: PROCEDURE(A);
		DECLARE	A ADDRESS;
		CALL SELDMA(BUFFA.= A);
		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;
	FCBDSK = 0;
	
	DO CASE FUNC;
		/* 0: SYSTEM RE-BOOT */
		GO TO BOOT;
		/* 1: READ CONSOLE */
		DO; /* READ CHARACTER, TEST FOR GRAPHICS */
			IF ((RET := CONIN) >= ' ') OR
				(RET = CR) OR (RET = LF) OR (RET = TAS) THEN
			CALL TABOUT(RET);
			END;
		/* 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 = FDOS;
		/* 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,D LOG = 0;
			CALL SETDMA(80H);
			CALL SELECT;
			CHAR$RDY,	LISTCOPY = FALSE;
			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 */
		CALL SETDMA(INFO);
		/* 27: RETURN THE LOGIN VECTOR ADDRESS */
		ARET = ALLOCA;
		END; /* OF CASES */
	
	GOBACK:
	IF FCBDSK <> 0 THEN /* RESTORE DISK NUMBER */
		DO; S = FCBDSK; LINFO = OLDDSK; CALL CURSELECT;
		END;
	/* RESTORE THE USER'S STACK AREA */
	STACKPTR = OLDSP;
	
	/* RETURN A SINGLE OR DOUBLE BYTE VALUE */
	RETURN	ARET OR RET;
	END DISKMON;
;
DECLARE TEMPDATA(10) BYTE;	/* TEN LOCATIONS IN RAM FOR THE INTERFACE*/
