.comment	`
This version of CCC.C is incompatible with the code generated
by the standard version of cc.  It is missing sdei, etc., and
routines are at different addresses.

			`
	.xlist

FALSE	equ	0
TRUE	equ	NOT FALSE
MPM2	equ	FALSE

USERST	equ	FALSE	;True to use a restart vector for CDB interfacing
RSTNUM	equ	6	;Use "RST n" as default debugger vector. Has no
			;effect if USERST is false.
rstloc	equ  RSTNUM*8	;Memory address where "RST n" vector falls

nfcbs	equ	9	;maximum # of files open at one time
base	equ	0	;start of ram in system (either 0 or 4200h)
.bdos	equ	base+5	;the rest of these do not vary between CP/M systems.
tpa	equ	base+100h
tbuff	equ	base+80h
fcb	equ	base+5ch
origin	equ	tpa
exitad	equ	base	;warm boot location

cntrlc	equ	3
cr	equ	0dh
lf	equ	0ah
newlin	equ	0ah
errorv	equ	255


conin	equ 1		;get a character from console
conout	equ 2		;write a character to console
lstout	equ 5		;write a character to list device
dconio	equ 6		;direct console I/O (only for CP/M 2.0)
pstrng	equ 9		;print string (terminated by '$')
getlin	equ 10		;get buffered line from console
cstat	equ 11		;get console status
select	equ 14		;select disk
openc	equ 15		;open a file
closec	equ 16		;close a file
delc	equ 19		;delete a file
reads	equ 20		;read a sector (sequential)
;writs	equ 21		;write a sector (sequential)
creatc	equ 22		;make a file
renc	equ 23		;rename file
sdma	equ 26		;set dma
gsuser	equ 32		;get/set user code
readr	equ 33		;read random sector
writr	equ 34		;write random sector
cfsizc	equ 35		;compute file size
srrecc	equ 36		;set random record

	aseg
	org	origin

