DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦9b5afb9c5⟧ TextFile

    Length: 11008 (0x2b00)
    Types: TextFile
    Names: »DEFF2A.CSM«

Derivation

└─⟦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« 

TextFile

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