;LOADSYS.ASM   REASSEMBLY OF CPMLDR.COM
;28 MAY 85 RHP

; THIS PROGRAM READS THE FILE 'SYSTEM.FIL' OFF OF THE DISK
; AND RELOCATES THE FILE TO THE OPERATING POSITION.
;
;APPEND A TRUNKATED BIOS THAT NEED ONLY DO CONSOLE WRITE, AND DISK 
; READ FUNCTIONS.
;
;THIS PROGRAM MAY BE RESIDENT ON THE SYSTEM TRACKS OR RUN 
; AS A TRANSIENT PROGRAM.

;BIOS JUMP TABLE
;
BIOSS	EQU	0B00H
;
@BOOT	EQU	BIOSS + 000H	;COLD BOOT
@CONOT	EQU	BIOSS + 00CH	;CONSOLE OUT
@HOME	EQU	BIOSS + 018H	;HOME TO TRACK 0
@SLDSK	EQU	BIOSS + 01BH	;SELECT DISK
@STTRK	EQU	BIOSS + 01EH	;SET TRACK
@STSEC	EQU	BIOSS + 021H	;SET SECTOR
@STDMA	EQU	BIOSS + 024H	;SET DMA ADDRESS
@READ	EQU	BIOSS + 027H	;READ A SECTOR
@SCTRN	EQU	BIOSS + 030H	;TRANSLATE A PHYSICAL SECTOR
@MOV	EQU	BIOSS + 04BH	;MOVE BETWEEN BANKS
;
;	BDOS CALL FUNCTIONS
;
PRINT$STRING	EQU	000H	;DE=STRING ADDRESS
DISK$RESET	EQU	001H	;NO PARAMETERS
SEL$DISK	EQU	002H	;  WAS FUNCT E
SRCH$FIRST	EQU	003H	;DE=FCB ADDR, A=DIR CODE
READ$SEQUENT	EQU	004H	;DE=FCB ADDR, A=ERROR CODE
RETURN$CUR$DSK	EQU	005H	;  WAS FUNCT 19
SET$DMA$ADDR	EQU	006H	;DE=DMA ADDRESS
;
FCB	EQU	0005CH
TBUFF	EQU	00080H
;
	ORG	00100H
;
;
	LXI	SP,STACK1	;SET UP THE STACK
	CALL	@BOOT		;COLD BOOT
;
	MVI	C,DISK$RESET	;RESET DISK
	CALL	BDOS		;
;
	MVI	C,PRINT$STRING	;PRINT STRING
	LXI	D,MSBANR	;SIGN ON BANNER
	CALL	BDOS
;
	MVI	C,SRCH$FIRST	;LOCATE FILE ON DISK
	LXI	D,FCBT
	CALL	BDOS
;
	CPI	0FFH		;CHECK FOR ERROR
	LXI	D,MSOPEN	;OPEN ERROR MESSAGE
	JZ	QUITS		;HALT
;
	LXI	D,TBUFF		;POINT TO TEMP BUFFER
	CALL	DMASET		;IDENTIFY AS DMA ADDR
	CALL	READSECT
	LXI	H,TBUFF		;POINT TO TEMP BUFFER
	LXI	D,HEDR1		;POINT TO NEW STORAGE
	MVI	C,006H		;MOVE 6 BYTES
;
MOVER:	MOV	A,M		;MOVE MEMORY BLOCK
	STAX	D
	INX	D
	INX	H
	DCR	C
	JNZ	MOVER
;
	CALL	READSECT	;PUT SECTOR INTO TEMP BUFFER
	MVI	C,PRINT$STRING	;PRINT OUT THE CONTENTS OF
	LXI	D,TBUFF		;THE STRING JUST READ
	CALL	BDOS
;
	LDA	HEDR2 		;GET 2ND GYTE OF HEADER
	MOV	H,A		;PUT IN H
	LDA	HEDR1 		;GET FIRST BYTE OF HEADER
	CALL	READFILE
;
	LDA	HEDR4 		;GET 4TH BYTE OF HEADER
	ORA	A		;SET FLAGS
	JZ	SKIPRD		;SKIP IF EMPTY
	MOV	H,A
	LDA	HEDR3 
	CALL	READFILE
;
SKIPRD:	LXI	H,FCB+1		;1ST CHAR OF FILENAME
	MOV	A,M		;GET IT
	CPI	024H		;IS IT A $?
	JNZ	SKIP2		;IF NOT THEN SKIP
	INX	H		;2ND CHAR OF FILENAME
	MOV	A,M		;GET IT
	CPI	042H		;IS IT A 'B'?
	CZ	REBOOT		;THEN GO TO REBOOT
SKIP2:	LXI	SP,HEDR5	;ELSE JUMP TO ADDRESS OF
	RET			; BYTES 5,6 OF HEADER 

READFILE:
	ORA	A		;SET FLAGS
	MOV	D,A		;FIRST BYTE TO D
	MVI	E,000H		;E=0
	MOV	A,H		;SECOND BYTE TO A
	RAL			;X2
	MOV	H,A		;BACK TO H
READLOOP:
	XCHG			;SWAP DE,HL
	LXI	B,0FF80H	; -80	
	DAD	B		;SUBTRACT 80 FROM 2ND BYTE
	XCHG			;SWAP AGAIN
	PUSH	D		;SAVE REGISTERS
	PUSH	H
	CALL	DMASET		;POINT TO NEW ADDRESS
	CALL	READSECT	;READ DISK INTO THERE	
	POP	H		;RESTORE REGISTERS
	POP	D
	DCR	H		;H-1
	JNZ	READLOOP		;LOOP TIL H=0
	RET

DMASET:	MVI	C,SET$DMA$ADDR
	CALL	BDOS
	RET

READSECT:
	MVI	C,READ$SEQUENT
	LXI	D,FCBT		;POINT TO FILE CONTROL BLOCK
	CALL	BDOS
;
	ORA	A		;SET FLAGS
	LXI	D,MSREAD	;READ ERROR MESSAGE
	RZ			;NO ERROR
QUITS:	MVI	C,PRINT$STRING	;ELSE PRINT ERROR MSG
	CALL	BDOS
;
	DI			;KILL INTERRUPTS
	HLT			;FREEZE
