;************* THIS IS FILE NSCPM48.ASM ****************
;
;THIS PROGRAM IS THE INTERFACE FROM NORTHSTAR
;BASIC (SPECIAL VERSION AT 800H) RELEASE 4
;TO CPM V1.4, V2.0, AND CDOS V1.07.  11/20/78
;
;	REV 1   4/8/79   GOT IT TO WORK WITH MINOR LIMITATIONS
;	REV 2   4/14/79	 -CREATE FULLY IMPLEMENTED WITH BLOCK SIZE
;			 -FIXED DIRECTORY LIST BUG
;			 -WILL CLOSE UP TO 8 OPEN FILES VERSUS 4 (BUG)
;			 -ADDED PUNCH DEVICE AS DEV #2 IN BASIC
;	REV 3	5/10/79	 -MODIFIED CREATE ROUTINE TO NOT CAUSE BDOS
;			  ERROR WHEN CREATING A FILE WHOSE SIZE IS
;			  LARGER THAN CPM
;			 -RETURN DISK NUMBER WHEN DIRECTORY ENTRY NOT FOUND (BUG)
;			 -DISK/DIRECTORY FULL MESSAGE ON CONSOLE WHEN CREATING
;			  SINCE NS BASIC WON'T ERROR WITH THIS INTERFACE.
;			  JUMP TO WARM BOOT AFTER MESSAGE DISPLAYED.
;			 -ADD VERIFY AFTER WRITE & ERROR MESSAGE JUMP TO JUMP
;			  TABLE SINCE BASIC INSERTS A JUMP ADDRESS AT INIT
;			 -INIT TO JUMP TO WBOOT SINCE BASIC MODIFIES ANYWAY
;	REV 4	5/28/79  -FIXED MEMSET TO ERROR IF SET IN CPM AREA
;			 -ZEROES OUT A REG IN FCB0 ROUTINE (BUG)
;			 -PATCHES BASIC TO REMOVE LIMIT ON 350 BLOCK SIZE
;			 -AUTO PATCH OF LINE LENGTH=132
;			 -AUTO PATCH OF DELETE ECHO CHAR TO BACKSPACE (CTL-H)
;	REV 5	6/10/79	 -MODIFIED SRCHMOR SUBROUTINE FOR CDOS COMPATIBLITY.
;			  DOES NOT AFFECT REV 4.
;			 -REVISED COMMENTS ON CDOS PATCH AND COMPATIBILITY
;	REV 6	9/27/79  -ADDED VARIABLES TO ALLOW CHANGE IN STARTING MEMORY
;			  ADDRESS FROM STD CPM TO TRS80 CPM
;	REV 7	10/29/79 -CORRECTED CLOSE WHEN WRITING A TYPE 3 BLOCK.
;			 -RESTORED NEXT RECORD WHEN CROSSING EXTENTS FOR CDOS.
;			 -CORRECTED TYPO FOR ONE OF THE CDOS PATCHES.
;	REV 8	11/20/79 -MADE INTERFACE COMPATIBLE WITH CPM V2.0.
;			 -INCREASED MAXIMUM FILE SIZE TO 4096 256-BYTE BLOCKS
;			  FOR 8" QUAD DENSITY. (1 MEGABYTE FILE SIZE)
;			 -PUT . IN FRONT OF FILE TYPE WHEN CATALOGING.
;
;	REV 9	07/04/82 -CHANGED REV 8 TO WORK WITH NORTH STAR BASIC
;			  REL. 5.2. ALSO CHANGED ENTRY POINTS TO WORK
;			  LIKE 5.2 DOS.                         -SFK-
;THIS INTERFACE WILL WORK WITH CPM OR ANY OF ITS
;DERIVATIVES, E.G., IMDOS, CDOS (V1.07 OR LATER), ETC
;
;NOTE:	CDOS V1.07 MUST BE PATCHED IN 4 PLACES; THIS IS INDICATED BY THE [[ ]]
;	IN THE REMARKS.
;
;
;	*****************************************
;	*					*
;	* YOU MUST MOVE BASIC TO JUST ABOVE THIS*
;	* INTERFACE.  USE THE BASIC MOVER IN	*
;	* THE NORTHSTAR USERS GROUP (REL 4)	*
;	*					*
;	* BASIC MOVER PARAMETERS: STD	TRS80	*
;	*					*
;	*	BASIC START ADDR: 800	4A00	*
;	*	ROM ADDRESS:	 E800	E800	*
;	*	DOS START ADDR:    F6	42F6	*
;	*	END OF MEMORY ADDR: XXXX	*
;	*		X=DON'T CARE		*
;	*****************************************
;
;****************************************************************************
;
;	RELEASE 4 INCOMPATIBILITIES (THRU REV 4):
;
;		1. RND(-1) WILL NOT GENERATE RANDOM NUMBERS
;
;	SOFTWARE NOTES:
;
;		1. STORAGE ALLOWED FOR ONLY 10 OPEN FILES
;		2. DO NOT HAVE FILES WITH THE SAME NAME WITH A SINGLE
;			CHARACTER TYPE.  IF MORE THAN ONE, FUNCTIONS WILL
;			OPERATE ON 1ST ENTRY FOUND IN DIRECTORY
;			(EXCLUDING SAVE, NSAVE, LOAD, APPEND)
;		3. WHEN CREATING A FILE AND THE DISK OR DIRECTORY IS FULL,
;			THE MESSAGE 'DISK/DIR FULL' IS DISPLAYED ON THE CONSOLE
;			NOT THE NORTH STAR ERROR MESSAGE.  THIS INTERFACE
;			IMPLEMENTATION DOES NOT ALLOW ERROR TRAPPING OF DISK
;			FULL WHEN CREATING.  IT DOES NOT STOP EITHER.
;			JUMPS TO WARM BOOT AFTER PRINTING MESSAGE.
;		4. WILL NOT ALLOW MEMSET INTO CPM AREA.  GIVES ARGUMENT ERROR
;			IF ATTEMPTED.  WHEN BASIC IS BOOTED, MEMSET AT 809H IS
;			AUTOMATICALLY SET TO THE MAX RAM UP TO BDOS-1 IN CPM.
;
;
;***************************************************************************
;
;----------------------------------------------------
;FCB AND NORTHSTAR DISK PARAMETERS FORMAT
;
;  FIELD	POSITION	DESCRIPTION
;
;    ET		    0		ENTRY TYPE
;    FN		   1-8		FILE NAME
;    FT		   9-11		FILE TYPE
;    EX             12		FILE EXTENT (0-15)
;		  13-14		NOT USED
;    RC		    15		RECORD COUNT (0-128)
;    DM		  16-31		DISK MAP (16 1K BLKS)
;    NR		    32		NEXT RECORD
;    DA		  33-34		NS DISK ADDRESS
;    BL		  35-36		NUMBER OF 256-BYTE BLOCKS
;    TY		    37		NS FILE TYPE
;    PB		    38		NO. OF BASIC PROGRAM BLKS
;		  39-40		FILE PARAMETERS, NOT USED
;    DN		    41		DRIVE NUMBER FILE IS ON
;-------------------------------------------------------
;
;******CONDITIONAL ASSEMBLIES ******
;
TRUE	EQU	-1
FALSE	EQU	NOT TRUE
;
;
;***** EQUATES *****
;
ADDRZ	EQU	0		;FIRST ADDRESS OF MEMORY
				;(STD CPM=0; TRS80 CPM=4200H)
