ftp.barnyard.co.uk

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

/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / BDSC / BDSC-1 / DEFF2.CSM < prev next >

Wrap

Text File | 2000-06-30 | 22KB | 1,259 lines

; ; BD Software C Standard Library Machine Language Functions ; Written by Leor Zolman ; v1.46, 3/15/82 ; ; This file is in "CSM" format; to convert to CRL format, ; use CASM.SUB in conjunction with CASM.COM, ASM.COM and DDT.COM. ; ; Functions appearing in this file: ; ; getchar kbhit ungetch putchar putch gets rand srand ; srand1 nrand csw setmem movmem call calla inp ; outp peek poke sleep pause setfcb read write ; open close creat unlink seek tell rename fabort ; fcbaddr exit bdos bios codend externs endext topofmem ; exec execl execv sbrk rsvstk ; maclib bds FUNCTION getchar lda ungetl ;any character pushed back? ora a mov l,a jz gch2 xra a ;yes. return it and clear the pushback sta ungetl ;byte in C.CCC. mvi h,0 ret gch2: push b mvi c,conin call bdos pop b cpi cntrlc ;control-C ? jz base ;if so, reboot. cpi 1ah ;control-Z ? lxi h,-1 ;if so, return -1. rz mov l,a cpi cr ;carriage return? jnz gch3 push b mvi c,conout ;if so, also echo linefeed mvi e,lf call bdos pop b mvi l,newlin ;and return newline (linefeed).. gch3: mvi h,0 ret ENDFUNC FUNCTION kbhit lda ungetl ;any character ungotten? mvi h,0 mov l,a ora a rnz ;if so, return true push b mvi c,cstat ;else interrogate console status call bdos pop b ora a ;0 returned by BDOS if no character ready lxi h,0 rz ;return 0 in HL if no character ready inr l ;otherwise return 1 in HL ret ENDFUNC kbhit FUNCTION ungetch lda ungetl mov l,a push h call ma2toh sta ungetl pop h mvi h,0 ret ENDFUNC ungetch FUNCTION putchar call ma1toh ;get character in A push b mvi c,conout cpi newlin ;newline? jnz put1 ;if not, just go put out the character mvi e,cr ;else...put out CR-LF call bdos mvi c,conout mvi a,lf put1: mov e,a call bdos put2: mvi c,cstat ;now, is input present at the console? call bdos ora a jnz put3 pop b ;no...all done. ret put3: mvi c,conin ;yes. sample it (this will always echo the call bdos ; character to the screen, alas) cpi cntrlc ;is it control-C? jz base ;if so, abort and reboot pop b ;else ignore it. ret ENDFUNC FUNCTION putch call ma1toh push b mvi c,conout mov e,a cpi newlin jnz putch1 ;if not newline, just put it out mvi e,cr ;else put out CR-LF call bdos mvi c,conout mvi e,lf putch1: call bdos pop b ret ENDFUNC FUNCTION gets call ma1toh ;get destination address push b ;save BC push h push h lxi h,-150 ;use space below stack for reading line dad sp push h ;save buffer address mvi m,88h ;Allow a max of about 135 characters mvi c,getlin xchg ;put buffer addr in DE call bdos ;get the input line mvi c,conout mvi e,lf ;put out a LF call bdos pop h ;get back buffer address inx h ;point to returned char count mov b,m ;set B equal to char count inx h ;HL points to first char of line pop d ;DE points to start destination area copyl: mov a,b ;copy line to start of buffer ora a jz gets2 mov a,m stax d inx h inx d dcr b jmp copyl gets2: xra a ;store terminating null stax d pop h ;return buffer address in HL pop b ret ENDFUNC FUNCTION rand lhld rseed xchg mvi a,48h ana e jz rand1 jpe rand1 stc rand1: lhld rseed+2 mov a,h ral mov h,a mov a,l ral mov l,a shld rseed+2 mov a,d ral mov h,a mov a,e ral mov l,a shld rseed mov a,h ani 7fh mov h,a ret ENDFUNC FUNCTION srand call ma1toh mov a,h ora l jz srand2 shld rseed shld rseed+2 ret srand2: lxi d,stg1 push b mvi c,9 call bdos lxi h,0bdbdh srand3: push h mvi c,11 call bdos pop h inx h inx h inx h ani 1 jz srand3 shld rseed shld rseed+2 mvi c,conout mvi e,cr call bdos mvi c,conout mvi e,lf call bdos mvi c,conin ;clear the character call bdos pop b ret stg1: db 'Wait a few seconds, and type a CR: $' ENDFUNC FUNCTION srand1 EXTERNAL puts call ma1toh push h call puts ;print prompt string pop h push b lxi h,5678h sr1a: push h mvi c,cstat call bdos pop h inx h inx h inx h ora a jz sr1a shld rseed shld rseed+2 pop b ret ENDFUNC FUNCTION nrand EXTERNAL puts call arghak lhld arg1 ;get n (1st arg) mov a,h ana l cpi 255 ;was it -1 (set seed) ? jnz nrand1 lhld arg2 ;copy seed shld seed lhld arg3 shld seed+2 lhld arg4 shld seed+4 ret ;all done nrand1: push b mov a,h ;look at first arg again ora l jnz nrand3 ;is it 0 (randomize)? lhld arg2 push h ;yes. print out string call puts ;call puts pop d lxi h,5a97h ;yes. start w/something odd nrand2: push h mvi c,cstat ;interrogate console status call bdos pop h inx h ;and keep it odd inx h ;and growing ora a jz nrand2 ;until user types something. shld seed ;then plaster the value all over the shld seed+2 ;seed. shld seed+4 pop b ret nrand3: lda seed ;now compute next random number. from this ori 1 ; point on, the code is that of Prof. Paul Gans sta seed ;lsb of SEED must be 1 mvi b,6 ;clear 6 PROD bytes to 0 lxi h,prod randm1: mvi m,0 inx h dcr b jnz randm1 lxi b,6 ;set byte counter randm2: lxi h,plier-1 dad b ;make addr of lsb of PLIER mov a,m ;PLIER byte push b ;save byte counter mvi b,8 ;set bit counter randm3: mov d,a ;save PLIER byte lxi h,prod ;shift whole PROD left one bit mvi c,6 xra a randm4: mov a,m ;get byte ral ;shift left mov m,a ;put byte inx h dcr c jnz randm4 mov a,d ;recover PLIER byte ral ;look at current high bit jnc randm6 ;0 means no add cycle push psw ;add SEED to PROD xra a mvi c,6 lxi h,prod lxi d,seed randm5: ldax d adc m mov m,a inx h inx d dcr c jnz randm5 pop psw randm6: dcr b ;test bit counter jnz randm3 ;go cycle more bits pop b ;recover byte counter dcr c ;test it jnz randm2 ;go process more bytes mvi b,6 ;complement PROD, add 1 to it, lxi h,seed ;and transfer it to SEED. lxi d,prod xra a cmc randm7: ldax d cma aci 0 mov m,a inx h inx d dcr b jnz randm7 dcx h ;put the two high order bytes mov a,m ;into HL for return to C, not ani 7fh ;neglecting to zero the high mov h,a ;order bit so a positive int lda seed+4 ;is returned mov l,a pop b ret plier: db 0c5h,87h,1 db 0eh,9ah,0e0h seed: db 1,0,0,0,0,0 prod: db 0,0,0,0,0,0 ENDFUNC FUNCTION csw in 255 mov l,a mvi h,0 ret ENDFUNC FUNCTION setmem call arghak push b lhld arg2 xchg lhld arg1 lda arg3 mov c,a inx d setm2: dcx d mov a,d ora e jnz setm3 pop b ret setm3: mov m,c inx h jmp setm2 ENDFUNC FUNCTION movmem call arghak lhld arg3 ;get block length mov a,h ora l rz ;do nothing if zero length push b mov b,h mov c,l ;set BC to length lhld arg2 ;get dest addr xchg ;put in DE lhld arg1 ;get source addr in HL call cmphd ;if source < dest, do tail-first jc tailf ;else do head-first headf: mvi a,2 ;test for Z-80 inr a jpe m8080h ;Z80? db 0edh,0b0h ;yes. do block move. pop b ret ;and done. m8080h: mov a,m stax d inx h inx d dcx b mov a,b ora c jnz m8080h pop b ret tailf: dcx b ;tail first. Compute new source dad b ;and destination addresses xchg dad b xchg inx b mvi a,2 ;test for Z80 inr a jpe m8080t ;Z80? db 0edh,0b8h ;yes. do block move. pop b ret m8080t: mov a,m stax d dcx h dcx d dcx b mov a,b ora c jnz m8080t pop b ret cmphd: mov a,h cmp d rnz mov a,l cmp e ret ENDFUNC FUNCTION call call arghak push b lhld arg5 xchg lhld arg4 mov b,h mov c,l lda arg2 lxi h,call2 push h lhld arg1 push h lhld arg3 ret call2: pop b ret ENDFUNC FUNCTION calla call arghak push b lhld arg5 ;get de value xchg lhld arg4 ;get bc value mov b,h mov c,l lda arg2 ;get a value lxi h,calla2 ;get return address push h ;push it lhld arg1 ;get address of routine push h lhld arg3 ;get hl value ret ;call routine calla2: mov l,a ;put A value in HL mvi h,0 ;clear high byte pop b ret ENDFUNC FUNCTION inp call ma1toh sta iohack+1 ;store as arg to ram area input subroutine call iohack ;call the subroutine to get value mov l,a ;and put into HL mvi h,0 ret ENDFUNC FUNCTION outp call ma1toh ;get port number sta iohack+4 ;store as arg to ram area output subroutine call ma2toh ;get data byte call iohack+3 ;output it ret ENDFUNC FUNCTION peek peek: call ma1toh mov l,m mvi h,0 ret ENDFUNC peek FUNCTION poke call arghak lhld arg1 lda arg2 mov m,a ret ENDFUNC FUNCTION sleep call ma1toh push b inx h sl1: dcx h mov a,h ora l jnz sl1a pop b ret sl1a: lxi d,10000 sl2: dcx d mov a,d ora e jnz sl2 push h mvi c,cstat call bdos ora a pop h jz sl1 push h mvi c,conin call bdos cpi cntrlc jz base pop h jmp sl1 ENDFUNC FUNCTION pause push b paus1: mvi c,cstat call bdos ora a jz paus1 pop b ret ENDFUNC FUNCTION setfcb call arghak push b lhld arg2 ;get pointer to name text igsp: mov a,m inx h cpi ' ' jz igsp cpi tab jz igsp dcx h xchg ;set DE pointing to 1st non-space char lhld arg1 ;get --> fcb area call setfcb ; do it lxi h,0 ;all OK. pop b ret ENDFUNC FUNCTION read call arghak lda arg1 call fgfd jc error ;error if illegal fd mov a,m ani 2 ;open for read? jz error ;error if not push b lda arg1 call fgfcb shld tmp2 ;tmp2 will hold dma addr lxi h,0 ;count of # of successful sectors read shld tmp2a ; will be kept at tmp2a read2: lhld arg3 ;done? mov a,h ora l jz read4 read2a: lhld arg2 ;else read another sector xchg ;DE is dma addr mvi c,sdma call bdos ;set DMA lhld tmp2 xchg ;DE is fcb addr mvi c,reads push d ;save de so we can fudge nr field if call bdos ;we stop reading on extent boundary... pop d ; CP/M is a pain. cpi 2 pop b jz error ;if error, abort push b cpi 1 jnz read6 ;EOF? read3: lxi h,32 ;yes. are we on extent boundary? dad d ;if so, adjust for CP/M's stupidity here mov a,m ;by turning an 80h sector count into 00h. cpi 80h jnz read4 mvi m,0 ;yes. reset nr to 0...CP/M leaves it at 80h! read4: lhld tmp2a read5: pop b ret read6: lhld arg3 dcx h shld arg3 lhld arg2 lxi d,128 dad d shld arg2 lhld tmp2a inx h shld tmp2a jmp read2 ENDFUNC FUNCTION write call arghak lda arg1 call fgfd jc error mov a,m ani 4 jz error push b lda arg1 call fgfcb shld tmp2 lxi h,0 shld tmp2a lxi d,tbuff ;80 for normal CP/M, else 4280 mvi c,sdma call bdos writ1: lhld arg3 ;done yet? mov a,h ora l lhld tmp2a ;if so, return count jz writ3 lhld arg2 ;else copy next 128 bytes down to tbuff lxi d,tbuff ;80 for normal CP/M, else 4280 mvi b,128 writ2: mov a,m stax d inx h inx d dcr b jnz writ2 shld arg2 ;save -> to next 128 bytes lhld tmp2 ;get addr of fcb xchg mvi c,writs ;go write call bdos ora a ;error? lhld tmp2a ;if so, return # of successfully written jnz writ3 ; sectors. inx h ; else bump successful sector count, shld tmp2a lhld arg3 ; debump countdown, dcx h shld arg3 jmp writ1 ; and go try next sector writ3: pop b ret ENDFUNC FUNCTION open call arghak xra a call fgfcb ;any fcb's free? jc error ;if not, error sta tmp xchg lhld arg1 xchg push b call setfcb mvi c,openc call bdos cpi errorv ;successful open? pop b jz error ;if not, error lda tmp call fgfd ;get HL pointing to fd table entry lda arg2 ora a ;open for read? mvi d,3 jz open1 dcr a mvi d,5 jz open1 ;write? dcr a jnz error ;else must be both or bad mode. mvi d,7 open1: mov m,d lda tmp mov l,a mvi h,0 ret ENDFUNC FUNCTION close jmp close ;jump to the close routine in C.CCC ENDFUNC FUNCTION creat EXTERNAL unlink,open call arghak lhld arg1 push b push h call unlink ;erase any old versions of file pop d mvi c,creatc lxi d,fcb call bdos cpi errorv pop b jz error lxi h,2 push h lhld arg1 push h call open pop d pop d ret ENDFUNC creat FUNCTION unlink call ma1toh push b xchg lxi h,fcb call setfcb mvi c,delc call bdos lxi h,0 pop b ret ENDFUNC FUNCTION seek EXTERNAL tell call arghak ;copy arguments to args area lda arg1 call fgfcb jc error ;error if file not open push b push h ;save fcb address lhld arg1 push h call tell ;get r/w pointer position for the file pop d xchg ;put present pos in DE lda arg3 lhld arg2 ;get offset in HL ora a ;absolute offset? jz seek2 ;if so, offset is new position dad d ;else add offset to current position seek2: mov a,l ;convert to extent and sector values rlc mov a,h ral ani 7fh sta tmp xthl lxi d,12 push h dad d cmp m ;jumping over extent boundary? jz seek5 xthl ;yes. xchg mvi c,closec ;close old extent push d call bdos pop d pop h cpi errorv jnz seek4 seek3: pop d pop b jmp error seek4: lda tmp mov m,a push d mvi c,openc ;and open new one. call bdos seek5: pop d cpi errorv jz seek3 lxi h,32 ;and set nr field dad d pop d mov a,e ani 7fh mov m,a xchg ;return new sector # in HL pop b ret ENDFUNC FUNCTION tell call ma1toh ;get fd value in A call fgfcb jc error push b lxi d,12 dad d mov b,m ;put extent # in B lxi d,20 dad d mov c,m ;put sector # in C xra a ;rotate extent right one bit, old b0 --> Carry mov a,b rar mov h,a ;rotated value becomes high byte of tell position mvi a,0 ;rotate b0 of extent into A rar mov b,a ;save rotated extent number in B add c ;add rotated extent number to sector number mov l,a ;and result becomes low byte of tell position mov a,c ;if both rotated extent # and sector # has bit 7 hi, ana b ;then the sum had an overflow, so... jp tell2 inr h ;bump position number by 256 tell2: pop b ;and all done. ret ENDFUNC FUNCTION rename call arghak push b renam: lhld arg1 xchg lxi h,wfcb call setfcb lhld arg2 xchg lxi h,wfcb+16 call setfcb lxi d,wfcb mvi c,renc call bdos pop b cpi errorv jz error lxi h,0 ret wfcb: ds 53 ENDFUNC FUNCTION fabort call ma1toh call fgfd jc error mvi m,0 ;clear entry in fd table lxi h,0 ret ENDFUNC FUNCTION fcbaddr call ma1toh call fgfd ;is it an open file? jc error call ma1toh call fgfcb ;get fcb addr in HL ret ENDFUNC FUNCTION exit jmp exit ENDFUNC FUNCTION bdos call arghak push b lda arg1 ;get C value mov c,a lhld arg2 ;get DE value xchg ;put in DE call bdos ;make the bdos call pop b ret ;and return to caller ENDFUNC FUNCTION bios call arghak push b lhld base+1 ;get addr of jump table + 3 dcx h ;set to addr of first jump dcx h dcx h lda arg1 ;get function number (1-85) mov b,a ;multiply by 3 add a add b mov e,a ;put in DE mvi d,0 dad d ;add to base of jump table push h ;and save for later lhld arg2 ;get value to be put in BC mov b,h ;and put it there mov c,l lxi h,retadd ;where call to bios will return to xthl ;get address of vector in HL pchl ;and go to it... retadd: mov l,a ;all done. now put return value in HL mvi h,0 pop b ret ;and return to caller ENDFUNC FUNCTION codend lhld codend ret ENDFUNC FUNCTION externs lhld extrns ret ENDFUNC FUNCTION endext lhld freram ret ENDFUNC FUNCTION topofmem lhld base+6 lda tpa ;check for "NOBOOT" hackery cpi 21h ; "lxi h" at start of C.CCC (as inserted by NOBOOT)? dcx h ;if CCC doesn't begin with "lxi h," then top of rnz ;memory is just below the base of the bdos lxi d,-2100 ;else subtract CCP size (plus little more for good dad d ;measure) and return that as top of memory. ret ENDFUNC FUNCTION exec EXTERNAL execl call ma1toh ;get filename lxi d,0 ;load null parameter in DE push d ;push null parameter push h ;push filename call execl ;do an execl pop d ;clean up stack pop d ret ENDFUNC FUNCTION execl call arghak push b lhld arg1 xchg lxi h,-60 ;compute &nfcb for use here dad sp push h ; save for much later (will pop into BC) push h ;make a few copies for local use below push h call setfcb ;set up COM file for execl-ing pop h ;get new fcb addr lxi b,9 ;set extension to COM dad b mvi m,'C' inx h mvi m,'O' inx h mvi m,'M' pop d ;get new fcb addr again mvi c,openc ;open the file for reading call bdos cpi errorv jnz noerrr err: pop h pop b jmp error noerrr: lhld arg2 ;any first parameter? mov a,h ora l jnz excl0 lxi d,arg2 ;no...null out first default fcb slot push d lxi h,fcb call setfcb pop h jmp excl0a ;and go null out 2nd fcb slot excl0: xchg ;yes.. place into first default fcb slot lxi h,fcb call setfcb lhld arg3 ;any second parameter given? mov a,h ora l jnz excl0a lxi h,arg3 excl0a: xchg ;yes: stick it into second default fcb slot lxi h,fcb+16 call setfcb lxi d,tbuff+1 ;now construct command line: xra a ; zero tbuff+1 just in case there stax d ; are no arg strings lxi h,8 ;get pointer to 1st arg string in HL dad sp ; by offsetting 4 objects from the current SP mvi b,0 ;char count for com. line buf. excl1: push h ;and construct command line mov a,m ;get addr of next arg string pointer inx h mov h,m mov l,a ;0000 indicates end of list. ora h ;end of list? jz excl3 mvi a,' ' ;no. install next string dcx h excl2: call mpuc ;convert to upper case for command line buffer stax d inx d inr b inx h mov a,m ora a ;end of string? jnz excl2 pop h ;yes. inx h ;bump param pointer inx h jmp excl1 ;and go do next string excl3: pop h ;clean up stack mov a,b ;check for command buffer overflow cpi 53h jc excl30 ;if no overflow, go load file lxi d,errmsg mvi c,9 ;else comlain and abort... call bdos jmp err errmsg: db 7,'EXECL: Too much text',cr,lf,'$' excl30: lxi h,tbuff ;set length of command line mov m,b ;at location tbuff excl3a: lxi d,code0 ;copy loader down to end of tbuff lxi h,tpa-42 mvi b,42 ;length of loader excl4: ldax d mov m,a inx d inx h dcr b jnz excl4 pop b ;get fcb pointer in BC ;reset the SP: lhld base+6 ;get BDOS pointer in HL lda tpa ;look at first op byte of run-time pkg cpi 31h ;begin with "lxi sp,"? jnz go0 ;if so, use the same value now... lhld tpa+1 ;else get special SP value jmp go1 go0: cpi 21h ;begin with "lxi h" (the NOBOOT sequence?) jnz go1 ;if not, just use the BDOS addr as top of memory lxi d,-2050 ;for NOBOOT, subtract 2100 from BDOS addr dad d ;and make that the new SP go1: sphl lxi h,base push h ;set base of ram as return addr jmp tpa-42 ;(go to `code0:') mpuc: cpi 61h ;convert character in A to upper case rc cpi 7bh rnc sui 32 ret ; ; This loader code is now: 42 bytes long. ; code0: lxi d,tpa ;destination address of new program code1: push d ;push dma addr push b ;push fcb pointer mvi c,sdma ;set DMA address for new sector call bdos pop d ;get pointer to working fcb in DE push d ;and re-push it mvi c,reads ;read a sector call bdos pop b ;restore fcb pointer into BC pop d ;and dma address into DE ora a ;end of file? jz tpa-8 ;if not, get next sector (goto `code2:') mvi c,sdma ;reset DMA pointer lxi d,tbuff call bdos jmp tpa ;and go invoke the program code2: lxi h,80h ;bump dma address dad d xchg jmp tpa-39 ;and go loop (at code1) ENDFUNC FUNCTION execv EXTERNAL execl call arghak lhld arg2 ;get -> arg list mvi b,0 ;clear arg count execv1: inr b ;bump arg count mov e,m inx h mov d,m inx h mov a,d ora e ;last arg? jnz execv1 ;if not, keep looking for last one mov a,b ;save arg count in case of error sta savcnt dcx h ;HL -> next to last arg execv2: mov d,m ;now push args on stack dcx h mov e,m dcx h dcr b push d jnz execv2 execv3: lhld arg1 ;get program name push h ;save as first arg to execl call execl ;go do it; shouldn't come back. lda savcnt ;woops, we're back. Must've been an error... add a mov l,a ;put size of passed parameter list mvi h,0 ;into HL, and adjust stack dad sp sphl lxi h,-1 ;return error value ret savcnt: ds 1 ;save arg count here ENDFUNC FUNCTION sbrk call ma1toh ;get # of bytes needed in HL xchg ;put into DE lhld allocp ;get current allocation pointer push h ;save it dad d ;get tentative last address of new segment jc brkerr ;better not allow it to go over the top! dcx h xchg ; now last addr is in DE lhld alocmx ;get safety factor mov a,h ;negate cma mov h,a mov a,l cma mov l,a inx h dad sp ;get HL = (SP - alocmx) call cmpdh ;is DE less than HL? jnc brkerr ;if not, can't provide the needed memory. xchg ;else OK. inx h shld allocp ;save start of next area to be allocated pop h ;get pointer to this area ret ;and return with it. brkerr: pop h ;clean up stack jmp error ;and return with -1 to indicate can't allocate. cmpdh: mov a,d cmp h rc rnz mov a,e cmp l ret ENDFUNC FUNCTION rsvstk call ma1toh ;get the value to reserve shld alocmx ;and set new safety factor ret ENDFUNC