;
REBOOT:	RST	07		
	RET
;
BDOS:	XCHG			;MSG POINTER IN HL
	SHLD	INFO		;STORE MSG LOCATION
	XCHG			;MSG POINTER BACK TO DE
	MOV	A,C
	CPI	00EH
	JC	BDOS1
	STA	SAVEC 		;SAVE # IN C
	XRA	A		;CLEAR ACCUMULATOR
	STA	ZERO3 		;SET TO FALSE 
	STA	CURDSK
	STA	ZERO4 
BDOS1:	MOV	A,E		;GET LO BYTE OF MEM ADDRESS
	STA	LINFO 		;SAVE IT
	LXI	H,00000H	;CLEAR HL
	SHLD	ARET		;RETURN VALUE DEFAULTS TO 0000
	SHLD	FCBDSK		;  SAVE USERS STACK PTR, SET TO LOCAL STACK
	DAD	SP		;MOVE SP TO HL
	SHLD	ENTSP		;ENTSP=STACK POINTER
	LXI	SP,LSTACK	;POINT STACK TO END OF C7 TABLE
	LXI	H,GOBACK	;RETURN HERE AFTER ALL FUNCTIONS
	PUSH	H		;JUMP GOBACK EQUIV TO RETURN
	MOV	A,C
	CPI	006H		;NUMBER OF FUNCTIONS
	JNC	BDOS2		;INVALID NUMBER
	MOV	C,E		;POSSIBLE OUTPUT CHAR. TO C
	LXI	H,FUNCTAB	;POINT TO FUNCTION TABLE
	JMP	BDOS3
;
BDOS2:	SBI	064H
	JC	SEARCH$FIN
BDOS3:	MOV	E,A		;E GETS A
	MVI	D,000H		;DE=FUNCTION, HL=.CIOTAR
	DAD	D		;ADD DE, HL
	DAD	D		;ADD DE, HL
	MOV	E,M		;MEMORY WORD TO DE
	INX	H
	MOV	D,M		;DE=FUNCTION ARGUMENT
	LHLD	INFO		;POINT TO MESSAGE WITH HL
	XCHG			;DE POINTS MSG, HL TO DEST.
	PCHL			;JUMP TO ROUTINE
;
FUNCTAB:
	DW	FUNCT00		;FUNCTION 9=PRINT STRING
	DW	FUNCT01		;FUNCTION D=RESET DISK
	DW	FUNCT02		;FUNCTION E=SELECT DISK
	DW	FUNCT03		;FUNCTION F=OPEN FILE
	DW	FUNCT04		;FUNCTION 14=READ SEQUENTIAL
	DW	FUNCT05		;FUNCTION 19=RETURN CURRENT DISK
	DW	FUNCT06		;FUNCTION 1A=SET DMA ADDRESS
;
;	COMPUTE CHARACTER POSITION/WRITE CONSOLE
;	CHARACTER FROM C
;	COMPCOL = TRUE IF COMPUTING COLUMN POSITION
;
CONOUT:	LDA	COMPCOL
	ORA	A
	JNZ	COMPOUT		;WRT CHAR FROM C, THEN COMP COL.
	PUSH	B
	CALL	@CONOT		;PRINT CHARACTER ON CONSOLE
	POP	B
COMPOUT:MOV	A,C		;RECALL CHAR & COMPUTE COL POSIT
	LXI	H,COLUMN	;A=CHAR, HL=.COLUMN
	CPI	07FH		;RUBOUT?
	RZ			;NO COL CHANGE IF NULLS
	INR	M		;NEXT COLUMN
	CPI	020H		;SPACE?
	RNC			;RETURN IF GRAPHIC,ELSE RESET COL.
	DCR	M		;NEXT COLUMN
	MOV	A,M
	ORA	A
	RZ			;RET IF ZERO, ELSE MAYBE BS OR EOL
	MOV	A,C		;CHAR IN A
	CPI	008H		;CTL H?
	JNZ	NOTBACKSP	;ELSE BACKSPACE
	DCR	M		;NEXT COLUMN
	RET
;
;	NOT A BACKSPACE CHARACTER, EOL?
;
NOTBACKSP:
	CPI	00AH		;LINEFEED?
	RNZ
	MVI	M,000H		;END OF LINE, COL=0
	RET
;
;	PRINT STRING  DE=STRING ADDRESS, ENDS IN $ 
;
FUNCT00:XCHG			;WAS LHLD INFO
	MOV	C,L
	MOV	B,H		;BC=STRING ADDRESS
;
;	PRINT MESSAGE UNTIL M(BC) = $
;
PRINT:	LXI	H,DOLLAR
	LDAX	B
	CMP	M		;$?
	RZ			;STOP ON $, ELSE MORE TO PRINT
	INX	B
	PUSH	B
	MOV	C,A
	MOV	A,C
	CPI	009H		;TAB?
	JNZ	CONOUT		;IF NO TAB, DIRECT TO CONOUT
TAB0:	MVI	C,020H		;ELSE CHANGE TO SPACE
	CALL	CONOUT
	LDA	COLUMN		
	ANI	007H		;COLUMN MOD 8 = 0 7
	JNZ	TAB0		;BACK FOR ANOTHER IF NOT
	POP	B
	JMP	PRINT
;
DISKEOF:MVI	A,001H		;SET LRET=1
STA$RET:STA	ARET 		;STORE THE REGISTER TO ARET
FNC$RET:RET	;JMP GOBACK (POP STACK FOR NON CPM FUNCTIONS)
;
SEL$ERROR:
	LXI	B,MSBDOS	;BDOS ERROR MESSAGE
	CALL	PRINT
	LXI	B,MSSLCT	;SELECT MSG
 	JMP	QUIT2
;
PERMSG:	LXI	B,MSBDOS	;BDOS ERROR MESSAGE
	CALL	PRINT
	LXI	B,MSPERM	;PERMANENT MSG
QUIT2:	CALL	PRINT
;
	DI			;KILL INTERRUPTS
	HLT			;FREEZE
;
SUBDH:	MOV	A,E		;SUBTRACT HL = DE-HL
	SUB	L
	MOV	E,A
	MOV	A,D
	SBB	H
	MOV	D,A
	RNC
	DCR	B
	RET