;
; The "lxi sp,0" instruction at the start of the code is changed by
; CLINK, if the "-t" option is NOT used, into:
;		lhld	base+6
;		sphl
;
; If "-t <addr>" is used, then the sequence becomes:
;		lxi	sp,<addr>
;		nop
;
; If "-n" is used, to indicate no-warm-boot, then the the sequence becomes:
;		jmp	snobsp
;		nop
;

	lxi	sp,0	;These two instructions change depending on whether
	nop		;or not the CLINK "-t" or "-n" options are given.

	nop
	nop

	jmp	skpfex	;skip over the following vector (don't ask...)

fexitv:	jmp	exitad	;final exit vector. If "-n" used, this
			;becomes address of the "nobret" routine.

skpfex:	call	init	;do ARGC & ARGV processing, plus misc. initializations
	call	_main	;go crunch!!!!
	jmp	vexit	;close open files and reboot

extrns:	ds	2		;set by CLINK to external data base address
cccsiz:	dw	_main-origin	;size of this code (for use by CLINK)
codend:	ds	2		;set by CLINK to (last addr of code + 1)
freram:	ds	2		;set by CLINK to (last addr of externals + 1)

;
; Jump vectors to some file i/o utility routines:
;

error:	jmp	verror	;loads -1 into HL and returns
.exit:	jmp	vexit	;close all open files and reboot

.close:	jmp	vclose	;close a file
setfcb:	jmp	vsetfcb	;set up fcb at HL given filename at DE
fgfd:	jmp	vfgfd	;return C set if file fd in A not open
fgfcb:	jmp	vfgfcb	;compute address of internal fcb for fd in A
setfcu:	jmp	vsetfcu	;set up FCB and process user number prefix
setusr:	jmp	vsetusr ;set user area to upper 5 bits of A, save previous
rstusr:	jmp	vrstusr	;restore user area to what it was before setusr call
snobsp: jmp	vsnobsp	;set up SP for non-boot ("-tn") CLINK option
nobret:	jmp	vnobret	;return to CCP when non-boot ("-tn") in effect.

;khack:	jmp	vkhack	;Kirkland interrupt vector initialization
	ds	3

clrex:	jmp	vclrex	;routine to clear external data area

;no	ds	9	;reserved

;
; The following routines fetch a variable value from either
; the local stack frame or the external area, given the relative
; offset of the datum required immediately following the call;
; for the "long displacement" routines, the offset must be 16 bits,
; for the "short displacement" routines, the offset must be 8 bits.
;(DELETED!!)
;ldei:
;sdei:
;lsei:
;ssei:
;ldli:
;sdli:

;
; Flag conversion routines:
;
;(DELETED!)
;pzinh:
;pnzinh:
;pcinh:
;pncinh:
;ppinh:
;pminh:
;pzind:
;pnzind:
;pcind:
;pncind:
;ppind:
;pmind:

;	
; Relational operator routines: take args in DE and HL,
; and return a flag bit either set or reset.
;
; ==, >, < :
;

eqwel:	mov	a,l	;return Z if HL == DE, else NZ
	cmp	e
	rnz		;if L <> E, then HL <> DE
	mov	a,h	;else HL == DE only if H == D
	cmp	d
	ret

blau:	xchg		;return C if HL < DE, unsigned
albu:	mov	a,d	;return C if DE < HL, unsigned
	cmp	h
	rnz		;if D <> H, C is set correctly
	mov	a,e	;else compare E with L
	cmp	l
	ret

bgau:	xchg		;return C if HL > DE, unsigned
agbu:	mov	a,h	;return C if DE > HL, unsigned
	cmp	d
	rnz		;if H <> D, C is set correctly
	mov	a,l	;else compare L with E
	cmp	e
	ret

blas:	xchg		;return C if HL < DE, signed
albs:	mov	a,h	;return C if DE < HL, signed
	xra	d
	jp	albu	;if same sign, do unsigned compare
	mov	a,d
	ora	a
	rp		;else return NC if DE is positive and HL is negative
	stc		;else set carry, since DE is negative and HL is pos.
	ret

bgas:	xchg		;return C if HL > DE, signed
agbs:	mov	a,h	;return C if DE > HL, signed
	xra	d
	jp	agbu	;if same sign, go do unsigned compare
	mov	a,h
	ora	a
	rp		;else return NC is HL is positive and DE is negative
	stc
	ret		;else return C, since HL is neg and DE is pos


;
; Multiplicative operators: *, /, and %:
;

smod:	mov	a,d	;signed MOD routine: return (DE % HL) in HL
	push	psw	;save high bit of DE as sign of result
	call	tstn	;get absolute value of args
	xchg
 	call	tstn
	xchg
	call	usmod	;do unsigned mod
	pop	psw	;was DE negative?
	ora	a	;if not,
	rp		;	all done
	mov	a,h	;else make result negative
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	ret

;	nop		;maintain address compatibility with some
;	nop		; pre-release v1.4's.

usmod:	mov	a,h	;unsigned MOD: return (DE % HL) in HL
	ora	l
	rz
	push	d
	push	h
	call	usdiv
	pop	d
	call	usmul
	mov	a,h
	cma
	mov	h,a
	mov	a,l
	cma 
	mov	l,a
	inx	h
	pop	d
	dad	d
	ret

smul:	xra	a	;signed multiply: return (DE * HL) in HL
	sta	tmp
	call	tstn
	xchg
	call	tstn
	call	usmul
smul2:	lda	tmp
	rar
	rnc
	mov	a,h
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	ret

tstn:	mov	a,h
	ora	a
	rp
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	lda	tmp
	inr	a
	sta	tmp
	ret

usmul:	push	b	;unsigned multiply: return (DE * HL) in HL
	call	usm2
	pop	b
	ret

usm2:	mov	b,h
	mov	c,l
	lxi	h,0
usm3:	mov	a,b
	ora	c
	rz
	mov	a,b
	rar
	mov	b,a
	mov	a,c
	rar
	mov	c,a
	jnc	usm4
	dad	d
usm4:	xchg
	dad	h
	xchg
	jmp	usm3

usdiv:	mov	a,h	;unsigned divide: return (DE / HL) in HL
	ora	l	;return 0 if HL is 0
	rz
	push	b
	call	usd1
	mov	h,b
	mov	l,c
	pop	b
	ret


usd1:	mvi	b,1
usd2:	mov	a,h
	ora	a
	jm	usd3
	dad	h
	inr	b
	jmp	usd2

usd3:	xchg

usd4:	mov	a,b
	lxi	b,0
usd5:	push	psw
usd6:	call	cmphd
	jc	usd7
	inx	b
	push	d
	mov	a,d
	cma
	mov	d,a
	mov	a,e
	cma
	mov	e,a
	inx	d
	dad	d
	pop	d
usd7:	xra	a
	mov	a,d
	rar
	mov	d,a
	mov	a,e
	rar
	mov	e,a
	pop	psw
	dcr	a
	rz
	push	psw
	mov	a,c
	ral
	mov	c,a
	mov	a,b
	ral
	mov	b,a
	jmp	usd6

sdiv:	xra	a	;signed divide: return (DE / HL) in HL
	sta	tmp
	call	tstn
	xchg
	call	tstn
	xchg
	call	usdiv
	jmp	smul2

cmphd:	mov	a,h	;this returns C if HL < DE
	cmp	d	; (unsigned compare only used
	rc		;  within C.CCC, not from C)
	rnz
	mov	a,l
	cmp	e
	ret

;
; Shift operators  << and >>:
;

sderbl:	xchg		;shift DE right by L bits
shlrbe:	inr	e	;shift HL right by E bits
shrbe2:	dcr	e
	rz
	xra	a
	mov	a,h
	rar
	mov	h,a
	mov	a,l	
	rar
	mov	l,a
	jmp	shrbe2

sdelbl:	xchg		;shift DE left by L bits
shllbe:	inr	e	;shift HL left by E bits
shlbe2:	dcr	e
	rz
	dad	h
	jmp	shlbe2


;
; Routines to 2's complement HL and DE:
;

cmh:	mov	a,h
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	ret

cmd:	mov	a,d
	cma
	mov	d,a
	mov	a,e
	cma
	mov	e,a
	inx	d
	ret


;
; The following routines yank a formal parameter value off the stack
; and place it in both HL and A (low byte), assuming the caller
; hasn't done anything to its stack pointer since IT was called.
;(DELETED!)
;ma1toh:
;ma2toh:
;ma3toh:
;ma4toh:
;ma5toh:
;ma6toh:
;ma7toh:
;
; This routine takes the first 7 args on the stack
; and places them contiguously at the "args" ram area.
; This allows a library routine to make one call	to arghak
; and henceforth have all it's args available directly
; through lhld's instead of having to hack the stack as it
; grows and shrinks. Note that arghak should be called as the
; VERY FIRST THING a function does, before even pushing BC.
;(should delete this)
arghak: lxi	d,args
	lxi	h,4	;pass over two return address
	dad	sp	;source for block move in HL
	push	b	;save BC
	mvi	b,14	;countdown in B
arghk2:	mov	a,m	;copy loop
	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	arghk2	
	pop	b	;restore BC
	ret

;
; ABSOLUTELY NO CHANGES SHOULD EVER BE MADE TO THE CODE BEFORE
; THIS POINT IN THIS SOURCE FILE (except for customizing the EQU
; statements at the beginning of the file).
;(Well, I did.)


;
; The following two routines are used when the "-tn" CLINK option
; was given, in order to preserve the SP value passed to the transient
; command by the CCP and return to the CCP after execution without
; performing a warm-boot.
;

vsnobsp:
	lxi	h,0		;get CCP's SP value in HL
	dad	sp
	shld	spsav		;save it for later
	lhld	base+6		;get BIOS pointer
	lxi	d,-2100		;subtract size of CCP plus a fudge
	dad	d
	sphl			;make that the new SP value
	jmp	tpa+3		;and get things under way...

vnobret:
	lhld	spsav		;restore CCP's SP
	sphl
	ret			;return to CCP



;
; This routine is called first to do argc & argv processing (if
; running under CP/M) and some odds and ends initializations:
;

init:	pop	h	;store return address
	shld	tmp2	; somewhere safe for the time being


;room on stack for arglst and comlin and fcbt

	lxi	h,-36*nfcbs
	dad	sp
	shld	.fcbt

	lxi	h,-131 -36*nfcbs
	dad	sp
	shld	.comlin
	lxi	h,-131-60 -36*nfcbs
	dad	sp
	shld	.arglst
	sphl


	nop
	nop
	nop
	nop
	nop
;	nop


	dcx	h
	dcx	h
;this is now arglst-2
;for now, let's keep total bytes the same 'til ram
;=+14
	push	h

			;Initialize storage allocation pointers:
	lhld	freram	;get address after end of externals
	shld	allocp	;store at allocation pointer (for "sbrk.")
;excessive?
;	lxi	h,1000	;default safety space between stack and
;try 256
;(now a constant)
;-	lxi	h,100H
;-	shld	alocmx	; highest allocatable address in memory 
			; (for use by "sbrk".).

;(revise lib so don't need this stuff)
			;Initialize random seed:
;	lxi	h,59dch	;let's stick something wierd into the
;	shld	rseed	;first 16 bits of the random-number seed

			;Initialize I/O hack locations:
;	mvi	a,0dbh		;"in" op, for "in xx; ret" subroutine
;	sta	iohack
;	mvi	a,0d3h		;"out" op for "out xx; ret" subroutine
;	sta	iohack+3
;	mvi	a,0c9h		;"ret" for above sobroutines
;	sta	iohack+2	;the port number is filled in by the
;	sta	iohack+5	;"inp" and "outp" library routines.

;	call	khack		;initialize Kirkland debugger vector

	 			;initialize raw I/O parameters
	xra	a
	sta	freeze		;clear freeze (^S) flag
	sta	pending		;no pending input yet
	mvi	a,1fh	
	sta	.mode		;tty mode: all features enabled
	mvi	a,'C'-64
	sta	quitc		;this is the standard interrupt char


			;under CP/M: clear console, process ARGC & ARGV:
	mvi	c,cstat ;interrogate console status to see if there
	call	.bdos	;  happens to be a stray character there...

	ora	a	;(used to be `ani 1'...they tell me this works
;	nop		; better for certain bizarre CP/M-"like" systems)

	jz	initzz
	mvi	c,conin   ;if input present, clear it
	call	.bdos

initzz:
	lhld	.comlin
	xchg
	lxi	h,tbuff


;note that we COULD find our own name in CCP conbuf
; if we really wanted it for argv[0]

	mov	b,m		;first get length of it from loc. base+80h
	inx	h
	mov	a,b
	ora	a	;if no arguments, don't parse for argv
	jnz	initl
	lxi	d,1	;set argc to 1 in such a case.
	jmp	i5

initl:	mov	a,m	;ok, there are arguments. parse...
	stax	d	;first copy command line to comlin
	inx	h
	inx	d
	dcr	b
	jnz	initl
	xra	a	;place zero following line
	stax	d

	lhld	.arglst	;where pointers will all go
	mov	b,h
	mov	c,l
	lhld	.comlin	;now compute pointers to each arg
	lxi	d,1		;arg count


	xra	a		;clear "in a string" flag
	sta	tmp1
i2:	mov	a,m	;between args...
	inx	h
	cpi	' '
	jz	i2
	ora	a
	jz	i5	;if null byte, done with list
	cpi	'"'
	jnz	i2a	;quote?
	sta	tmp1	;yes. set "in a string" flag
	jmp	i2b	

i2a:	dcx	h
i2b:	mov	a,l	;ok, HL is a pointer to the start
	stax	b	;of an arg string. store it.
	inx	b
	mov	a,h
	stax	b
	inx	b
	inx	d	;bump arg count
i3:	mov	a,m
	inx	h	;pass over text of this arg
	ora	a	;if at end, all done
	jz	i5
	push	b	;if tmp1 set, in a string 
	mov	b,a	; (so we have to ignore spaces)
	lda	tmp1
	ora	a
	mov	a,b
	pop	b
	jz	i3a
	cpi	'"'	;we are in a string.
	jnz	i3	;check for terminating quote
	xra	a	;if found, reset "in string" flag
	sta	tmp1
	dcx	h
	mov	m,a	;and stick a zero byte after the string
	inx	h	;and go on to next arg
i3a:	cpi	' '	;now find the space between args
	jnz	i3
	dcx	h	;found it. stick in a zero byte
	mvi	m,0
	inx	h
	jmp	i2	;and go on to next arg

i5:	push	d	;all done finding args. Set argc.

	mvi	b,3*nfcbs  ;now initialize all the file info
	lxi	h,fdt	;by zeroing the fd table)
i6:	mvi	m,0
	inx	h
	dcr	b
	jnz	i6


	call	clrex	;clear externals, if CLINK -z option NOT used

	xra	a
	sta	ungetl	;clear the push-back byte,
	sta	errnum	;and file error code

	lhld	tmp2
	pchl		;all done initializing.

;
; The following routine gets called to clear the external
; data area, unless the CLINK "-z" option is used.
;

vclrex:	lhld	freram	;clear externals
	xchg
	lhld	extrns
	call 	cmh
	dad	d	;HL now holds size of external data area
clrex1:	mov 	a,h	;loop till done
	ora	l
	rz
	dcx	d
	dcx	h
	xra	a
	stax	d
	jmp	clrex1


;
; Initialize Kirkland interrupt vector... enables
; programs compiled with "-k" to run without the debugger:
;(DELETED)

;
; General purpose error value return routine:
;

verror:	lxi	h,-1	;general error handler...just
	ret		;returns -1 in HL

;
; Here are file I/O handling routines, only needed under CP/M:
;

;
; Close any open files and reboot:
;

vexit:
				;if under CP/M, close all open files
	mvi	a,7+nfcbs	;start with largest possible fd
exit1:	push	psw		;and scan all fd's for open files
	call	vfgfd		;is file whose fd is in A open?
	jc	exit2		;if not, go on to next fd
	mov	l,a		;else close the associated file
	mvi	h,0
	push	h
	call	vclose
	pop	h
exit2:	pop	psw
	dcr	a		;and go on to next one
	cpi	7
	jnz	exit1

	jmp	fexitv		;done closing...now return
				; to CP/M or whatever.


;
; Close the file whose fd is 1st arg:
;

vclose:
;	call	ma1toh	;get fd in A
	pop	d
	pop	h
	mov	a,l
	push	h
	push	d
	sta	..fd

	call	vfgfd	;see if it is open
	jc	verror	;if not, complain
	mov	a,m
	call	setusr	;set user area to match current fd
	ani	4	;check if open for writing


	IF NOT MPM2	;if not MP/M, and
	jz	close2	;the file isn't open for write, don't bother to close
	ENDIF


	push	h	;save fd table entry addr

;	call	ma2toh	;get the fd in A again
	lda	..fd

	push	b
	call	vfgfcb	;get the appropriate fcb address
	xchg		;put it in DE
	mvi	c,closec  ;get BDOS function # for close
	call	.bdos	;and do it!
	pop	b
	pop	h
close2:	call	rstusr	;reset user number to original state
	mvi	m,0	;close the file logically
	cpi	255	;if 255 came back from .bdos, we got problems
	lxi	h,0	
	rnz		;return 0 if OK
	dcx	h	;return -1 on error
	ret

..fd:	ds	1
;
; Determine status of file whose fd is in A...if the file
; is open, return Cy clear and with the address of the fd table
; entry for the open file in HL. If the file is not open,
; return Cy set:
;

vfgfd:	mov	d,a
	sui	8
	rc		;if fd < 8, error
	cpi	nfcbs
	cmc		;don't allow too big an fd either
	rc
	push	d
	mov	e,a	;OK, we have a value in range. Now
	mvi	d,0	;  see if the file is open or not
	lxi	h,fdt
	dad	d	;offset for 3-byte table entries
	dad	d
	dad	d
	mov	a,m
	ani	1	;bit 0 is high if file is open
	stc
	pop	d
	mov	a,d
	rz		;return C set if not open
	cmc
	ret		;else reset C and return

;
; Set up a CP/M file control block at HL with the file whose
; simple null-terminated name is pointed to by DE:
; Format for filename must be: "[white space][d:]filename.ext"
; The user number prefix hack is NOT recognized by this subroutine.
;

vsetfcb:
	push	b
	call	igwsp	;ignore blanks and tabs	
	push	h	;save fcb ptr
	inx	d	;peek at 2nd char of filename
	ldax	d
	dcx	d
	cpi	':'	;default disk byte value is 0
	mvi	a,0	; (for currently logged disk)
	jnz	setf1
	ldax	d	;oh oh...we have a disk designator
	call	mapuc	;make it upper case
	sui	'A'-1	;and fudge it a bit
	inx	d	;advance DE past disk designator to filename
	inx	d
setf1:	mov	m,a	;set disk byte
	inx	h
	mvi	b,8
	call	setnm	;set filename, pad with blanks
	call	setnm3	;ignore extra characters in filename
	ldax	d
	cpi	'.'	;if an extension is given,
	jnz	setf2
	inx	d	;skip the '.'
setf2:	mvi	b,3
	call	setnm	;set the extension field and pad with blanks
	xra	a	;and zero the appropriate fields of the fcb
	mov	m,a
	lxi	d,20
	dad	d
	mov	m,a
	inx	h
	mov	m,a	;zero random record bytes of fcb
	inx	h
	mov	m,a
	inx	h
	mov	m,a
	pop	d
	pop	b
	ret

;
; This routine copies up to B characters from (DE) to (HL),
; padding with blanks on the right. An asterisk causes the rest
; of the field to be padded with '?' characters:
;

setnm:	push	b
setnm1:	ldax	d
	cpi	'*'	;wild card?
	mvi	a,'?'	;if so, pad with ? characters
	jz	pad2

setnm2:	ldax	d
	call	legfc	;next char legal filename char?
	jc	pad	;if not, go pad for total of B characters
	mov	m,a	;else store
	inx	h
	inx	d
	dcr	b
	jnz	setnm1	;and go for more if B not yet zero
	pop	b
setnm3:	ldax	d	;skip rest of filename if B chars already found
	call	legfc
	rc
	inx	d
	jmp	setnm3

pad:	mvi	a,' '	;pad with B blanks
pad2:	mov	m,a	;pad with B instances of char in A
	inx	h
	dcr	b
	jnz	pad2
	pop	b
	ret

;
; Process filename having optional user area number prefix of form "<u#>/",
; return the effective user area number of the given filename in the upper
; 5 bits of A, and also store this value at "usrnum". Note that if no user
; number is specified, the current user area is presumed by default. After
; the user area prefix is processed, do a regular "setfcb":
;
; Note: a filename is considered to have a user number if the first char
; 	in the name is a decimal digit and the first non-decimal-digit
;	character in the name is a slash (/).

vsetfcu:
	push	b	;save BC
	push	h	;save vcb pointer
	call	igwsp	;ignore blanks and tabs	
	call	isdec	;decimal digit?
	jnc	setfc2	;if so, go process

setfc0:	push	d	;save text pointer
	mvi	c,gsuser  ;else get current effective user number
	mvi	e,0ffh

	call	.bdos	;get current user area if implemented

	pop	d	;restore text pointer

setfc1:	rlc		;rotate into upper 5 bits of A
	rlc
	rlc
	sta	usrnum	;and save
	pop	h	;restore junk
	pop	b
	jmp	setfcb	;and parse rest of filename

setfc2:	mvi	b,0	;clear user number counter
	push	d	;save text pointer in case we invalidate user prefix
setfc3:	sui	'0'	;save next digit value
	mov	c,a	; in C
	mov	a,b	;multiply previous sum by 10
	add	a	;*2
	add	a	;*4
	add	a	;*8
	add	b	;*9
	add	b	;*10
	add	c	;add new digit
	mov	b,a	;put sum in B
	inx	d	;look at next char in text
	ldax	d	;is it a digit?	
	call	isdec
	jnc	setfc3	;if so, go on looping and summing digits
	cpi	'/'	;make sure number is terminated by a slash
	jz	setfc4
	pop	d	;if not, entire number prefix is not really a 
	jmp	setfc0	; user number, so just ignore it all.

setfc4:	inx	d	;ok, allow the user number
	pop	h	;get old text pointer off the stack
	mov	a,b	;get user number value
	jmp	setfc1	;and go store it and parse rest of filename


;
; Test if char in A is legal character to be in a filename:
;

legfc:	call	mapuc
	cpi	'.'	; '.' is illegal in a filename or extension
	stc
	rz
	cpi	':'	;so is ':'
	stc 	
	rz
	cpi	7fh	;delete is no good
	stc
	rz
	cpi	'!'	;if less than exclamation pt, not legal char
	ret		;else good enough

;
; Map character in A to upper case if it is lower case:
;

mapuc:	cpi	'a'
	rc
	cpi	'z'+1
	rnc
	sui	32	;if lower case, map to upper
	ret

;
; Ignore blanks and tabs at text pointed to by DE:
;

igwsp:	dcx	d
igwsp1:	inx	d
	ldax	d
	cpi	' '
	jz	igwsp1
	cpi	9
	jz	igwsp1
	ret

;
; Return Cy if char in A is not a decimal digit:
;

isdec:	cpi	'0'
	rc
	cpi	'9'+1
	cmc
	ret


;
; This routine does one of two things, depending
; on the value passed in A.
;
; If A is zero, then it finds a free file slot
;  (if possible), else returns C set.
;
; If A is non-zero, then it returns the address
; of the fcb corresponding to an open file whose
; fd happens to be the value in A, or C set if there
; is no file associated with fd.
;

vfgfcb:	push	b
	ora	a	;look for free slot?
	mov	c,a
	jnz	fgfc2	;if not, go away
	mvi	b,nfcbs	;yes. do it...
	lxi	d,fdt
;	lxi	h,fcbt
	lhld	.fcbt
	mvi	c,8
fgfc1:	ldax	d
	ani	1
	mov	a,c
	jnz	fgfc1a	;found free slot?
	pop	b	;yes. all done.
	ret

fgfc1a:	push	d
	lxi	d,36	;fcb length to accommodate random I/O
	dad	d
	pop	d
	inx	d	;bump to next 3-byte table entry
	inx	d
	inx	d
	inr	c
	dcr	b
	jnz	fgfc1
fgfc1b:	stc
	pop	b
	ret		;return C if no more free slots

fgfc2:	call	vfgfd	;compute fcb address for fd in A:
	jc	fgfc1b	;return C if file isn't open

	sui	8
	mov	l,a	;put (fd-8) in HL
	mvi	h,0
	dad	h	;double it
	dad	h	;4*a
	mov	d,h	;save 4*a in DE
	mov	e,l
	dad	h	;8*a
	dad	h	;16*a
	dad	h	;32*a
	dad	d	;36*a
	xchg		;put 36*a in DE
;-	lxi	h,fcbt	;add to base of table
	lhld	.fcbt
	dad	d	;result in HL
	mov	a,c	;and return original fd in A
	pop	b
	ret

;
; The following two subroutines change the current CP/M user area for
; user with file I/O:
;

vsetusr:
	push	b	;SET user number to upper bits of A, save current:
	push	h
	push	d
	push	psw	;save A
	mvi	c,gsuser ;get user code
	mvi	e,0ffh
	call	.bdos
	sta	curusr	;save current user number
	pop	psw	;get new user number byte
	push	psw
	rar		;shift user number down to low bits
	rar
	rar
	ani	1fh	;and mask off high order garbage
setu0:	mov	e,a
	mvi	c,gsuser  ;set user code
	call	.bdos
	pop	psw
	pop	d
	pop	h
	pop	b
	ret

vrstusr:
	push	b
	push	h
	push	d
	push	psw
	lda	curusr	;get last saved user number
	jmp	setu0	;and go set current user area to that

;
; Ram area:
;

ram	equ	$

;no	ds	20	;reserved by BDS

errnum:	ds	1	;error code from file I/O operations
;pbase:	ds	2	;screen-DMA address
;ysize:	ds	2	;screen width
;xsize:	ds	2	;screen height
;psize:	ds	2	;screen length

;rseed:	ds	8	;the random generator seed


args:
arg1:	ds	2
arg2:	ds	2
arg3:	ds	2
arg4:	ds	2
arg5:	ds	2
arg6:	ds	2
arg7:	ds	2
			;"arghak" puts args passed on stack here.

;iohack:	ds	6	;room for I/O subroutines for use by "inp"
			;and "outp" library routines

allocp:	ds	2	;pointer to free storage for use by "sbrk" func
alocmx:	dw	100H	;highest location to be made available to the
			;storage allocator

;room:	ds	30	;reserved for use by BDS C system code
;uroom:	ds	20	;available for use by user

	.comment	`
(Too much garbage here)
tmp	equ	room	;this is misc. garbage space
tmp1	equ	room+1
tmp2	equ	room+2
tmp2a	equ	room+4
ungetl	equ	room+6	;where characters are "ungotten"
unused	equ	room+7
curusr	equ	room+8	;used to save current user number during file I/O
usrnum	equ	room+9	;set by "setfcu" to user number of given filename

.mode	equ	room+10	;tty mode
freeze	equ	room+11	;true if output frozen (^S)
pending equ	room+12	;true if input character waiting
pendch	equ	room+13	;if pending true, this is the character
quitc	equ	room+14	;the general system abort character (^C usually)
spsav	equ	room+15	;saved SP value from CCP
;	equ	room+17	;where next thing goes

			`


tmp:	ds	1	;this is misc. garbage space
tmp1:	ds	1
tmp2:	ds	2
tmp2a:	ds	2
ungetl:	ds	1	;where characters are "ungotten"
;unused
curusr:	ds	1	;used to save current user number during file I/O
usrnum:	ds	1	;set by "setfcu" to user number of given filename

.mode:	ds	1	;tty mode
freeze:	ds	1	;true if output frozen (^S)
pending:ds	1	;true if input character waiting
pendch:	ds	1	;if pending true, this is the character
quitc:	ds	1	;the general system abort character (^C usually)
spsav:	ds	2	;saved SP value from CCP


echo	equ	1	;masks for "mode" byte...echo mode
quit	equ	2	;quit enabled
flow	equ	4	;^S/^Q protocol honored
strip	equ	8	;strip parity
expand	equ	16	;expand '\n' into CR-LF on output

;
;--------------------------------------------------------------------------
;
; The fcb table (fcbt): 36 bytes per file control block
;

;fcbt:	ds	36*nfcbs	;reserve room for fcb's (extra byte for IMDOS)


;
; The fd table: one byte per file specifying r/w/open as follows:
; 	bit 0 is high if open, low if closed
; 	bit 1 is high if open for read
; 	bit 2 is high if open for write	 (both b1 and b2 may be high)
;	bits 3-7 contain the user number in which the file is active (0-31)
;

fdt:	ds	3*nfcbs	;3 bytes per fcb: 1 for active, r/w, etc., and
			;		  2 to specify highest sector num seen

;
; The command line is copied here by init:
;

;
; End of CP/M-only data area
;---------------------------------------------------------------------------

.fcbt:		ds	2
.comlin:	ds	2
.arglst:	ds	2

_main	equ	$	;where "main" program will be loaded under CP/M

	.list

	end