;************* 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.
;
;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+700H
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+197H ;ENTRY POINT TO BASIC FOR 'ARGUMENT ERROR'
;
;*** NORTH STAR BASIC PARAMETERS ***
;
MEMEND EQU 9 ;BASIC OFFSET FOR END OF MEMORY
PGMPTR EQU BASIC+2BB9H ;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 42H ;OPEN TYPE 3 FILE
LDADR EQU 7CH ;LOAD OR APPEND
DESADR EQU 0C4H ;DESTROY
FLADR EQU 0F7H ;FILE
CRADR EQU 98H ;CREATE
NSADR EQU 0BBH ;NSAVE
NSCR2 EQU 6 ;NSAVE OR CREATE FOR THE 2ND TIME
DESDWR EQU 0D3H ;DESTROY FILE
SAVADR EQU 41H ;SAVE
;
;**************************************************************************
;
;**** PATCHES TO BASIC MEMSET ROUTINE ****
;
ORG BASIC+519H
;
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+05F6H
;
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 132
;
;
;***************************************************************************
;
ORG IFBASE
;
;**** JUMP TABLE; MATCHES NORTHSTAR DOS ****
;
JMP BSINIT
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
;
;**** 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
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