;
RECOK8:	LDAX	D		;A GETS MEMORY POINTED BY DE
	CMP	M		;COMPARE TO MEMORY POINTED BY HL
	RNZ			;QUIT IF DIFFERENT
	INX	H		;NEXT HL
	INX	D		;NEXT DE
	DCR	C		;TIL COUNT IN C
	RZ			; DROPS TO ZERO
	JMP	RECOK8		;ELSE TRY AGAIN
;
;	MOVE DATA OF LENGTH C FROM DE TO HL
;
MOVE:	INR	C		;IN CASE IT IS ZERO
MOVE0:	DCR	C		;FOR COUNT IN C
	RZ			;DONE?
	LDAX	D		;MEMORY POINTED BY DE TO A
	MOV	M,A		;MOVE TO MEMORAY POINTED BY HL
	INX	D		;NEXT DE
	INX	H		;NEXT HL
	JMP	MOVE0		;KEEP LOOPING TIL C=0
;
;	SELECT DISK DRIVE AT CURDSK, FILL THE BASE ADDRESS
;	CURTKA-ALLOCA, THEN FILL VALUES IN DISK PARAMETER BLOCK
;
SELECTDISK:
	MOV	C,D		;CURRENT DISK TO C
				;LSB OF C=0 IF NOT YET LOGGED IN
	CALL	@SLDSK		;SELECT DISK, SETS HL
	MOV	A,H
	ORA	L
	RZ			;HL=0 FOR ERROR ELSE DISK HEADER
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H		;DE=.TRAN
	INX	H
	INX	H		;.CDRMAX
	SHLD	CURTRKA
	INX	H
	INX	H		;HL=.CURREC
	SHLD	CURRECA
	INX	H
	INX	H
	INX	H
	INX	H
	INX	H
	INX	H
	XCHG
	SHLD	TRANV		;.TRAN VECTOR
	LXI	H,BUFFB		;DE=SOURCE, HL=DEST FOR MOVE 
	MVI	C,00DH		;ADDLIST
	CALL	MOVE		;ADDLIST FILLED
	LHLD	BUFFB		;NOW FILL DPB
	XCHG			;DE IS SOURCE
	LXI	H,SECTPT	;HL IS DEST.
	MVI	C,011H		;DPBLIST
	CALL	MOVE		;DATA FILLED
	LHLD	MAXALL		;LARGEST ALLOC NUMBER
	MOV	A,H		;00 INDICATES <255
	LXI	H,SINGLE
	MVI	M,0FFH		;FF=TRUE, ASSUME A=00
	ORA	A
	JZ	RETSELECT
	MVI	M,000H		;M=FALSE
RETSELECT:			;HIGH ORDER OF MAXALL NOT 0
				; USE DOUBLE DM
	STC
	RET
;
;	MOVE TO TRACK 0
;
HOME:	CALL	@HOME		;HOME THE DISK
	XRA	A		;ZERO THE ACCCUM
	LHLD	CURTRKA
	MOV	M,A
	INX	H
	MOV	M,A		;CURTRAK=0000
	LHLD	CURRECA
	MOV	M,A
	INX	H
	MOV	M,A		;CURREC=0000
	INX	H
	MOV	M,A
	RET
;
;
RDBUFF1:
	LXI	H,ARECORD
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	MOV	B,M
	RET
;
;
;
RDBUFF:	CALL	RDBUFF1
	CALL	@READ		;READ A SECTOR
	ORA	A		;SET FLAGS
	RZ			;OK
	MOV	C,A		;SAVE ERROR
	CPI	003H		;CHECK ERROR
	JC	PERMSG		;PERMANENT BDOS ERROR
	MVI	C,001H		;ELSE CHANGE ERROR FLAG
	JMP	PERMSG		;PERMANENT BDOS ERROR

;
;	SEEK RECORD CONTAINING THE CURRENT DIRECTORY ENTRY
;
SEEKDIR:LHLD	DCNT		;DIRECTORY COUNTER TO COUNTER
	MVI	C,002H		;DSKSHF
	CALL	HLROTR		;VALUE TO HL
	MVI	B,000H
	XCHG
	LXI	H,ARECORD
	MOV	M,E		;STORE ARECORD
	INX	H
	MOV	M,D		;STORE DREC
	INX	H
	MOV	M,B
	RET
;
;	SEEK THE TRACK GIVEN BY ARECORD (ACTUAL RECORD)
;
SEEK:	LHLD	CURTRKA
	MOV	C,M
	INX	H
	MOV	B,M
	PUSH	B
	LHLD	CURRECA
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	MOV	B,M
	LHLD	ARECORD
	LDA	SHIFTED
	MOV	C,A
SEEK0:	MOV	A,L		;LOOP WHILE ARECORD < CURREC
	SUB	E
	MOV	A,H
	SBB	D
	MOV	A,C
	SBB	B
	PUSH	H
	JNC	SEEK1		;SKIP IF ARECORD >= CURREC
	LHLD	SECTPT		;CURREC = SECTPT
	CALL	SUBDH		;SUBTRACT HL FROM DE
	POP	H
	XTHL
	DCX	H		;CURTRK = CURTRK-1
	XTHL
	JMP	SEEK0		;FOR ANOTHER TRY
;
SEEK1:	LHLD	SECTPT		;LOOK WHILE ARECORD >= (T:CURREC+SECTP)
	MOV	A,E		;ADD HL AND DE
	ADD	L
	MOV	E,A
	MOV	A,D
	ADC	H
	MOV	D,A
	RNC
	INR	B
	POP	H
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	MOV	A,C
	SBB	B
	JC	SEEK2		;SKIP IF T>ARECORD, CURREC=T,
	XTHL			; CURTRK=CURTRK+1
	INX	H
	XTHL
	PUSH	H
	JMP	SEEK1		;FOR ANOTHER TRY
