CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol010 / nscpm48.asm < prev next >

Wrap

Assembly Source File | 1984-04-29 | 22.0 KB | 978 lines

;************* 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 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