IFBASE	EQU	ADDRZ+100H
BASIC	EQU	IFBASE+0D00H
WBOOT	EQU	ADDRZ
BDOS	EQU	ADDRZ+5
;
;*** CPM SYSTEM CALL EQUATES ***
;
PRINT	EQU	9
SEARCH	EQU	17
NEXT	EQU	18
;
;*** BIOS JUMP TABLE RELATIVE ADDRESSES (RELATIVE TO WARM BOOT @ ADDR 6,7) ***
;
CONST	EQU	3
CONIN	EQU	6
CONOT	EQU	9
LIST	EQU	0CH
PUNCH	EQU	0FH
;
CTLC	EQU	3
CTLS	EQU	13H		;FREEZE SCREEN KEY
;
PRNTNO	EQU	1		;NS DEVICE NUMBER FOR PRINTER; CALLS CPM LIST
PNCHNO	EQU	2		;NS DEVICE NUMBER FOR PUNCH
;
NOFCBS	EQU	10
FCBSIZ	EQU	42		;NO. OF BYTES IN EXTENDED FCB
CR	EQU	0DH
LF	EQU	0AH
ERRMSG	EQU	0		;DUMMY ADDRESS
ARGERR	EQU	BASIC+1A0H	;ENTRY POINT TO BASIC FOR 'ARGUMENT ERROR'
;
;*** NORTH STAR BASIC PARAMETERS ***
;
MEMEND	EQU	9		;BASIC OFFSET FOR END OF MEMORY
PGMPTR	EQU	BASIC+2DF3H	;NS BASIC PROGRAM POINTER
;
;*** THE FOLLOWING EQUATES ARE FOR DETERMINING WHICH DISK FUNCTION IS
;	CALLING DLOOK.  THEY ARE THE LEAST SIGNIFICANT ADDRESS BYTE FOR EACH
;	FUNCTION. ***
;
TY3ADR	EQU	83H		;OPEN TYPE 3 FILE
LDADR	EQU	0B4H		;LOAD OR APPEND
DESADR	EQU	79H		;DESTROY
FLADR	EQU	0FBH		;FILE
CRADR	EQU	45H		;CREATE
NSADR	EQU	2		;NSAVE
NSCR2	EQU	88H		;NSAVE OR CREATE FOR THE 2ND TIME
SAVADR	EQU	0CCH		;SAVE
;
;**************************************************************************
;
;**** PATCHES TO BASIC MEMSET ROUTINE ****
;
	ORG	BASIC+52AH
;
	XCHG			;PUT MEMSET ADDR IN DE
	LHLD	BDOS+1		;GET BEGINNING OF CPM ADDR
	JMP	MEMSET
MEMSETR	EQU	$		;PATCH IN INTERFACE JUMPS TO HERE
;
;**** PATCH BASIC TO REMOVE 350 BLOCK SIZE LIMIT ****
;
	ORG	BASIC+665H
;
	LXI	H,-4096 	;SHOULD SUFFICE FOR 8" QD
;
;**** PATCH BASIC TO ECHO BACKSPACE (CTL-H) ON DELETE ****
;
	ORG	BASIC+17H
;
	DB	8
;
;**** PATCH BASIC TO LINE LENGTH=132 ****
;
	ORG	BASIC+0EH