;
SEEK2:	XTHL
	PUSH	H
	LHLD	SECTPT
	CALL	SUBDH		;SUBTRACT HL FROM DE
	POP	H		;ARRIVE HERE WITH UPDATED VALUES
				; IN EACH REGISTER
	PUSH	D
	PUSH	B
	PUSH	H		;TO STACK FOR LATER
				;STACK=BC=ARECORD, DE=CURREC, HL=CURTRK
	XCHG
	LHLD	OFFSET
	DAD	D		;HL=CURTRK+OFFSET
	MOV	B,H
	MOV	C,L
	SHLD	TRACK
	CALL	@STTRK		;TRACK SET UP. NOTE THAT BC-CURTRK
				; IS DIFFERENCE TO MOVE IN BIOS
	POP	D		;RECALL CURTRK
	LHLD	CURTRKA
	MOV	M,E
	INX	H
	MOV	M,D		;CURTRK UPDATED
				; NOW COMPUTE SECTOR AS ARECORD-CURREC
	POP	B		
	POP	D		;RECALL CURREC
	LHLD	CURRECA
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
	MOV	M,B
	POP	B		;BC=ARECORD, DE=CURREC
	MOV	A,C
	SUB	E
	MOV	L,A
	MOV	A,B
	SBB	D
	MOV	H,A
	CALL	SEEK3
	MOV	B,H
	MOV	C,L
	LHLD	TRANV
	XCHG			;BC=SECTOR#, DE=.TRAN
	CALL	@SCTRN		;HL=TRAN (SECTOR)
	MOV	C,L
	MOV	B,H
	SHLD	SAVSEC
	CALL	@STSEC		;SECTOR SELECTED
	LHLD	DMAADDR
	MOV	C,L
	MOV	B,H
	JMP	@STDMA		;SET DMA
;
SEEK3:	LDA	ZERO1
	MOV	C,A
	JMP	HLROTR
;
;	COMPUTE DISK MAP POSITION FOR VRECORD TO HL
;
DM$POSITION:
	LXI	H,BLKSHF
	MOV	C,M		;SHIFT COUNT TO C
	LDA	VRECORD		;CURRENT VIRTUAL RECORD TO A
DMPOS0:	ORA	A
	RAR
	DCR	C
	JNZ	DMPOS0		;A=SBR(VRECORD,BLKSHF)=
				; VRECORD/2**(SEC/BLOCK)
	MOV	B,A		;SAVE IT FOR LATER ADDITION
	MVI	A,008H
	SUB	M		;8-BLKSHF TO ACCUMULATOR
	MOV	C,A		;EXTENT SHIFT COUNT IN REGISTER C
	LDA	EXTVAL		;EXTENT VALUE ANI EXTMASK
;
;	BLKSHF=3,4,5,6,7, C=5,4,3,2,1
;	SHIFT IS 4,3,2,1,0
;
DMPOS1:	DCR	C
	JZ	DMPOS2
	ORA	A
	RAL
	JMP	DMPOS1
;
;	ARRIVE HERE WITH A=SHL(EXT AND EXTMSK), 7-BLKSHF)
;
DMPOS2:	ADD	B		;ADD THE PREVIOUS SHR(VRECORD,BLKSHF)
				;VALUE. A IS ONE OF THE VALUES,
				;DEPENDING ON ALLOC BKS BLKSHF
				;1K	3	V/8+EXTVAL*16
				;2K	4	V/16+EXTVAL*8
				;4K	5	V/32+EXTVAL*4
				;8K	6	V/64+EXTVAL*2
				;16K	7	V/128+EXTVAL*1
	RET			;WITH DM$POSITION IN A
;
;	GET DISK MAP VALUE FROM POSITION GIVEN BY BC
;
GETDM:				;POINT TO 16TH CHAR IN INFO
	LHLD	INFO		;BASE ADDRESS OF FCB
	LXI	D,00010H	;DSKMAP
	DAD	D		;HL=.DSKMAP
	DAD	B		;INDEX BY SINGLE BYTE VALUE
	LDA	SINGLE		;SINGLE BYTE/MAP ENTRY?
	ORA	A
	JZ	GETDMD		;GET DISK MAP SINGLE BYTE
	MOV	L,M
	MOV	H,B
	RET			;WITH HL=00BB
;
GETDMD:	DAD	B		;HL=.FCB(DM+I*2)
				; DOUBLE PRECISION VALUE RETURNED
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A
	RET
;
;	COMPUTE DISK BLOCK NUMBER FROM CURRENT FCB
;
INDEX:	CALL	DM$POSITION	;0....15 IN REGISTER A
	STA	DMPOS 
	MOV	C,A
	MVI	B,000H
	CALL	GETDM		;VALUE TO HL
	SHLD	ARECORD
	MOV	A,L
	ORA	H
	RET
;
;	COMPUTE ACTUAL RECORD ADDRESS, ASSUMING INDEX CALLED
;
ATRAN:	LDA	BLKSHF		;SHIFT COUNT TO REG A
	MOV	C,A
	LHLD	ARECORD	
	XRA	A
	CALL	ATRAN0
	SHLD	ARECORD
	STA	SHIFTED 
	SHLD	SHAREC
	LDA	BLKMSK
	MOV	C,A		;MASK VALUE TO C
	LDA	VRECORD 
	ANA	C		;MASKED VALUE IN A
	MOV	B,A
	STA	MSKVREC 
	LXI	H,ARECORD	;ARECORD=HL OR (VRECORD AND BLKMSK)
	ORA	M
	MOV	M,A
	RET
;
ATRAN0:	INR	C
ATRAN1:	DCR	C
	RZ
	DAD	H
	ADC	A
	JMP	ATRAN1
;
;	GET CURRENT EXTENT FIELD ADDRESS TO A
;
GETEXTA:LHLD	INFO
	LXI	D,0000CH	;EXTNUM
	DAD	D		;HL=.FCB(EXTNUM)
	RET

GETFCBB:	LHLD	INFO
	LXI	D,0000FH
	DAD	D
	RET
;
;	COMPUTE RECCNT AND NXTREC ADDRESSES FOR GET/SETFCB
;
GETFCBA:CALL	GETFCBB
	XCHG			;DE=.FCB(NXTREC)
	LXI	H,00011H	;NXTREC-RECC
	DAD	D		;HL=.FCB(NXTREC)
	RET
