;SDISK 1/12/81 ;XYBASIC Interpreter Source Module ;Copyright (C) 1978, 1979, 1980, 1981 by Mark Williams Company, Chicago ;statement routines for CP/M SDISK version if cpm and sdisk ;The sequential disk file block working space is located at the ;top of RAM, between (STRT) and (FILET). Location FILES contains the ;number of file blocks currently allocated. ;Each potential sequential disk file has a 166 byte file block, containing: ;1 File #, 0 if unused and nonzero if OPEN ;2 Mode, 0 for Output and nonzero for Input ;3 Count, 0-7FH indicating last position written/read in current buffer ;4 Column, initially 0, ignored for Input ;5 Width, initially 72, ignored for Input ;6-38 File control block (33 bytes) ;39-166 Buffer (128 bytes) if rtpak ;EQUates for C3885 RTPAK version dclr0 equ uferr close equ uferr dinp0 equ uferr open equ uferr dprin equ uferr eoffn equ uferr else ;NOT RTPAK ;CLEAR @ dclr0: inr a ;clear @0 means files=1, etc. jz bferr ;CLEAR @ 255 not allowed mov c,a ;desired # files to C call closn ;close any open files lda files ;current # sub c jp dclr2 ;need fewer, so skip memory check lxi d,-filen lhld symta dclr1: dad d inr a jnz dclr1 ;leave room for additional file xchg ;new symta to DE lhld eofad call cmdhu jc omerr ;not enough space, fatal OM error dclr2: lhld strt xchg call cplde ;- top of string space to DE lhld memt dad d ;-current amount of string space to HL push h ;and saved mov a,c sta files ;save new file max lhld filet ;top of file space to HL lxi d,-filen ;space per file to DE dclr3: dcr a jz dclr4 mvi m,0 ;initialize empty file space dad d jmp dclr3 dclr4: shld strt ;store new top of string space pop d dad d ;subtract string space needed jmp cle0a ;and initialize symbol table, etc. ;CLOSE [@, ...] close: call gtsfn ;look for file # jc closn ;none, close all jz bferr ;DK error if @0 closed mov h,b mov l,c clos1: ora a jnz closi ;close file open for input mov a,m ;fetch count sui 80H mov b,a ;eof count to B mvi c,cntlz clos2: push b push h call dwrtc ;write an eof pop h pop b inr b jnz clos2 ;write more eofs closi: inx h inx h ;point to file number mvi m,0 ;reset to 0 lxi d,-37 dad d xchg ;fcb address to DE mvi c,dkclf if c3885 and not debug call bdos1 ;BDOS call with interrupts disabled else call bdos endif cpi 255 rnz jmp dkerr ;close error closn: call sfils clon1: dcr b rz ;all closed push b push d push h ;save all mov a,m ;fetch file number ora a dcx h mov a,m ;fetch type dcx h ;point to count cnz clos1 ;close a file pop h pop d pop b ;restore dad d ;point to next jmp clon1 ;and see if more to close ;DIR [] if not c3885 dircm: call gtaf5 ;set filename to *.* xra a sta fcbad ;set disk to @ sta fcbcr call dtst0 ;look for delimiter cc gtafn ;get desired ambiguous filename if present mvi c,17 dirc1: call ctest ;look for console break char call wcrlf ;write crlf call bdosf ;search for next occurrence of filename cpi 255 rz ;no more ani 3 rrc rrc rrc adi 81H mov e,a mvi d,0 ;address of filename to DE mvi c,8 call prstr ;print the filename call wrtsp ;and print a space mvi c,3 call prstr ;and print filetype mvi c,18 ;look for next jmp dirc1 endif ;INPUT @, dinp0: push psw call gtcom ;skip trailing comma pop psw jz inpu1 ;INPUT @0, normal INPUT with no quoted string ora a jz fmerr ;FM error if file open for Output push b ;save file count pointer dinp1: call gtlhs ;get destination pop h ;file count pointer to HL cpi strst push psw ;save type (Zero set iff string) lxi d,nlnad ;input buffer address to DE mvi c,0 ;char count to C dinp2: call dread ;read a disk file char cpi ' '+1 jc dinp2 ;ignore leading spaces or control chars cpi ',' jz dinp2 ;and ignore leading commas dinp3: cpi ' ' jnz dinp4 ;next not space pop psw push psw ;Zero set iff string mvi a,' ' jnz dinp6 ;done if space and numeric dinp4: cpi ',' jz dinp6 ;done if comma cpi cr jz dinp5 ;done if stax d ;else store the char inx d inr c ;bump the count jz dinp8 ;256 chars call drea0 ;else look at next char jz dinp6 ;done if eof inr m ;else read it jmp dinp3 ;and repeat dinp5: call dinlf ;ignore trailing if present dinp6: pop psw push h lxi h,nlnad jnz dinp9 ;numeric value xchg ;location to DE mvi a,strst dinp7: call asigv ;assign value to destination call gtcnd ;look for comma and more vars jnc dinp1 pop h ;pop saved file count pointer din10: call drea0 ;look at first unread char rz ;eof, done cpi ' ' jz din11 ;ignore trailing spaces cpi cr rnz ;done if next char not space or inr m ;ignore the trailing ;DINLF ignores next character iff dinlf: call drea0 ;look at next char rz ;eof cpi lf rnz ;not , return inr m ;read the ret ;and return din11: inr m ;read the trailing space jmp din10 ;and look for more trailing spaces or dinp8: dcr m ;unread the 256th char dcr c ;correct the count jmp dinp6 ;and assign it dinp9: mvi a,cr stax d ;put after value shld txtp2 call flip ;to read the input buffer call gtlit ;evaluate the numeric value jc fierr ;bad value cpi strst jz fierr ;string value is also bad push d push psw call flip ;to read as before ldax d ;fetch next char from input buffer cpi cr jnz fierr ;FI error if not , value is bad pop psw pop d jmp dinp7 ;else assign value to destination as above fierr: error f, F, I ;fatal FI error fmerr: error f, F, M ;fatal FM error ;LINPUT [@] if not c3885 linpt: call idtst ;LINPUT is illegal in direct mode call gtsfn ;look for file # push psw push b call gtcom ;skip comma, if any call gtlhs ;get destination cpi strst jnz snerr ;must be string pop h ;count pointer to HL pop psw jc linp0 jz linp0 ;normal linput ora a jz fmerr ;FM error if open for output lxi d,nlnad push d ;save input buffer address mvi c,0 jmp linf1 linf0: inr c ;char count to C jz linf2 ;256 chars read linf1: call dread ;read a disk char stax d ;store it inx d cpi cr jnz linf0 ;read another unless at cr pop d ;location = input buffer to DE call dinlf ;skip trailing if present jmp linp2 ;assign value to destination linf2: dcr m ;unread the 256th char dcr c ;correct the count pop d ;restore location jmp linp2 ;assign value to desination ;LINPUT from the console linp0: lhld textp push h ;save textp call gtlin ;get input line xthl ;recover old textp shld textp pop h mov d,h mov e,l ;copy first char address to DE mvi a,cr mvi c,0 ;char count to C linp1: cmp m jz linp2 ;done if char is cr inr c inx h jmp linp1 linp2: mvi a,strst jmp asigv ;assign string value to destination endif ;MARGIN [@,] if not c3885 margn: call gtsfn ;find file jc marg0 ;none, change WIDTH push psw ;save Zero status push b ;and pointer mvi d,',' call gtdsn ;skip , call gtbex ;get byte value pop h ;pointer to HL pop psw ;restore Zero jz marg1 ;@0, change WIDTH dcx h dcx h ;point to file width field mov m,c ;and change it ret marg0: call gtbex ;get byte value marg1: mov a,c sta width ;value to WIDTH ret endif ;OPEN {I | O | U} @, open: call gtcha ;get desired mode push psw ;and save call gtcom ;allow comma after mode call gtatn ;get desired file number jc bferr jz bferr ;0 not allowed call sfils ;set up B, DE, HL for search mov c,b ;max # files to C also push d push h ;and save ;first check if number already associated with open file open1: dcr c jz open2 cmp m jz foerr ;desired number already open, FO error dad d jmp open1 ;else try next open2: mov c,a ;desired number to C push b mvi d,',' call gtdsn ;skip , call gtfnm ;get desired filename ;check if file of same name is already open pop b pop h push h push b opn2a: dcr b jz opn2c ;checked all files, ok mov a,m ;fetch file # lxi d,-37 dad d ;address the file fcb ora a jz opn2b ;no file, skip the test push b push h lxi d,fcbad lxi b,(12 shl 8) or 12 ;count = 12 chars to B and C call cmstr ;compare file fcb with new fcb jz foerr ;already open, FO error pop h pop b opn2b: lxi d,-129 dad d ;address the next file # jmp opn2a ;and test it opn2c: pop b pop h pop d ;then check if space available for file open3: dcr b jz operr ;all available file areas full mov a,m ora a jz open4 ;available dad d jmp open3 ;else try next open4: mov m,c dcx h pop psw ;recover desired mode cpi 'O' jz openo cpi 'U' jz openu ;else open for input cpi 'I' jnz snerr ;SN error if not I inx h mvi m,0 ;reset file # to 0 in case not found push b push h call cdkop ;open the file pop h pop b mov m,c ;set the file # dcx h mvi m,255 ;mode = input dcx h mvi m,7FH ;count = 7FH so next read gets new buffer lxi d,-35 dad d ;HL addresses file fcb jmp open6 ;open for output openo: xra a mov m,a ;mode = output dcx h mov m,a ;buffer address = 0 dcx h mov m,a ;column = 0 dcx h mvi m,72 ;default width = 72 lxi d,-33 dad d ;HL addresses file fcb push h call cdkmk ;delete old, make new pop h open6: lxi b,fcbad lxi d,33 jmp moved ;copy default fcb to fcb and return ;open for update openu: mvi m,0 ;mode = output dcx h push h ;save count address dcx h mvi m,72 ;column = 72 dcx h mvi m,72 ;default width = 72 lxi d,-161 dad d ;address buffer base xthl ;save push h ;and save count address call cdkop ;open the file opnu1: call cdkrd ;read a record mvi a,0 ;count zero in case eof jz opnu4 ;eof lxi h,dmaad ;default dma address to HL mvi a,cntlz ;eof to A opnu2: cmp m ;check if next char is eof jz opnu3 ;yup inr l ;else try next jnz opnu2 jmp opnu1 ;reading another buffer if necessary opnu3: mov a,l sui 80H ;compute the new count opnu4: pop h mov m,a ;store the new count pop h lxi b,dmaad lxi d,80H call moved ;copy the buffer to file entry buffer lda fcbcr dcr a sta fcbcr ;update the cr field to rewrite the same record jmp open6 ;and copy the fcb to the file entry foerr: error f, F, O ;fatal FO error operr: error f, O, P ;fatal OP error ;PRINT @, dprin: push psw mvi d,',' call gtd ;skip comma if present pop psw jz prin0 ;normal PRINT if @0 ora a jnz fmerr ;FM error if file is OPEN for input lxi h,nulls mov a,m ;fetch current NULLS value push psw ;and save mvi m,0 ;and reset to 0 for disk PRINT lhld colum push h ;save current column and width mov h,b mov l,c shld filep ;set file pointer so PRINT goes to file dcx h mov e,m ;column to E push h dcx h mov d,m ;width to D xchg shld colum ;set file column and width call prin0 ;print the line lda colum pop h mov m,a ;reset file column pop h shld colum ;restore column and width pop psw ;recover original NULLS value sta nulls ;and restore it lxi h,0 shld filep ;reset file pointer ret ;SCRATCH [] if not c3885 scrat: call gtafn ;get ambiguous filename mvi c,dkdlf jmp bdosf ;delete it endif ;functions ;EOF: --> eoffn: mov a,b ora a jnz bferr ;arg too large, cannot be file # mov a,c call gtsf0 ;find arg value ora a jz fmerr ;FM error if open for output mov h,b mov l,c eoff0: call drea0 ;look at next char lxi b,-1 rz ;eof, return -1 inx b ret ;no eof, return 0 ;routines ;DREAD reads a char from a disk file, issues DK error if char is EOF. dread: call drea0 ;read a char jz eferr ;EF error if read through eof inr m ;else read the char ret eferr: error f, E, F ;fatal EF error ;DREA0 looks at the next character from a disk file. ;Call: HL pointer to count of file entry ;Retn: A next character ; BC,DE,HL preserved ; Zero Set iff eof drea0: push h push d mov a,m ;fetch count inr a ;and bump it jp drea1 ;ok unless 80H ;must read a new buffer of characters and reset count mvi m,255 ;reset count of last char read push h push b lxi d,-35 dad d push h ;save fcb address lxi d,-128 dad d ;address buffer xchg call stdma ;set dma address to buffer pop d mvi c,dkrdf if c3885 and not debug call bdos1 ;BDOS call with interrupts disabled else call bdos endif push psw ;save status call rtdma ;and reset the dma address to 80H pop psw ;restore status pop b pop h cpi 2 jz dkerr ;read error cpi 1 mvi a,cntlz jz drea2 ;return if eof xra a ;reset count drea1: lxi d,-163 dad d call adahl ;address desired char mov a,m ;fetch it drea2: cpi cntlz ;Zero set iff eof pop d pop h ret dwrit: call dwrtc ;write char to disk file jmp pop4 ;restore and return dwrtc: mov a,m ;fetch count inr m ;update count push psw xchg ;count pointer to DE lxi h,-163 dad d ;point to buffer base call adahl ;add count+base = destination mov m,c ;char to destination pop psw rp ;return unless count is 80H xra a stax d ;store new count = 0 inx h ;point to fcb push h ;save fcb address lxi d,-128 dad d xchg call stdma ;set dma address to buffer pop d ;recover fcb address push d ;and save again mvi c,dkwtf if c3885 and not debug call bdos1 ;BDOS call with interrupts disabled else call bdos endif push psw call rtdma ;reset dma address pop psw pop d ;fcb address to DE ora a rz ;successful write, return lxi h,37 ;otherwise disk is full dad d mvi m,0 ;reset the file # to 0, now inactive mvi c,dkdlf if c3885 and not debug call bdos1 ;BDOS call with interrupts disabled else call bdos endif error f, D, F ;fatal DF error endif ;end of NOT RTPAK conditional ;@ ;GTATN gets @ followed by a number for sequential disk routines. ;A fatal DK error occurs if the is not in the range 0 to 255. ;Retn: Carry Set iff no @ found ; Zero Set iff is 0 ; A Value of gtatn: mvi d,'@' call gtd ;look for @ rc ;not found call gtexp ;evaluate the mov a,b ora a jnz bferr ;fatal BF error if not between 0 and 255 ora c ;value to A ret bferr: error f, B, F ;fatal BF error ;GTSFN finds an OPEN sequential disk file. A DK error occurs ;if a nonzero file # is given but no corresponding OPEN file exists. ;Retn: Carry Set iff no @ found ; Zero Set iff file @0 is specified ; A Mode of file (0 output, nonzero input) ; BC Pointer to count field of file entry ; HL Pointer to byte preceding file buffer gtsfn: call gtatn ;look for @ rc ;no @ rz ;@ 0 if rtpak jmp uferr ;issue UF error if nonzero file # in RTPAK else ;NOT RTPAK gtsf0: call sfils ;set up registers for search -- EOF entry point gtsf1: dcr b jz bferr ;not found, BF error cmp m ;compare desired to actual jz gtsf2 ;gotcha dad d ;else try next jmp gtsf1 gtsf2: mov b,h mov c,l ;file pointer to BC dad d ;HL points below buffer ori 1 ;Carry and Zero reset dcx b ldax b ;fetch mode dcx b ;point to count with BC ret sfils: lxi h,files mov b,m ;max # files to B lhld filet lxi d,-filen ret endif ;end of NOT RTPAK conditional endif ;end of SDISK conditional ;end of SDISK page