;
	DB	80
;
;
;***************************************************************************
;
	ORG	IFBASE
;
;**** JUMP TABLE; MATCHES NORTHSTAR DOS ****
;
	JMP	BSINIT
;
	ORG	IFBASE+0DH
;
	JMP	COUT		;BEGINNING OF EQUIV NS DOS JUMP TABLE
	JMP	CIN
	JMP	INIT
	JMP	CONTC
	JMP	ERRMSG		;BASIC ERROR MESSAGE; BASIC CHANGES AT INIT
	JMP	DLOOK
	JMP	DWRIT
	JMP	DCOM
	JMP	DLIST
	JMP	WBOOT
RWCHK:	DB	0		;VERIFY; PUT HERE FOR TABLE INTEGRITY
	JMP	ERRMSG		;BASIC ERROR MESSAGE; BASIC CHANGES AT INIT
DEN:	DB	0		;FAKE SINGLE DENSITY
GOTYPE:	DB	1		;GO TYPE (DUMMY)
BUFPT:	DW	0		;KEYBUFFER PTR (DUMMY)
DCRSZ:	DB	24		;SCREEN SIZE (DUMMY)
CONFG:	DB	0		;DRIVE CONFIG BYTE
;
;
;**** CHECK FOR MEMSET ****
;
MEMSET:	DCX	H		;ONE LESS
	XRA	A		;CLEAR CARRY
	MOV	A,L
	SBB	E		;MEMSET ADDR-MAX CPM MEM ADDR
	MOV	A,H
	SBB	D
	XCHG			;HL=MEMSET ADDR
	JC	ARGERR		;JUMP TO BASIC'S ARGUMENT ERROR
	JMP	MEMSETR
;
;**** SET UP BASIC END OF MEMORY ****
;
BSINIT:	LHLD	BDOS+1
	DCX	H		;ONE LESS
	SHLD	BASIC+MEMEND
	JMP	BASIC
;
;**** CONSOLE OUT INTERFACE ****
;
COUT:	PUSH	B
	PUSH	D
	PUSH	H
	ORA	A		;A=0 FOR CONSOLE?
	CZ	CONIT
	CPI	PRNTNO		;SHALL WE SEND TO LIST DEVICE?
	CZ	LISTIT
	CPI	PNCHNO		;PUNCH DEVICE NUMBER?
	CZ	PNCHIT
	CPI	PNCHNO+1
	CNC	CONIT		;DEFAULT TO CONSOLE FOR ALL OTHER DEVICES
	MOV	C,B
	CALL	CBIOS
	POP	H
	POP	D
	POP	B
	MOV	A,B
	RET
;
CONIT:	MVI	E,CONOT		;CONSOLE OUT FOR DEV #0
	RET
LISTIT:	MVI	E,LIST
	RET
PNCHIT:	MVI	E,PUNCH
	RET
;
;**** CONSOLE IN INTERFACE ****
;
CIN:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	E,CONIN		;CONSOLE IN FOR ALL DEV #'S
	CALL	CBIOS
	POP	H
	POP	D
	POP	B
	RET
;
;**** CONTROL-C INTERFACE ****
;
CONTC:	MVI	E,CONST
	CALL	CBIOS
	CPI	0FFH
	RNZ
	MVI	E,CONIN
	CALL	CBIOS
	CPI	CTLS		;FREEZE THE SCREEN?
	CZ	CIN
	CPI	CTLC
	RET	
;
CBIOS:	MVI	D,0
CBIOS2:	LHLD	WBOOT+1
	DAD	D
	PCHL
;
;**** INITIALIZATION INTERFACE ****
;
INIT:	RET
;
;
;**** DIRECTORY LOOK UP INTERFACE ****
;
;	INPUT:  A=DISK NO.  HL=NAME IN RAM
;	OUTPUT: A=DISK NO.
;		CARRY=1 IF FAILURE & HL=1ST FREE DISK ADDR
;		CARRY=0 IF SUCCESS & HL=8TH BYTE OF DOS ENTRY IN RAM
;
DLOOK:	STA	DISKNO		;SAVE DR#
	POP	D		;GET RETURN ADDRESS
	PUSH	D		;SAVE IT FOR LATER
	MVI	A,NSCR2		;2ND NSAVE OR CREATE?
	CMP	E
	JZ	FOOLIT		;FOOLIT; SAY OK
	PUSH	H		;SAVE NS NAME PTR
	XRA	A
	STA	EXTENT		;ZERO EXTENT
	CALL	FCB0		;ZERO FCB AREA
	POP	H		;RESTORE NS NAME PTR
	MVI	A,80H		;FOOL NS BASIC; MAX PGM SIZE=32K
	STA	NSPARMS+5	;SAVE IT
	LXI	D,FCB+1		;POINT TO NAME LOC
	MVI	B,8		;NAME CHARS
NEXTC:	MOV	A,M
	CPI	0DH		;PUT IN SPACES IF CR
	JZ 	SPACES
	CPI	' '
	JZ 	SPACES	
	CPI	','
	JZ	DRVNO
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	NEXTC
	MOV	A,M
	CPI	','
	JNZ	SEL
DRVNO:	INX	H
	MOV	A,M
	CPI	'4'		;IF DRIVE #>=4 THEN ERROR
	JNC	ERROR
	CPI	'1'		;IF DRIVE #<0 THEN ERROR
	JC	ERROR
	ANI	3
	STA	DISKNO
	XRA	A
	CMP	B
	JZ	SEL