;
;	SET VARIABLES FROM CURRENTLY ADDRESSED FCB
;
GETFCB:	CALL	GETFCBA		;ADDRESSES IN DE, HL
	MOV	A,M
	STA	VRECORD 	;VRECORD=FCB(NXTREC)
	XCHG
	MOV	A,M
	STA	RCOUNT 		;RCOUNT=FCB(RECCNT)
	CALL	GETEXTA		;HL=.FCB(EXTNUM)
	LDA	EXTMSK		;EXTENT MASK TO A
	ANA	M		;FCB(EXTNUM) AND EXTMASK
	STA	EXTVAL 
	RET
;
;	PLACE VALUES BACK IN CURRENT FCB
;
SETFCB:	CALL	GETFCBA		;ADDRESSES TO DE, HL
	MVI	C,001H
	LDA	VRECORD
	ADD	C
	MOV	M,A		;FCB(NXTREC)=VRECORD+SEQIO
	XCHG
	LDA	RCOUNT
	MOV	M,A		;FCB(RECCNT)=RCOUNT
	RET
;
;	HL ROTATE RIGHT BY AMOUNT C
;
HLROTR:	INR	C		;IN CASE 0
HLROTR0:DCR	C
	RZ			;RETURN WHEN C=0
	MOV	A,H
	ORA	A
	RAR
	MOV	H,A		;HIGH BYTE
	MOV	A,L
	RAR
	MOV	L,A		;LOW BYTE
	JMP	HLROTR0
;
;	ROTATE THE MASK IN HL BY THE AMOUNT IN C
;
HLROTL:	INR	C		;MAY BE ZERO
HLROTL0:DCR	C
	RZ			;RETURN WHEN C=0
	DAD	H
	JMP	HLROTL0
;
;	SET A "1" VALUE IN CURDSK POSITION OF BC
;
SET$DISK:
	LDA	CURDSK
	PUSH	B		;SAVE INPUT PARAMETER
	MOV	C,A		;READY PARAMETER FOR SHIFT
	LXI	H,00001H
	CALL	HLROTL		;HL=MASK TO INTEGRATE
	POP	B		;ORIGINAL MASK
	MOV	A,C
	ORA	L
	MOV	L,A
	MOV	A,B
	ORA	H
	MOV	H,A		;HL=MASK OR ROL(1,CURDSK)
	RET
;
;	RETURN TRUE IF DIR CHECKSUM
;
NOWRITE:LDA	CURDSK
	MOV	C,A
	CALL	HLROTR
	MOV	A,L
	ANI	001H
	RET			;NOW 0 IF NOWRITE
;
;	COMPUTE THE ADDRESS OF A DIRECTORY ELEMENT AT
;	POSITION DPTR IN THE BUFFER
;
GETDPTRA:
	LHLD	BUFFA
	LDA	DPTR
	ADD	L		;HL=HL+A
	MOV	L,A
	RNC			;OVERFLOW TO H
	INR	H
	RET
;
RDDIR2:	PUSH	D
	LXI	D,0000AH
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	POP	D
	RET
;
READDIR3:	CALL	SEEKDIR
	LDA	ZERO2
	ORA	A
	JZ	RD$DIR
	MVI	A,003H
	CALL	READDIR4
	JMP	SETDATA
;
;	READ A DIRECTORY ENTRY INTO THE DIRECTORY BUFFER
;
RD$DIR:	CALL	RDDIR1
	SHLD	BUFFA
	CALL	SEEK
	CALL	RDBUFF		;DIRECTORY ENTRY LOADED
;
;	SET DATA DMA ADDRESS
;
SETDATA:LHLD	DMAAD
	JMP	SETDMA
;
RDDIR1:	LHLD	ALLOCA
	CALL	RDDIR2
;
;	HL=ADDRESS TO SET (I.E., BUFFA OR DMAAD)
;
SETDMA:	SHLD	DMAADDR
	RET
;
;	RETURN ZERO FLAG IF AT END OF DIRECTORY, NON ZERO
;	IF NOT AT END (END OF DIR IF DCNT=0FFFFH)
;
END$OF$DIR:	LXI	H,DCNT
	MOV	A,M		;MAY BE 0FFH
	INX	H
	CMP	M		;LOW(DCNT)=HIGH(DCNT)?
	RNZ			;NOW ZERO RETURNED IF DIFFERENT
				;HIGH AND LOW THE SAME,=0FFH?
	INR	A		;0FFH BECOMES 00 IF SO
	RET
;
;	SET DCNT TO THE END OF THE DIRECTORY
;
SET$END$DIR:
	LXI	H,0FFFFH	;(ENDDIR)
	SHLD	DCNT
	RET
;
READ$DIR:
	LHLD	DIRMAX
	XCHG
	LHLD	DCNT
	INX	H
	SHLD	DCNT
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	JC	SET$END$DIR
	LDA	DCNT
	ANI	003H
	MVI	B,005H
READDIR2:
	ADD	A
	DCR	B
	JNZ	READDIR2
	STA	DPTR 
	ORA	A
	RNZ
	PUSH	B
	CALL	READDIR3
	POP	B
	RET
;
;	COMPARE EXTENT# IN A TO THAT IN C, RETURN NONZERO
;	IF NO MATCH
;
COMPEXT:
	PUSH	B		;SAVE C'S ORIGINAL VALUE
	PUSH	PSW
	LDA	EXTMSK
	CMA
	MOV	B,A		;B HAS NEGATED FORM OF EXTENT MASK
	MOV	A,C
	ANA	B
	MOV	C,A		;LOW BITS REMOVED FROM C
	POP	PSW
	ANA	B		;LOW BITS REMOVED FROM A
	SUB	C
	ANI	01FH		;(MAXEXT) SET FLAGS
	POP	B		;RESTORE ORIGINAL VALUES
	RET
;
OPENER:	CALL	GETFCBA
	MVI	C,010H
	MOV	B,C
	INR	C
	PUSH	B
OPENER1:
	POP	B
	DCR	C
	XRA	A
OPENER2:
	DCX	H
	DCR	B
	CMP	M
	JNZ	OPENER3
	DCR	C
	JNZ	OPENER2
OPENER3:
	MOV	A,C
	STA	DMPOS 
	LDA	SINGLE
	ORA	A
	MOV	A,B
	JNZ	OPENER4
	RAR
