|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 11008 (0x2b00) Types: TextFile Names: »DEFF2A.CSM«
└─⟦23f778bf6⟧ Bits:30005378 BDS C v1.46 & Pascal/MT+ v5.5 (Callan format) └─ ⟦this⟧ »DEFF2A.CSM« └─⟦4ada80662⟧ Bits:30005446 Pascal/MT+ v5.5 & XREF & BDS C v1.46 └─ ⟦this⟧ »DEFF2A.CSM«
; ; BD Software C Standard Library Machine Language Functions ; Written by Leor Zolman ; v1.46, 3/22/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: ; ; rread rwrite rtell rseek rsrec rcfsiz ; setjmp longjmp ; setplot clrplot line plot txtplot ; index getline ; ; ; ; The random-record file I/O function contained here are NOT documented ; in the User's Guide, because they are non-portable to pre-2.0 CP/M ; Systems. ; maclib bds ; ; Here are the new random-access file I/O routines ; for use with CP/M version 2.x ONLY...these functions ; will NOT work under pre-2.x CP/M's. ; ; The new functions are: rread, rwrite, rtell, rseek, ; rsrec, rcfsiz ; ; ; Rread: ; ; Read a number of sectors randomly. ; Usage: ; ; i = rread(fd, buf, n); ; ; The return value is either the number of sectors successfully ; read, 0 for EOF, or 1000 + (BDOS ERROR CODE) ; ; The Random Record Field is incremented following each successful ; sector is read, just as if the normal (sequentail) read function ; were being used. Rseek must be used to go back to a previous ; sector. ; FUNCTION rread call arghak lda arg1 call fgfd jc error mov a,m ani 2 jz error push b lda arg1 call fgfcb shld tmp2 lxi h,0 shld tmp2a r2: lhld arg3 mov a,h ora l lhld tmp2a jnz r2a pop b ret r2a: lhld arg2 xchg mvi c,sdma call bdos lhld tmp2 xchg mvi c,readr ;code for BDOS random read push d ;save de so we can fudge nr field if call bdos ;we stop reading on extent boundary... pop d ; CP/M sucks! ora a jz r4 ;go to r4 if no problem cpi 1 jz r2b ;EOF? mov c,a ;put return error code in BC mvi b,0 lxi h,1000 ;add to 1000 dad b pop b ret r2b: lxi h,32 ;yes. are we on extent boundary? dad d mov a,m cpi 80h jnz r3 mvi m,0 ;yes. reset nr to 0...CP/M leaves it at 80! r3: lhld tmp2a ;(note: the above "bug" in CP/M was supposedly fixed pop b ; for 2.x, but one can never be sure...) ret r4: lhld arg3 dcx h shld arg3 lhld arg2 lxi d,128 dad d shld arg2 lhld tmp2a inx h shld tmp2a lhld tmp2 ;get address of fcb lxi b,33 ;get addr of random record field dad b mov c,m ;bump inx h ; value mov b,m ; of inx b ; random mov m,b ; field dcx h ; by one mov m,c jmp r2 ENDFUNC ; ; Rwrite: ; ; The random "write" routine, which always copies the sector ; to be written down to tbuff before writing. Returns ; the # of sectors successfully written, or -1 on hard error. ; (the "1000 + error code" business is not used for rwrite) ; FUNCTION rwrite 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 nwr2: lhld arg3 ;done yet? mov a,h ora l lhld tmp2a ;if so, return count jnz nwr2a pop b ret nwr2a: lhld arg2 ;else copy next 128 bytes down to tbuff lxi d,tbuff ;80 for normal CP/M, else 4280 mvi b,128 nwr3: mov a,m stax d inx h inx d dcr b jnz nwr3 shld arg2 ;save -> to next 128 bytes lhld tmp2 ;get addr of fcb xchg mvi c,writr ;go write randomly call bdos ora a ;error? lhld tmp2a ;if so, return # of successfully written pop b ; sectors. rnz push b inx h ; else bump successful sector count, shld tmp2a lhld arg3 ; debump countdown, dcx h shld arg3 lhld tmp2 ; get address of fcb lxi b,33 ; get address of random field dad b mov c,m ; bump 16-bit value at random inx h ; record mov b,m ; field inx b ; of mov m,b ; fcb dcx h ; by one mov m,c jmp nwr2 ; and go try next sector ENDFUNC ; ; rseek: ; ; rseek(fd, offset, origin) ; seeks to offset records if origin == 0, ; to present position + offset if origin == 1, ; or to end of file + offset if origin == 2. ; (note that in the last case, the offset must be non-positive) ; FUNCTION rseek call arghak lda arg1 call fgfcb jc error push h call rtell2 lhld arg2 lda arg3 ;is origin == 0? ora a jz rseek2 ;if so, HL holds new position dcr a ;no. is origin == 1? jnz rseek1 dad d ;yes. add offset to current position jmp rseek2 ;and result is in HL rseek1: pop d ;else origin must be 2... push d push b mvi c,cfsizc ;compute end of file position call bdos pop b pop h ;get back fcb push h call rtell2 ;get DE = position lhld arg2 ;add offset dad d ;and HL holds new position rseek2: xthl ;get fcb, push new position lxi d,33 dad d ;HL points to random field of fcb pop d ;get new position in DE mov m,e ;and put into fcb inx h mov m,d xchg ;and return the position value ret rtell2: lxi d,33 dad d mov e,m inx h mov d,m ret ENDFUNC ; ; Rtell: ; ; Return random record position of file: ; FUNCTION rtell call arghak lda arg1 call fgfcb jc error lxi d,33 ;go to random record field dad d mov e,m ;get value into DE inx h mov d,m xchg ;put into HL ret ENDFUNC ; ; Rsrec: ; ; Set random field from serial access mode: ; FUNCTION rsrec call arghak lda arg1 call fgfcb jc error push h xchg push b mvi c,srrecc call bdos pop b pop h lxi d,33 dad d mov a,m inx h mov h,m mov l,a ret ENDFUNC ; ; Rcfsiz: ; ; set random record field to end-of-file: ; FUNCTION rcfsiz call arghak lda arg1 call fgfcb jc error push h xchg push b mvi c,cfsizc call bdos pop b pop h lxi d,33 dad d mov a,m inx h mov h,m mov l,a ret ENDFUNC FUNCTION setjmp call ma1toh mov m,c ;save BC inx h mov m,b inx h xchg lxi h,0 dad sp xchg mov m,e ;save SP inx h mov m,d inx h pop d ;save return address push d mov m,e inx h mov m,d lxi h,0 ;and return 0 ret ENDFUNC FUNCTION longjmp call ma1toh ;get buffer address mov c,m ;restore BC inx h mov b,m inx h mov e,m ;restore SP...first put it in DE inx h mov d,m inx h shld temp ;save pointer to return address call ma2toh ;get return value xchg ;put return val in DE, old SP in HL sphl ;restore SP with old value pop h ;pop retur address off stack lhld temp ;get back ptr to return address mov a,m inx h mov h,m mov l,a ;HL holds return address xchg ;put ret addr in DE, get return value in HL push d ;push return address on stack ret ;and return... temp: ds 2 ENDFUNC FUNCTION setplot call arghak push b lhld arg1 ;get base address shld pbase ; initialize lhld arg3 ;get y size shld ysize ; initialize xchg ;leave it in DE lhld arg2 ;get x size shld xsize ; initialize call usmul ;figure out screen size shld psize ; initialize pop b ret ENDFUNC FUNCTION clrplot lhld psize ;put screen size xchg ; in DE lhld pbase ;get screen base in HL clr2: mvi m,' ' ;and inx h ; clear dcx d ; each mov a,d ; location ora e ; (all DE of 'em) jnz clr2 ret ENDFUNC FUNCTION line call arghak ;get args push b lda arg2 ;put one set of endpoint data in DE in mov c,a ;format: D = x = arg2, E = y = arg3 lda arg3 mov b,a mov d,b mov e,c call put ; put up one endpoint at BC lda arg4 ;put other endpoint data in HL mov c,a lda arg5 mov b,a call put ;(but first put up the point from BC) mov h,b mov l,c call liner ;now connect them... pop b ret ;all done. liner: mov a,d sub h call abs cpi 2 jnc line2 ;are points far enough apart ;in both dimensions to warrant mov a,e ;drawing a line? sub l call abs cpi 2 jnc line2 ret ;if not, return. line2: call midp ;find midpoint call put ;put it up push d ;set up recursive calls mov d,b mov e,c call liner xthl call liner xchg pop h ret ;and we are done! midp: push h push d mov a,h sub d ani 1 jz mid3 mov a,h cmp d jc mid2a inr d jmp mid3 mid2a: dcr h mid3: mov a,l sub e ani 1 jz mid4 mov a,l cmp e jc mid3a inr e jmp mid4 mid3a: dcr l mid4: mov a,h add d ora a rrc mov b,a mov a,l add e ora a rrc mov c,a pop d pop h ret put: push h push d mov a,b lhld ysize xchg lhld pbase inr a put1: dcr a jz put2 dad d jmp put1 put2: mov e,c mvi d,0 dad d lda arg1 mov m,a pop d pop h ret abs: ora a rp cma inr a ret ENDFUNC FUNCTION plot call arghak lda arg1 lhld ysize xchg lhld pbase inr a plot1: dcr a jz plotc dad d jmp plot1 plotc: lda arg2 mov e,a mvi d,0 dad d lda arg3 mov m,a ret ENDFUNC FUNCTION txtplot call arghak push b lhld arg2 xchg lhld ysize call usmul xchg lhld arg3 dad d xchg lhld pbase dad d xchg lhld arg1 mvi b,0 lda arg4 ora a jz txt2 mvi b,80h txt2: mov a,m ora a jnz txt3 pop b ret txt3: ora b stax d inx h inx d jmp txt2 ENDFUNC ; ; Index(str,substr) ; char *str, *substr; ; ; Returns index of substr in str, or -1 if not found. ; FUNCTION index call arghak lhld arg1 xchg ;main str ptr in DE lhld arg2 ;substr ptr in HL dcx d index1: inx d ldax d ;end of str? ora a jnz index2 lxi h,-1 ;yes. not found. ret index2: cmp m ;quick check for dissimilarity jnz index1 ;loop if not same right here push d ;else do long compare push h index3: inx h inx d mov a,m ;end of substr? ora a jnz index4 ;if not, go on testing pop d ;else matches pop d ;get starting address of substr in DE lhld arg1 ;subtract beginning of str call cmh dad d ;and return the result ret index4: ldax d ;current char match? cmp m jz index3 ;if so, keep testing pop h ;else go on to next char in str pop d jmp index1 ENDFUNC ; ; Getline(str,lim) ; char *str; ; ; Gets a line of text from the console, up to 'lim' characters. ; FUNCTION getline push b call ma3toh ;get max no. of chars mov c,a ;save in C call ma2toh ;get destination address push h lxi h,-150 ;use space below stack for reading line dad sp push h ;save buffer address mov m,c ;Set max # of 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 mov c,b ;save char count in C 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 mov l,c ;return char count in HL mvi h,0 pop b ret ENDFUNC «eof»