SPACES:	MVI	A,20H
	STAX	D
	INX	D
	DCR	B
	JNZ	SPACES		;ENOUGH SPACES?
SEL:	CALL	SELECT		;SET UP DEFAULT BUFFER @ 80H
	CALL	SETBUF0
OPEN:	MVI	A,'?'		;AMBIGUOUS FILE TYPE
	STA	FCB+9		;SAVE IN FCB
	LXI	H,2020H		;BLANKS FOR NO AMBUGUITY
	SHLD	FCB+10
	POP	H		;GET RETURN ADR
	PUSH	H		;SAVE IT AGAIN
	MOV	A,L
	CPI	TY3ADR		;OPEN TYPE<>2 CALLING?
	JZ	OPEN3
	CPI	CRADR		;CREATE CALLING?
	JZ	OPEN0
	CPI	FLADR		;FILE CALLING?
	JZ	OPEN0
	CPI	DESADR		;DESTROY CALLING?
	JZ	OPEN0
	MVI	A,2		;TYPE 2 ONLY FOR SAVE, NSAVE, LOAD, APPEND
	STA	FILTYP
	ADI	30H
	STA	FCB+9		;REMOVE AMBIGUITY
	XRA	A
	STA	OLD1
	LXI	H,FCBBAS
	LXI	B,NOFCBS*FCBSIZ	;ZERO TYPE 3 FCBS
	CALL	MOVEIT	
	JMP	OPEN0
OPEN3:	MVI	A,3		;SAVE TYPE=3 FOR OPEN
	STA	FILTYP
	CALL	SETTYP3		;SET UP FCB FOR TYPE <>2 OPEN
OPEN0:	CALL	OPENIT		;OPEN FILE; FIND THE SAME
	CPI	0FFH		;CHECK FOR NO ENTRY
	JZ	WRTYP2		;TEST FOR SAVE BEFORE ERROR
	MVI	C,17		;GET FIRST DIRECTORY ENTRY
	CALL	READ2
	LXI	H,ADDRZ+80H+9	;[[[[ LXI D,9 ]]]]
				;GET FILE TYPE FROM DIRECTORY (1ST ONE FOUND)
	CALL	DIRENT		;[[[[ DAD D   NOP   NOP ]]]]
	MOV	A,M
	LXI	D,9		;REMOVE AMBIGUITY; SAVE TYPE IN DIR
	CALL	ADD16
	SUI	30H
	LXI	D,37		;SAVE TYPE IN NS PARMS
	CALL	ADD16
	POP	H		;GET RETURN ADDR
	PUSH	H
	MOV	A,L
	CPI	DESADR		;DESTROY?
	JZ	DESTROY
	CPI	TY3ADR		;OPEN TYPE <>2?
	JNZ	FOOLIT		;FOR SAVE, FILE, LOAD, APPEND, CREATE, NSAVE
BLKS:	LHLD	CURFCB		;HL=PTR TO CURRENT FCB
	LXI	D,15		;MOVE PTR TO REC CNT IN FCB
	DAD	D
	MOV	A,M		;GET REC CNT IN FCB
	STA	RECCNT		;SAVE IT
	CPI	80H		;REC CNT = 128 BLKS?
	CZ	SRCHMOR		;FIND ALL EXTENTS IF IT IS
	LDA	EXTENT		;GET CURRENT EXTENT
	MVI	H,0		;COMPUTE EQUIV NS BLKS; * 64
	MOV	L,A
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H		;HL=# EXTENTS * # 256 BLKS PER EXTENT
	LDA	RECCNT		;GET REC CNT
	RAR			;DIVIDE BY 2
	JNC	BLKS1
	INR	A		;ROUND UP