OPENER4:
	PUSH	B
	PUSH	H
	MOV	L,A
	MVI	H,000H
	LDA	BLKSHF
	MOV	D,A
	MVI	A,007H
	SUB	D
	MOV	C,A
	CALL	HLROTR
	MOV	B,L
	LDA	EXTMSK
	CMP	B
	POP	H
	JC	OPENER1
	CALL	GETEXTA
	MOV	C,M
	CMA
	ANI	01FH
	ANA	C
	ORA	B
	POP	B
	RET
;
;	SEARCH FOR DIRECTORY ELEMENT OF LENGTH C AT INFO
;
SEARCH:	LHLD	INFO
	SHLD	SEARCHA		;SEARCHA=INFO
	MOV	A,C
	STA	SEARCHL 
	CALL	SET$END$DIR	;DCNT=ENDIR
	CALL	HOME		;TO START AT THE BEGINNING
				;(DROP THROUGH TO SEARCHN)
;
SEARCHN:			;SEARCH FOR THE NEXT DIRECTORY
				;ELEMENT, ASSUMING A PREVIOUS
				;CALL ON SEARCH  WHICH SETS
				;SEARCHA AND SEARCHL
	MVI	C,000H		;(FALSE)
	CALL	READ$DIR	;READ NEXT DIRECTORY ELEMENT
	CALL	END$OF$DIR
	JZ	SEARCH$FIN	;SKIP TO END IF SO
				;NOT END OF DIRECTORY, SCAN FOR MATCH
	LHLD	SEARCHA	
	XCHG
	CALL	GETDPTRA	;HL=BUFFA+DPTR
	LDA	SEARCHL
	MOV	C,A		;LENGTH OF SEARCH TO C
	MVI	B,000H		;B COUNTS UP, C COUNTS DOWN
	MOV	A,M
	CPI	0E5H		;(EMPTY)
	JZ	SEARCHN
SEARCHLOOP:
	MOV	A,C
	ORA	A
	JZ	ENDSEARCH
	MOV	A,B
	CPI	00DH		;(UBYTES)
	JZ	SEARCHOK	;
				;NOT THE UBYTES FIELD, EXTENT FIELD?
	CPI	00CH		;(EXTNUM) MAY BE EXTENT FIELD
	JZ	SEARCHEXT	;SKIP TO SEARCH EXTENT
	LDAX	D		;FCB CHARACTER
	SUB	M
	ANI	07FH		;MASK-OUT FLAGS/EXTENT MODULE
	JNZ	SEARCHN		;SKIP IF NOT MATCHED
	JMP	SEARCHOK	;MATCHED CHARACTER

SEARCHEXT:			;A HAS FCB CHARACTER
				;ATTEMPT AN EXTENT # MATCH
	LDAX	D
	PUSH	B		;SAVE COUNTERS
	MOV	C,M		;DIRECTORY CHARACTER TO C
	CALL	COMPEXT		;COMPARE USER/DIR CHAR
	POP	B		;RECALL COUNTERS
	ORA	A
	JNZ	SEARCHN		;SKIP IF NO MATCH
;
SEARCHOK:			;CURRENT CHARACTER MATCHES
	INX	D
	INX	H
	INR	B
	DCR	C
	JMP	SEARCHLOOP
;
ENDSEARCH:
	XRA	A
	STA	ARET 
	MOV	B,A
	INR	B
	RET
;
;	END OF DIRECTORY OR EMPTY NAME
;
SEARCH$FIN:		
	MVI	A,0FFH	
	MOV	B,A
	INR	B
	JMP	STA$RET
;
;	SEARCH FOR THE DIRECTORY ENTRY, COPY TO FCB
;
OPEN:	MVI	C,00FH		;NAMLEN
	CALL	SEARCH
	RZ			;RETURN WITH ARET=255 IF END
				;NOT END OF DIRECTORY. COPY FCB
				;INFORMATION (REFERENCED BELOW
				;TO COPY FCB INFO)
OPEN$COPY:
	CALL	GETEXTA
	MOV	A,M
	PUSH	PSW
	CALL	GETDPTRA
	XCHG			;DE=.BUFF(DPTR)
	LHLD	INFO		;HL=.FCB(0)
	MVI	C,020H		;(NXTREC) LENGTH OF MOVE OPERATION
	CALL	MOVE		;FROM .BUFF(DPTR) TO .FCB(0)
				;NOTE THAT ENTIRE FCB IS COPIED,
				; INCLUDING INDICATORS
	CALL	OPENER
	MOV	C,A
	POP	PSW
	MOV	M,A
OPEN$COPY1:
	MVI	B,000H
	XCHG
	LXI	H,00003H
	DAD	D
	LDAX	D
	SUB	C
	JZ	OPEN$COPY2
	MOV	A,B
	JNC	OPEN$RCNT	;USER IS LARGER
	MVI	A,080H		;DIRECTORY IS LARGER
	MOV	B,M
OPEN$RCNT:			;A HAS RECORD COUNT TO FILL
	MOV	M,A
	MOV	A,B
	STA	RECCNT 
	RET

OPEN$COPY2:
	STA	RECCNT 
	MOV	A,M
	ORA	A
	RNZ
	LDA	DMPOS
	ORA	A
	RZ
	LDA	SAVEC
	CPI	00FH
	RZ
	MVI	M,080H
	RET
;
OPEN$REEL3:
	PUSH	H
	LDA	RECCNT
	ORA	A
	JZ	OPEN$REEL4
	LXI	D,00003H
	DAD	D
	MOV	M,A
	XRA	A
	STA	RECCNT 
OPEN$REEL4:
	POP	H
	RET
;
;	CLOSE THE CURRENT EXTENT, AND OPEN THE NEXT ONE
;	IF POSSIBLE. RMF IS TRUE IF IN READ MODE
;
OPEN$REEL:
	CALL	GETEXTA
	MOV	A,M
	MOV	C,A
	INR	C
	CALL	COMPEXT
	JZ	OPEN$REEL1
	MVI	A,01FH
	ANA	C
	MOV	M,A
	MVI	C,00FH
	CALL	SEARCH
	CALL	OPEN$COPY
OPEN$REEL0:
	CALL	GETFCB
	XRA	A
	STA	VRECORD 
	JMP	STA$RET

