⟦f2a53e828⟧

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:
;
; 	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 sucks!
	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

«eof»
DataMuseum.dk

CP/M

⟦f2a53e828⟧ TextFile

Derivation

TextFile