BLKS1:	ANI	7FH
	MOV	E,A		;DE=# 256 REC COUNT
	XRA	A
	MOV	D,A		;D=0
	DAD	D		;HL=ALLOCATED NS BLKS=(#EXT*256BLKS/EXT)+#256 REC CNT IN LAST EXT
	PUSH	H		;SAVE IT
BLKS2:	LXI	D,36
	LHLD	CURFCB
	DAD	D		;PTR TO NS BLKS IN FCB
	POP	D		;DE=ALLOCATED NS BLKS
	MOV	M,D		;SAVE BLKS IN FCB
	DCX	H		;MOVE PTR BACK
	MOV	M,E
	DCX	H		;MOVE PTR TO NS PARAMETERS IN FCB
	DCX	H
BLKS3:	LDA	DISKNO		;A=CURRENT DISK NO.
	ORA	A		;ZERO CARRY FOR NS RETURN
	RET
;
;**** INTERFACE TO NORTHSTAR DCOM ROUTINES ****
;
;	INPUT:  A=NO OF BLOCKS  B=COMMAND (0=WR, 1=RD, 2=VERIFY)
;		C=DISK NO.	DE=STARTING RAM ADDRESS
;		HL=STARTING DISK ADDRESS
;	OUTPUT: CARRY=1 MEANS ARGUMENTS ILLEGAL
;
DCOM:	STA	BLKCNT		;SAVE # BLKS
	SHLD	DISKADR		;SAVE NS DISK ADR
	LXI	H,-80H
	DAD	D
	SHLD	BUFADR		;SAVE BUFFER ADR-128
	MOV	A,B
	STA	WR		;SAVE WRITE OR READ
	MOV	A,C
	ANI	7FH		;SCRAP DENSITY FLAG
	STA	DISKNO		;SAVE DR#
SEL1:	CALL	SELECT
	LDA	FILTYP
	CPI	2		;SKIP OFFSET CALC, IF TYPE 2
	JZ	WRRD
RECNUM:	CALL	FNDFCB
	LXI	D,33
	DAD	D		;HL=PTR TO NS BASE DISK ADR
	MOV	E,M
	INX	H
	MOV	D,M		;DE=BASE DISK ADR
	LHLD	DISKADR		;HL=CURRENT, DE=BASE
	MOV	A,L		;CURRENT-BASE
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A		;HL=ADDR OFFSET
	DAD	H		;* 2
	MOV	A,L
	ANI	7FH		;A=# 128 BYTE BLKS
	DAD	H		;H=EXTENT
	MOV	B,H		;TEMP STORE; B=EXTENT
	CALL	ADD16X		;PT TO NEXT REC & SAVE IT IN NEXT RECORD
	STA	DEVNXT		;SAVE NEXT REC FOR LATER
	LXI	D,-20		;EXTENT ADDR WRT PTR
	DAD	D		;PTR TO EXTENT IN FCB
	MOV	A,B		;A=EXT #
	STA	EXTENT		;SAVE IT
	CMP	M		;SAME ONE?
	CNZ	CLSOPN		;IF NOT CALL CLOSE/OPEN SUBR
WRRD:	LDA	WR
	ORA	A
	JZ	WRITE
	CPI	1
	JNZ	ERROR1
READ:	LDA	BLKCNT
	ORA	A
	RZ			;CY=0 FOR BASIC RETURN
	DCR	A
	STA	BLKCNT
	CALL	SETBUF		;GET 1ST 128-BYTE BLK
	CALL	READIT
	CALL	EOF
	CALL	SETBUF		;GET 2ND 128-BYTE BLK
	CALL	READIT		;TO EQUAL 1 256-BYTE BLK
	CALL	EOF
	JMP	READ
;
WRITE:	LHLD	BLKCNT		;GET BLOCK COUNT
	XRA	A		;CHECK FOR LAST ONE
	CMP	L
	JNZ	WRITE1
	CMP	H
	JZ	CLOSE
WRITE1:	DCX	H
	SHLD	BLKCNT		;SAVE FOR NEXT TIME
	CALL	SETBUF
	CALL	WRITEIT
	CALL	SETBUF
	CALL	WRITEIT
	JMP	WRITE
;
;****DESTROY A FILE ****
;
DESTROY:CALL	DELIT
	JMP	BLKS3
;
FOOLIT:	LXI	H,80H		;FOOL NSBASIC; MAX PROGRAM SIZE=32K
	PUSH	H		;SAVE IT BLKS2
	JMP	BLKS2
;
WRTYP2:	POP	H		;GET RETURN ADDR
	PUSH	H		;SAVE IT FOR RETURN
	MOV	A,L		;CHECK FOR LSA MATCH
	CPI	CRADR		;CREATE
	CZ	CRFLAG		;SET CREATE FLAG
	CPI	NSADR		;NSAVE
	MVI	A,2		;ALWAYS NSAVE TYPE 2
	CZ	NSAVE
ERROR:	LXI	H,0		;FOOL NS BASIC; NEXT DISK ADDR=0
	LDA	DISKNO		;DISK NUMBER FOR ERROR RETURN
ERROR1:	STC			;CY=1 FOR FILE NOT FOUND ERROR
	RET	
;
NSAVE:	STA	NSPARMS+4	;SAVE FILE TYPE IN NS DIRECTORY
CRNSAV:	ADI	30H		;CONVERT TO ASCII FOR CPM
	STA	FCB+9		;SAVE IN FCB
	CALL	DELIT		;DELETE, MAKE, THEN OPEN FOR NSAVE & CREATE
MAKEIT:	CALL	SETBUF0
	MVI	C,22
	CALL	READ2
	CPI	255		;JUMP IF DIRECTORY FULL
	JZ	DSKFUL
OPENIT:	CALL	SETBUF0
	MVI	C,15
	JMP	READ2
;
CRFLAG:	MVI	A,1
	STA	FUNFL		;SET UP DWRIT FUNCTION FLAG
	RET
;
;**** INTERFACE TO DIRECTORY LIST ROUTINE ****
;	INPUT:   A=DISK NUMBER      L=DEVICE NUMBER
;
DLIST:	PUSH	H
	STA	DISKNO
	CALL	SELECT
	POP	H
	MOV	A,L
	STA	DEVNXT
	CALL	RESET
	CALL	SETBUF0
	CALL	FCB0		;ZERO FCB AREA
	LXI	H,FCB		;NAME & TYPE = AMBIGUOUS (??????)
	MVI	B,11		;NUMBER OF CHARS IN NAME & TYPE
	MVI	A,'?'
DLIST0:	INX	H
	MOV	M,A
	DCR	B
	JNZ	DLIST0
	CALL	CRLF		;PRINT CR AND LF
	MVI	C,SEARCH	;FIND FIRST ENTRY
	CALL	DNEXT0
	CALL	DIRNT		;[[[[ NOP   NOP   NOP ]]]
				;WHICH ONE OF 4; POINT TO IT IN BUFFER
	CALL	PRNTIT		;PRINT OUT DIRECTORY ENTRY
DLIST1:	CALL	DNEXT		;GET ALL OTHERS
	CALL	DIRNT		;[[[[ NOP   NOP   NOP ]]]]
				;WHICH ONE OF 4; POINT TO IT IN BUFFER
	CALL	PRNTIT		;PRINT OUT
	JMP	DLIST1		;GET MORE
;
PRNTIT:	LXI	D,12		;PT TO FILE EXTENT
	DAD	D
	XRA	A
	CMP	M
	RNZ			;DON'T PRINT EXTENTS >0
	LDA	DISKNO		;PRINT DRIVE NUMBER
	ADI	40H		;CONVERT TO A,B,C,D,ETC
	MOV	B,A
	CALL	DPRNT
	MVI	B,':'
	CALL	DPRNT
	LXI	B,-12		;MOVE POINTER BACK TO BEGINNING
	DAD	B
	MVI	D,8		;PRINT NAME
	CALL	DLIST3
	MVI	B,'.'		;PRINT . BEFORE TYPE
	CALL	DPRNT
	MVI	D,3		;PRINT TYPE
	CALL	DLIST3
	MVI	C,6
SPCIT:	CALL	DPRNT0		;PRINT 6 SPACES
	DCR	C
	JNZ	SPCIT
	LDA	ACROSS
	DCR	A		;PRINT 3 ACROSS?
	STA	ACROSS
	CZ	CRLF		;START NEW LINE
	RET
;
DNEXT:	MVI	C,NEXT
DNEXT0:	LXI	D,FCB
	CALL	BDOS
	CPI	0FFH
	RNZ
	CALL	CRLF		;MAKE DISPLAY PRETTY
	POP	H		;CLEAR OUT STACK
	RET			;EXIT DIRECTORY LIST ROUTINE
;
DLIST3:	INX	H		;PRINT NO. OF BYTES SPECIFIED IN D
	MOV	B,M
	CALL	DPRNT
	DCR	D
	JNZ	DLIST3
	RET;
;
CRLF:	MVI	B,CR		;PRINT CR & LF
	CALL	DPRNT
	MVI	B,LF
	CALL	DPRNT
RESET:	MVI	A,3
	STA	ACROSS		;RESET NUMBER ACROSS SCREEN
	RET
;
DPRNT0:	MVI	B,' '		;PRINT SPACE
DPRNT:	LDA	DEVNXT		;PRINT ON SELECTED DEVICE
	JMP	COUT
;
;
;***** SELECT A DRIVE *****
;
SELECT:	LDA	DISKNO
	DCR	A
	MVI	C,14
	MOV	E,A
	JMP	BDOS
;
;*** FIND AN EXISTING TYPE 3 FCB IF POSSIBLE ***
;
SETTYP3:MVI	B,NOFCBS	;B=# OPEN TYPE 3 FILES
	LXI	H,FCBBAS	;HL=FCBBAS
RT0:	SHLD	CURFCB		;SAVE IT IN CURRENT FCB
	PUSH	H		;SAVE IT FOR LATER
	MVI	C,8		;8 CHARS IN FILE NAME
	LXI	D,FCB		;SET UP FCB FOR COMPARISON
RT1:	INX	D		;MOVE PTR TO 1ST CHAR IN NAME
	INX	H		;DITTO
	LDAX	D		;FILE NAME MATCH (8 CHARS) & DRIVE #
	CMP	M
	JNZ	NXTBLK
	DCR	C
	JNZ	RT1
	LXI	D,33		;PTR OFFSET TO DRIVE # IN FCB
	DAD	D		;MOVE PTR TO DRIVE #
	LDA	DISKNO		;GET CURRENT DRIVE #
	CMP	M		;SAME ONE?
	JNZ	NXTBLK		;MOVE ON IF NOT
	LXI	D,-29		;PT TO FCB EXTENT
	DAD	D
	XRA	A
	MOV	M,A		;ZERO OUT EXTENT IN FCB BEFORE OPENING
	POP	B		;CLEAR OUT STACK
	RET

NXTBLK:	POP	H
	LXI	D,FCBSIZ
	DAD	D
	DCR	B
	JNZ	RT0
NEW1:	LDA	OLD1		;NO MATCH; MAKE NEW ONE
	CPI	NOFCBS		;NO MORE FCB SPACE?
	CZ	FCBTOP
	INR	A
	STA	OLD1
	LXI	D,FCBSIZ
	LXI	H,FCBBAS-FCBSIZ
NXTBLK1:DAD	D		;SET UP PTR IN HL
	DCR	A		;MOVE FCBBAS UNTIL END FOUND
	JNZ	NXTBLK1
	SHLD	CURFCB
	MVI	B,FCBSIZ
	LXI	D,FCB		;MOVE FCB TO FCB AREA
MOVIT:	LDAX	D
	MOV	M,A
	INX	H
	INX	D
	DCR	B
	JNZ	MOVIT
	LDA	OLD1
	DCR	A
	RLC			;4K INCREMENTS
	RLC
	RLC
	RLC
	LXI	D,34
	CALL	ADD16		;ADD OFFSET FOR NS HI ORDER ADDR
	LXI	D,7		;PTR OFFSET TO DR # IN FCB
	DAD	D		;MOVE PTR
	LDA	DISKNO		;GET CURRENT DR #
	MOV	M,A		;SAVE IT IN FCB
	RET
;
FCBTOP:	XRA	A
	RET
;
;*** SEARCH FOR ALL EXTENTS ***
;
SRCHMOR:LHLD	CURFCB		;SEARCH FOR ALL EXTENTS
	LXI	D,12		;PT TO EXTENT
	DAD	D
	MVI	C,18		;SEARCH FOR NEXT DIR ENTRY
SRCH0:	PUSH	H		;SAVE PTR TO EXTENT
	LDA	EXTENT		;GET EXTENT
	INR	A		;A=EXT+1
	MOV	M,A		;NEW EXT=EXT+1
	CALL	READ2
	LXI	H,ADDRZ+80H+15	;[[[[ LXI D,0FH ]]]]
				;PT TO REC CNT IN DEFAULT FCB
	CALL	DIRENT		;[[[[ DAD D   NOP   NOP ]]]]
				;PT TO PARAMETER IN DIRECTORY
	LDA	EXTENT		;INCREMENT EXTENT
	INR	A
	STA	EXTENT		;SAVE NEW EXTENT
	MOV	A,M
	STA	RECCNT		;SAVE LAST RECORD COUNT
	CPI	80H		;IS EXTENT FULL?
	MVI	C,18		;SEARCH FOR NEXT DIR ENTRY
	POP	H
	JZ	SRCH0		;GET ANOTHER EXTENT IF IT IS
SRCH1:	XRA	A		;ZERO EXTENT IN FCB
	MOV	M,A
	RET
;
				;[[[[ SUBROUTINE NOT USED BY CDOS VERSION ]]]]
DIRNT:	LXI	H,ADDRZ+80H	;SET UP POINTER TO BUFFER
DIRENT:	ANI	3		;A=LOC OF DIR ENTRY IN BUFFER (0-3)
	RRC ! RRC ! RRC		;MULT BY 32
	ADD	L
	MOV	L,A		;HL=PTR DESIRED DIRECTORY ENTRY
	RET
;
;*** READ A TYPE 2 OR 3 BLOCK ***
;
READIT:	MVI	C,20
READ2:	LHLD	CURFCB
	XCHG
GOBDOS:	JMP	BDOS
;
;
;*** FIND AN EXISTING FCB USING NS PARAMETERS FROM BASIC ***
;
FNDFCB:	LXI	B,FCBSIZ
	LDA	DISKADR+1	;A=CURRENT HI BYTE DISK ADR
	MOV	E,A		;E=CURRENT ADR
	LXI	H,FCBBAS+34
	MOV	A,M		;A=BASE
	ADI	0FH		;16 * 256 BLKS OF 256 BYTE EACH, MAX
	CMP	E
	JNC	FNDFCB1		;IF CUR (E)<=BASE+0FH (A), THEN 0-FFF
	CALL	ADRCK
	JNC	FNDFCB1		;1000-1FFF
	CALL	ADRCK
	JNC	FNDFCB1		;2000-2FFF
	CALL	ADRCK
	JNC	FNDFCB1		;3000-3FFF
	CALL	ADRCK
	JNC	FNDFCB1		;4000-4FFF
	CALL	ADRCK
	JNC	FNDFCB1		;5000-5FFF
	CALL	ADRCK
	JNC	FNDFCB1		;6000-6FFF
	CALL	ADRCK
	JNC	FNDFCB1		;7000-7FFF
	CALL	ADRCK
	JNC	FNDFCB1		;8000-8FFF
	DAD	B		;9000-9FFF
;
FNDFCB1:LXI	D,-34
	DAD	D		;HL=PTR TO FCB IN FCB AREA
	SHLD	CURFCB
	RET
;
ADRCK:	DAD	B
	MOV	A,M
	ADI	0FH
	CMP	E
	RET
;
;*** WRITE TO DISK ***
;
WRITEIT:MVI	C,21
	CALL	READ2
	ORA	A		;WRITE IS OK IF A=0
	RZ
DSKFUL:				;IF DIRECTORY FULL, DISK FULL OR FILE
	POP	H		;EXTENSION ERROR, GIVE INVALID ARGUMENT ERROR
	STC			;CY=1 FOR BASIC ERROR RETURN
	RET
;
;*** SET UP DMA ADDRESS ***
;
SETBUF:	LDA	FUNFL		;ARE WE CREATING?
	ORA	A
	JNZ	SETBUF0		;SKIP INCREMENTING BUFFER IF WE ARE
	LHLD	BUFADR
	LXI	D,80H
	DAD	D
	SHLD	BUFADR
	XCHG
	JMP	SETBUF1
SETBUF0:LXI	D,ADDRZ+80H	;SET UP DEFAULT BUFFER
SETBUF1:MVI	C,26
	JMP	BDOS
;
;*** DIRECTORY WRITE INTERFACE ***
;	INPUT: HL=POINTER TO NS PARAMETERS
;
;	THIS ROUTINE IS ONLY USED FOR CREATE COMMAND TO GET FILE TYPE FROM
;	NORTH STAR DISK PARAMETERS AND TO RESERVE DISK SPACE FOR THE FILE.
;	A DUMMY FILE IS CREATED BY WRITING OUT WHATEVER IS IN RAM FROM ADDRZ+
;	80H TO ADDRZ+0FFH
;
DWRIT:	LDA	FUNFL		;CHECK IF CREATE; RETURN IF NOT
	ORA	A
	RZ
	XRA	A
	STA	FCB+32		;NEXT RECORD =0; CAUSED BY NS BASIC
	LHLD	NSPARMS+2	;GET BLOCK SIZE
	SHLD	BLKCNT		;SAVE IT FOR WRITING
	LDA	NSPARMS+4	;GET TYPE
	CALL	CRNSAV		;PUT TYPE IN FCB AND MAKE FILE
	CALL	WRITE		;SAVE DUMMY FILE
	JC	NOSPAC		;PRINT DISK FULL ERROR SINCE BASIC WON'T
	XRA	A
	STA	FUNFL		;FUNCTION FLAG=0
	RET
;
NOSPAC:	MVI	C,PRINT		;DISK OR DIRECTORY FULL MESSAGE ON CONSOLE
	LXI	D,EMSG
	CALL	BDOS
	JMP	WBOOT		;EXIT BASIC TO CPM AFTER ERROR MESSAGE
;
;
;*** CLOSE, OPEN, AND MAKE A DIRECTORY ENTRY ***
;
CLSOPN:	CALL	CLOSE0		;CLOSE CURRENT EXTENT
	LDA	EXTENT
	LXI	D,12
	CALL	ADD16
	CALL	OPENIT		;OPEN NEW EXTENT
	CPI	0FFH
	CZ	MAKEIT		;IF NO EXTENT,MAKE ONE
	LDA	DEVNXT		;GET NEXT REC
ADD16X:	LXI	D,32
ADD16:	LHLD	CURFCB		;MOVE PTR WRT TO OFFSET IN DE
	DAD	D
	MOV	M,A
	RET
;
;*** PROCESS END OF FILE ***
;
EOF:	CPI	1		;ALL BLKS READ?
	RC			;RETURN IF <1
	CPI	2		;GIVE INVALID ARGUMENT ERROR
	JZ	ERROR1		;IF READING UNWRITTEN RA DATA
	POP	H		;CLEAR OUT RETURN
QUIT:	ORA	A		;CY=0 FOR BASIC RETURN
	RET
;
;*** CLOSE A FILE ***
;
CLOSE:	LDA	FILTYP		;CHECK FOR TYPE 3
	CPI	3		;SPEED PROCESSING IF TYPE 3
	JNZ	CLOSE0		;OTHERWISE CLOSE EVERY TIME
	LDA	FUNFL		;CHECK IF CREATE
	ORA	A
	JNZ	CLOSE0
	LHLD	PGMPTR		;GET CURRENT PROGRAM PTR
	CALL	BLANKS		;IGNORE BLANKS
	CPI	'8'		;FILE #>=8?
	JNC	QUIT		;QUIT IF NOT LEGAL FILE #
	CPI	'0'		;FILE#<0?
	JC	QUIT		;QUIT IF NOT A LEGAL FILE #
	CALL	BLANKS		;IGNORE BLANKS
	CPI	23H		;# DELIMITER?
	JNZ	QUIT		;QUIT IF NOT
	CALL	BLANKS		;IGNORE BLANKS
	CPI	98H		;CLOSE TOKEN?
	JNZ	QUIT		;QUIT IF NOT
CLOSE0:	CALL	SETBUF0
	MVI	C,16
	CALL	READ2
	ORA	A		;CY=0 FOR BASIC RETURN
	RET
;
BLANKS:	DCX	H
	MOV	A,M
	CPI	20H		;IS IT A BLANK?
	JZ	BLANKS		;SKIP IF IT IS
	RET
;
;*** DELETE A FILE ***
;
DELIT:	CALL	SETBUF0
	MVI	C,19
	JMP	READ2
;
;*** ZERO DEFAULT FCB ***
;
FCB0:	LXI	H,FCB		;PT TO FCB
	SHLD	CURFCB		;SAVE CURRENT FILE CONTROL BLOCK
	LXI	B,FCBSIZ
	XRA	A		;A=0
MOVEIT:	MOV	M,A		;ZERO FCB
	INX	H
	DCX	B
	CMP	C
	JNZ	MOVEIT
	CMP	B
	JNZ	MOVEIT
	RET
;
;*** DISK/DIRECTORY FULL ERROR MESSAGE ***
;
EMSG:	DB	'DISK/DIR FULL',CR,LF,'$'
;
;***** BUFFER AREA *****
;
DISKNO:	DB	1
DEVNXT:	DS	1		;TEMP SAVE FOR DEV # OR NEXT REC
CURFCB:	DS	2
DISKADR:DS	2
WR:	DS	1
BLKCNT:	DW	0
BUFADR:	DS	2
RECCNT	DS	1
EXTENT:	DS	1
FUNFL:	DB	0
FILTYP:	DS	1
OLD1:	DB	0
ACROSS:	DB	3
FCB:	DS	33
NSPARMS:DS	8

FCBBAS:	DS	FCBSIZ
FCBBAS1:DS	FCBSIZ
FCBBAS2:DS	FCBSIZ
FCBBAS3:DS	FCBSIZ
FCBBAS4:DS	FCBSIZ
FCBBAS5:DS	FCBSIZ
FCBBAS6:DS	FCBSIZ
FCBBAS7:DS	FCBSIZ
FCBBAS8:DS	FCBSIZ
FCBBAS9:DS	FCBSIZ
;
	END	IFBASE