OPEN$REEL1:
	INR	M
	CALL	OPENER
	MOV	C,A
	CMP	M
	JNC	OPEN$REEL2
	DCR	M
	JMP	DISKEOF
;
OPEN$REEL2:
	CALL	OPEN$REEL3
	CALL	OPEN$COPY1
	JMP	OPEN$REEL0
;
;	SEQUENTIAL DISK READ OPERATION
;
SEQDISKREAD:
	CALL	GETFCB		;SETS PARAMETERS FOR THE READ
	LDA	VRECORD
	LXI	H,RCOUNT
	CMP	M		;VRECORD-RCOUNT,SKIP IF RCOUNT>VRECORD
	JC	RECORDOK	;NOT ENOUGH RECORDS IN THE EXTENT,
				; RECORD COUNT MUST BE 128 TO CONTINUE
	CPI	080H		;VRECORD=128
	JNZ	DISKEOF		;SKIP IF VRECORD<>128
	CALL	OPEN$REEL	;GO TO NEXT EXTENT IF SO
	LDA	ARET
	ORA	A
	JNZ	DISKEOF		;STOP AT EOF
;
;	ARRIVE WITH FCB ADDRESSING A RECORD TO READ
;
RECORDOK:
	CALL	INDEX		;ERROR 2 IF READING UNWRITTEN DATA
				; (RETURNS 1 TO BE COMPATABLE WITH 1.4)
	JZ	DISKEOF		;RECORD HAS BEEN ALLOCATED, READ IT
	CALL	ATRAN		;ARECORD NOW A DISK ADDRESS
	LDA	ZERO2
	ORA	A
	JNZ	RECORDOK1
	CALL	SETDATA
	CALL	SEEK		;TO PROPER TRACK, SECTOR
	CALL	RDBUFF		;TO DMA ADDRESS
	JMP	SETFCB		;REPLACE PARAMETER

SELECT:	LDA	CURDSK
	INR	A
	JZ	SEL$ERROR
	DCR	A
	LXI	H,SELSTR
	CMP	M
	RZ			;SKIP IN LINFO=CURDSK
	MOV	M,A
	MOV	D,A
	LHLD	DLOG
	CALL	NOWRITE
	MOV	E,A
	PUSH	D
	CALL	SELECTDISK
	POP	H		;RECALL DLOG VECTOR
	JNC	SEL$ERROR
	DCR	L
	RZ
	LHLD	DLOG
	MOV	C,L
	MOV	B,H		;CALL READY
	CALL	SET$DISK
	SHLD	DLOG
	RET
;
CURSELECT:
	LDA	LINFO
	STA	CURDSK 
	RET
;
CLRMODNUM:
	XRA	A
	STA	MODNUM 
	JMP	RSEL1
;
;	CHECK CURRENT FCB TO SEE IF RESELECTION NECESSARY
;
RESELECT:
	MVI	A,080H
	MOV	B,A
	DCR	A
	MOV	C,A
	LHLD	INFO
	LXI	D,00007H
	XCHG
	DAD	D
	MOV	A,M
	ANA	B
	MOV	A,M
	ANA	C
	MOV	M,A
	INX	H
	MOV	A,M
	ANA	B
	STA	MODNUM 
	MOV	A,M
	ANA	C
	MOV	M,A
	CALL	GETEXTA
	MOV	A,M
	ANI	01FH
	MOV	M,A
	CALL	GETFCBB
	MOV	A,M
	ANA	B
	JZ	RSEL1
	MOV	A,M
	ANA	C
	MOV	M,B
RSEL1:	STA	RECCNT 
	LXI	H,00000H
	SHLD	OLDDSK
	MVI	A,0FFH
	STA	FCBDSK 
	LHLD	INFO
	MOV	A,M
	ANI	01FH
	DCR	A
	STA	LINFO 
	CPI	0FFH
	JZ	RSEL2
	MOV	A,M
	STA	OLDDSK 
	CALL	CURSELECT
RSEL2:	CALL	SELECT
	MVI	A,000H
	LHLD	INFO
	MOV	M,A
	RET
;
;	RESET DISK SYSTEM TO DISK 0   SEVERAL PARAMETERS RETURNED
;
FUNCT01:LXI	H,00000H
	SHLD	DLOG
	XRA	A
	STA	CURDSK 		;NOTE THAT USER CODE IS UNCHANGED
	DCR	A
	STA	SELSTR 
	LXI	H,TBUFF
	SHLD	DMAAD		;DMAAD=TBUFF
	JMP	SETDATA		;TO DATA DMA ADDR
;
;	SELECT DISK  E=DISK NUMBER
;
FUNCT02:CALL	CURSELECT
	JMP	SELECT
;
;	OPEN FILE  DE=FCB ADDRESS  A=DIRECTORY CODE
;
FUNCT03:CALL	CLRMODNUM	
	CALL	OPEN
	CALL	END$OF$DIR
	RZ
	CALL	GETFCBA
	MOV	A,M
	INR	A
	JNZ	OPENX1
	DCX	D
	DCX	D
	LDAX	D
	MOV	M,A
OPENX1:	POP	H
	MVI	C,040H
	RET
;
;	READ SEQUENTIAL   DE=FCB  A=ERROR CODE
;
FUNCT04:CALL	RESELECT
	JMP	SEQDISKREAD
;
;	RETURN CURRENT DISK  HL=CURRENT DISK NUMBER
;
FUNCT05:LDA	CURDSK
	JMP	STA$RET
;
;	SET DMA ADDRESS  DE=DMA ADDRESS  
;	SET SUBSEQUENT DMA ADDRESS TO INFO
;
FUNCT06:XCHG			;WAS LHLD INFO
	SHLD	DMAAD		;DMAAD=INFO
	JMP	SETDATA		;TO DATA DMA ADDRESS
;
;	ARRIVE HERE AT END OF PROCESSING TO RETURN TO USER
;
GOBACK:	LDA	SAVEC
	CPI	00FH
	JC	RETMON		;RESELECTION MAY HAVE TAKEN PLACE
	LDA	ZERO4
	STA	CURDSK 
	LDA	FCBDSK
	ORA	A
	JZ	RETMON		;RESTORE DISK NUMBER
	LHLD	INFO
	MVI	M,000H		;FCB(0)=0
	LDA	OLDDSK
	ORA	A
	JZ	GOBACK1
	MOV	M,A		;FCB(0)=FCBDSK
GOBACK1:INX	H
	LDA	MODNUM
	ORA	M
	MOV	M,A
	CALL	GETFCBB
	LDA	RECCNT
	ORA	M
	MOV	M,A
;
;	RETURN FROM THE DISK MONITOR
;
RETMON:	LHLD	ENTSP		;GET OLD STACK POINTER
	SPHL			;RESTORE THE STACK
	LHLD	ARET
	MOV	A,L
	MOV	B,H		;BA=HL=ARET
	RET
;
RECORDOK1:
	MVI	A,001H
	CALL	RECORDOK2
	JMP	SETFCB
;
READDIR4:
	LHLD	ALLOCA
	JMP	READDIR5

RECORDOK2:
	LHLD	ZERO5
READDIR5:
	PUSH	PSW
	LDA	ZERO2
	MOV	B,A
	CMA
	MOV	C,A
	LDA	ARECORD
	MOV	E,A
	ANA	B
	STA	SOMREC 
	MOV	A,E
	ANA	C
	STA	ARECORD 
	SHLD	RECADR
	CALL	RDDIR2
	SHLD	DMAADDR
	LHLD	RECADR
	LXI	D,SELSTR
	MVI	C,004H
	POP	PSW
	PUSH	PSW
	CPI	004H
	JNC	RECOK2
	CALL	RECOK8	
	JZ	RECOK3
	XRA	A
RECOK2:	
	LXI	D,00004H
	LHLD	RECADR
	DAD	D
	MVI	A,002H
	CALL	RECOK7
	LHLD	RECADR
	LXI	D,SELSTR
	MVI	C,004H
	CALL	MOVE
	MVI	M,000H
RECOK3:	LDA	SOMREC
	INR	A
	LXI	D,TBUFF
	LXI	H,0FF80H
RECOK4:	DAD	D
	DCR	A
	JNZ	RECOK4
	XCHG
	LHLD	DMAADDR
	DAD	D
	POP	PSW
	CPI	003H
	JNZ	BNKMOV
	SHLD	BUFFA
	RET
;
BNKMOV:	XCHG
	LHLD	DMAAD
	LXI	B,TBUFF
	JMP	@MOV		;MOVE BETWEEN BANKS
;
RECOK7:	PUSH	PSW
	CALL	SEEK
	POP	PSW
	DCR	A
	CP	RDBUFF
	LXI	D,00004H
	LHLD	RECADR
	DAD	D
	INX	H
	INX	H
	LXI	D,TRACK
	MVI	C,004H
	JMP	MOVE
;
;	STORAGE LOCATIONS AND MESSAGES
;
COMPCOL:DB	000H

MSBDOS:	DB	00DH,00AH
	DB	'BDOS ERR: $'

MSSLCT:	DB	'Select$'

MSPERM:	DB	'Perm.$'

ARET:	DW	0000H

;
FCBT:	DB	000H
	DB	'CPM3    SYS'
	DB	0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0
;
MSOPEN:	DB	00DH,00AH
	DB	'CPMLDR error:  failed to open CPM3.SYS'
	DB	00DH,00AH
	DB	'$' 
;
MSREAD:	DB	00DH,00AH
	DB	'CPMLDR error:  failed to read CPM3.SYS'
	DB	00DH,00AH
	DB	'$' 
;
MSBANR:	DB	00DH
	DB	00AH,00AH,00AH,00AH,00AH,00AH
	DB	00AH,00AH,00AH,00AH,00AH,00AH
	DB	00AH,00AH,00AH,00AH,00AH,00AH
	DB	00AH,00AH,00AH,00AH,00AH,00AH
	DB	'CP/M V3.0 Loader'
	DB	00DH,00AH
	DB	'Copyright (C) 1982, Digital Research'
	DB	00DH,00AH
	DB	'$' 
	DB	'021182'
	DB	0,0,0,0
STACK1:				;STACK WALKS OVER THE BANNER
;
HEDR1:	DB	000H		

HEDR2:	DB	000H

HEDR3:	DB	000H

HEDR4:	DB	000H

HEDR5:	DB	0,0,0,0,0,0,0,0

ENTSP:	DB	0,0

DLOG:	DW	0000H

DMAADDR:DW	0000H

BUFFA:	DW	0000H

	DW	0000H

CURTRKA:DW	0000H

CURRECA:DW	0000H

BUFFB:	DW	0000H

	DW	0000H

	DW	0000H

ALLOCA:	DW	0000H

ZERO5:	DB	0,0,0,0,0

SECTPT:	DW	0000H

BLKSHF:	DB	000H

BLKMSK:	DB	000H

EXTMSK:	DB	000H

MAXALL:	DW	0000H

DIRMAX:	DW	0000H

OFFSET:	DW	0000H

ZERO1:	DB	000H

ZERO2:	DB	000H

MSKVREC:DB	000H

ZERO3:	DB	000H

TRANV:	DW	0000H

LINFO:	DB	000H

DMPOS:	DB	000H

RECCNT:	DB	000H

SINGLE:	DB	000H

ZERO4:	DB	000H

RCOUNT:	DB	000H

EXTVAL:	DB	000H

VRECORD:DB	000H

SELSTR:	DB	0FFH

ARECORD:DW	0000H

SHIFTED:DB	000H

SHAREC:	DW	0000H

MODNUM:	DB	000H

DPTR:	DB	000H

OLDDSK:	DB	000H

SOMREC:	DB	000H

RECADR:	DW	0000H

TRACK:	DW	0000H

SAVSEC:	DW	0000H

COLUMN:	DB	000H		;COLUMN NUMBER

DOLLAR:	DB	024H		;$

DMAAD:	DB	080H,000H	;DMA ADDRESS

CURDSK:	DB	000H		;CURRENT DISK

INFO:	DW	0000H		;MESSAGE LOCATION

FCBDSK:	DB	000H

SAVEC:	DB	000H

DCNT:	DW	0000H

SEARCHA:DW	0000H

SEARCHL:DB	000H

;
	DS	80
LSTACK:
;
	DS	134D		;F1LL OUT TO THE END OF THE BLOCK
;
	END