;
; CCC.ASM:  BDS C Run-Time Package (C.CCC)	    v1.6, 2/86
;
; 	Copyright (c) 1982, 1983, 1986  by BD Software, Inc.
;
; This is the source to the BDS C run-time package module. When running
; in a standard CP/M system environment, the run-time package object module
; resides at the start of the TPA (typically 100h). The code generated by
; the BDS C Compiler usually has its origin immediately following the end of
; the run-time package module.
;
; This file may be assembled either by Digital Research's assemblers
; (ASM and MAC) or by Microsoft's assembler (M80/L80). Set the M80 symbol
; (below) to specify which assembler shall be used. The final result of the
; assembly is a run-time package module named "C.CCC", ready for use by
; CLINK.COM or L2.COM.
;
;	Assembly instructions for MAC.COM / ASM.COM:
;	(set  M80 to FALSE)
;		>asm ccc
;		>load ccc
;		>ren c.ccc=ccc.com
;
;	Assembly instructions with M80.COM for standard CP/M TPA operation:
;	(set M80 to TRUE)
;		>m80 ccc,ccc=ccc.asm
;		>l80 /p:100,ccc/n,ccc/e
;		>ren c.ccc=ccc.com
;

M80	EQU 	FALSE	;TRUE for M80 and L80, FALSE if using ASM/MAC and LOAD

;
; Equate statements in CAPITAL letters may be configured to control the
; following environmental and auxilliary options of the run-time environment:
;
;	a) operating system environment, or lack thereof  (CPM, MPM2)
;	b) recognition of the CP/M "user area" mechanism (USAREA)
;	c) CDB debugger interface (USERST, RSTNUM)
;	d) code compression through use of restart vectors 1-7 (ZOPT1-ZOPT7)
;
; All the above options (except CPM and sometimes ZOPT1-ZOPT7) may be altered
; freely WITHOUT requiring the reassembly of the CSM-coded portions of the 
; C library (object in DEFF2.CRL). Changing ZOPT1-ZOPT7 requires library
; reassembly only when PRESRV is set to FALSE.
;
; If generating code for an operating-system-independent application (when
; the CPM equate is set to FALSE), make sure to set the following values:
;
;	e) the origin of the run-time package code segment (ORIGIN)
;	f) the origin of the run-time package's local data area (RAM)
;	g) the transfer address upon program termination (EXITAD)
;

false	equ	0
true	equ	not false

CPM	EQU	TRUE	;True if to be run under any CP/M- or MP/M-like system
MPM2	EQU	FALSE	;True ONLY if running MP/M II (forces R/O file closes)

PRESRV	EQU	TRUE	;True to preserve CRL-file address compatibility
			;	under various ZOPT1-ZOPT7 configurations
			;(changing to FALSE will shorten run-time pkg., but
			;will require re-CASM-ing .CSM files for new DEFF2.CRL)

USAREA	EQU	TRUE	;True if "user areas" are implemented on target system

USERST	EQU	FALSE	;True to use a restart vector for CDB interfacing
RSTNUM	EQU	6	;Use "RST n" as default CDB vector (if USERST true)
			;(If used, be sure corresponding ZOPTn below is FALSE)
rstloc	equ    rstnum*8	;physical address of debugger restart vector

ZOPT1	EQU	FALSE	;The following five equates control the
ZOPT2	EQU	FALSE	;initialization of restart vectors 1 through 7
ZOPT3	EQU	FALSE	;(rst 1 - rst 7) for use by C programs to achieve
ZOPT4	EQU	FALSE	;optimum space efficiency. If any of these vectors are
ZOPT5	EQU	FALSE	;used by your system for I/O, set them FALSE here!
ZOPT6	EQU	FALSE	; (set FALSE if CDB w/RST 6 is to be used with object.)
ZOPT7	EQU	FALSE	; (set FALSE if DDT or SID are to be used with object.)

;
;	Use this section to configure run-time package
;	for non-CP/M-resident operation (e.g., for ROM):
;

	IF NOT CPM		;fill in the appropriate values...
ORIGIN	EQU	NEWBASE		;Address at which programs are to run
RAM	EQU	WHATEVER	;R/W memory area for non-CP/M configurations
				;(default: immediately after C.CCC under CP/M)
EXITAD	EQU	WHENDONE	;where to go when done executing
	ENDIF

;
; Some CP/M-specific symbolic values:
;

	if	cpm
NFCBS	EQU	8	;maximum # of files open at one time
base	equ	0	;start of system ram
bdos	equ	base+5	;bdos entry pt.
tpa	equ	base+100h
tbuff	equ	base+80h
origin	equ	tpa
exitad	equ	base	;warm boot location

conin	equ	1	;BDOS call codes...console input
cstat	equ	11	;interrogate console status
closec	equ	16	;close file
gsuser	equ	32	;get/set user code
	endif

;
; The location of the jump vectors and utility routines must remain
; constant relative to the beginning of this run-time module.
;
; Do NOT change ANYTHING between here and the start of the
; "init" routine!!!!!!!!
;

	IF NOT M80
	org	origin
	ENDIF

;
; 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 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

	IF	CPM
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	vstfcu	;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
	ENDIF

	IF	NOT CPM	;if not under CP/M, file I/O routines
	jmp	verror	;are not used.
	jmp	verror
	jmp	verror
	jmp	verror
	jmp	verror
	jmp	verror
	jmp	verror
	jmp	verror
	jmp	verror
	jmp	verror
	ENDIF

clrex:	jmp	vclrex	;routine to clear external data area

	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.
;

;
; long-displacement, double-byte external indirection:
;
;	format:	call ldei		; get 16-bit value in HL
;		dw offset_from_extrns	; >= 256
;

ldei:	pop	h	;get address of offset
	mov	e,m	;put offset in DE
	inx	h
	mov	d,m
	inx	h 		
	push	h	;save return address
	lhld	extrns	;add offset to external area base
	dad	d
mindir:	mov	a,m	;and get the value into HL
	inx	h
	mov	h,m
	mov	l,a
	ret

;
; short-displacement, double-byte external indirection:
;
;	format:		call sdei		; get 16-bit value in L
;			db offset_from_extrns	; < 256
;

sdei:	pop	h
	mov	e,m
	inx	h
	push	h
	mvi	d,0
	lhld	extrns
	dad	d
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	ret

;
; long-displacement, single-byte external indirection:
;
;	format:		call	lsei		; get 8-bit value in L
;			dw offset_from_extrns	; >= 256
;

lsei:	pop	h
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	push	h
	lhld	extrns
	dad	d
	mov	l,m
	ret

;
; short-displacement, single-byte external indirection:
;
;	format:		call	ssei		; get 8-bit value in L
;			db offset_from_externs	; < 256
;

ssei:	pop	h
	mov	e,m	
	inx	h
	push	h
	mvi	d,0
	lhld	extrns
	dad	d
	mov	l,m
	ret

;
; long-displacement, double-byte local indirection:
;
;	format:		call	ldli		; get 16-bit value in HL
;			dw offset_from_BC	; >= 256
;

ldli:	pop	h
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	push	h
	xchg
	dad	b
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	ret

;
; short-displacement, double-byte local indirection:
;
;	format:		call	sdli		; get 16-bit value in HL
;			db offset_from_BC	; < 256
;

sdli:	pop	h
	mov	e,m
	inx	h
	push	h
	xchg
	mvi	h,0
	dad	b
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	ret

;
; Flag conversion routines:
;

pzinh:	lxi	h,1	;return HL = true if Z set
	rz
	dcx	h
	ret

pnzinh:	lxi	h,0	;return HL = false if Z set
	rz
	inx	h
	ret

pcinh:	lxi	h,1	;return HL = true if C set
	rc
	dcx	h
	ret

pncinh:	lxi	h,0	;return HL = false if C set
	rc
	inx	h
	ret

ppinh:	lxi	h,1	;return HL = true if P (plus) flag set
	rp
	dcx	h
	ret

pminh:	lxi	h,1	;return HL = true if M (minus) flag set
	rm
	dcx	h
	ret

pzind:	lxi	d,1	;return DE = true if Z set
	rz
	dcx	d
	ret

pnzind:	lxi	d,0	;return DE = false if Z set
	rz
	inx	d
	ret

pcind:	lxi	d,1	;return DE = true if C set
	rc
	dcx	d
	ret

pncind:	lxi	d,0	;return DE = false if C set
	rc
	inx	d
	ret

ppind:	lxi	d,1	;return DE = true if P (plus) flag set
	rp
	dcx	d
	ret

pmind:	lxi	d,1	;return DE = true if M (minus) flag set
	rm
	dcx	d
	ret
	

;	
; 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

	IF PRESRV
	nop		;maintain address compatibility with some
	nop		; pre-release v1.4's.
	ENDIF

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:	jmp	usmul	;turns out signed and unsigned multipilication
			; are equivalent for 16 bits, so just do unsigned

			;rst optimization of function entry sequence (ZOPT1):
fentrc:	pop	d	;pop  arg byte address into DE
	push 	b	;save BC
	ldax	d	;put stack offset byte value into L, setting up
	mov	l,a	;	HL with negative stack offset
	mvi	h,0ffh
	inx	d	;DE now points to return address
	dad	sp	;calculate new SP value
	sphl		;set new SP value
	mov	b,h	;place into BC as new frame base ptr
	mov	c,l	
	xchg		;put return address in HL
	pchl		;and return
	

smul2:	lda	tmp
	rar
	rnc
	jmp	cmh

	ds	3	;preserve address compatibility with previous versions

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.
;
; The mnemonics are "Move Arg #n To HL",
; where arg #1 is the third thing on the stack (where the first
; and second things are, respectively, the return address of the
; routine making the call	to here, and the previous return
; address to the routine which actually pushed the args on the
; stack.) Thus, a call	to "ma1toh" would return with the first
; passed parameter in HL and A; "ma2toh" would return the second,
; etc. Note that if the caller has pushed [n] items on the stack
; before calling "ma [x] toh", then the [x-n]th formal parameter
; value will be returned, not the [x]th.
;

ma1toh:	lxi	h,4	;get first arg
ma0toh:	dad	sp
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	ret

ma2toh:	lxi	h,6	;get 2nd arg
	jmp	ma0toh

ma3toh:	lxi	h,8	;get 3rd arg
	jmp	ma0toh

ma4toh:	lxi	h,10	;get 4th arg
	jmp	ma0toh

ma5toh:	lxi	h,12	;get 5th arg
	jmp	ma0toh

ma6toh:	lxi	h,14	;get 6th arg
	jmp	ma0toh

ma7toh:	lxi	h,16	;get 7th arg
	jmp	ma0toh

;
; 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.
;

arghak:	lxi	d,args	;destination for block move in DE
	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).
;


;
; This routine is called first to do argc & argv processing (if
; running under CP/M) and other initializations:
;

init:	pop	h	;store return address
	shld	tmp2	; somewhere safe for the time being

	IF	CPM
	lxi	h,arglst-2	;set up "argv" for the C main program
	ENDIF
	
	IF	NOT CPM
	lxi	h,0
	ENDIF

	push	h

			;Initialize storage allocation pointers:
	lhld	freram	;get address after end of externals
	shld	allocp	;store at allocation pointer (for "sbrk.")
	lxi	h,1000	;default safety space between stack and
	shld	alocmx	; highest allocatable address in memory 
			; (for use by "sbrk".).

			;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.

	IF	CPM
	call	khack		;initialize Kirkland debugger vector
	ENDIF

	IF	CPM	;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:	lxi	h,tbuff		;if arguments given, process them.
	lxi	d,comlin	;get ready to copy command line
	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

	lxi	h,comlin	;now compute pointers to each arg
	lxi	d,1		;arg count
	lxi	b,arglst	;where pointers will all go
	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
	ENDIF

	IF	NOT CPM	;if not under CP/M, force ARGC value	
	lxi	h,1	; of one.
	push	h
	ENDIF

	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

	mvi	a,0c3h	;CC '-Z' optimization initialization

;
; -Z optimization initializations:
;

	IF	ZOPT1
	sta	8	;rst 1: jmp fentrc
	lxi	h,fentrc
	shld	9
	ENDIF

	IF	NOT ZOPT1 AND PRESRV
	nop
	dw	0,0,0,0		;more NOPs
	ENDIF


	IF	ZOPT2
	sta	10h
	lxi	h,fexitc ;rst 2:jmp fexitc
	shld	11h
	ENDIF

	IF	NOT ZOPT2 AND PRESRV
	nop
	dw	0,0,0,0		;more NOPs
	ENDIF


	IF	ZOPT5
	sta	28h	;rst5:	jmp sdli
	lxi	h,sdli
	shld	29h
	ENDIF	

	IF	NOT ZOPT5 AND PRESRV
	nop
	dw	0,0,0,0		;more NOPs
	ENDIF


 	IF	ZOPT6
	sta	30h	;rst6:	jmp ldli
	lxi	h,ldli
	shld	31h
	ENDIF

	IF	NOT ZOPT6 AND PRESRV
	nop
	dw	0,0,0,0		;more NOPs
	ENDIF


	IF	ZOPT3
	lxi	h,237eh	;rst3:	mov a,m
	shld	18h	;	inx h
	lxi	h,6f66h	;	mov h,m
	shld	1ah	;	mov l,a
	mvi	a,0c9h	;	ret
	sta	1ch
	ENDIF

	IF	NOT ZOPT3 AND PRESRV
	nop
	dw	0,0,0,0		;more NOPs
	dw	0,0,0,0
	ENDIF


	IF	ZOPT4
	lxi 	h,2373h	;rst4:	mov m,e
	shld	20h	;	inx h
	lxi	h,0c972h ;	mov m,d
	shld	22h	;	ret
	ENDIF

	IF	NOT ZOPT4 AND PRESRV
	dw	0,0,0	;lotsa NOPs
	dw	0,0,0
	ENDIF


	IF	ZOPT7
	lxi	h,235eh
	shld	38h
	lxi	h,0c956h
	shld	3ah

	lxi	h,2b72h
	shld	3ch
	lxi	h,0c973h
	shld	3eh
	ENDIF

	IF	NOT ZOPT7 AND PRESRV
	dw	0,0,0,0,0,0	;you guessed it -- NOPs
	dw	0,0,0,0,0,0
	ENDIF

	lhld	tmp2
	pchl		;all done initializing.
	
	IF	ZOPT2	;object of rst 2 vector, if enabled
fexitc:	pop	d	;get offset address
	xchg		;return value in DE, &offset in HL
	mov	l,m	;put byte offset in HL
	mvi	h,0
	dad	sp	;add to SP
	sphl
	xchg		;put return value back in HL
	pop	b	;restore BC
	ret		;and return to previous function
	ENDIF

	IF	NOT ZOPT2 AND PRESRV
	dw	0,0,0	;NOPs
	dw	0,0
	ENDIF


;
; The following two routines are used when the "-tn" CLINK option
; is given, in order to preserve the SP value passed to the transient
; command by the CCP and return to the CCP after execution without
; needing to perform a warm-boot.
;

	IF CPM
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
	ENDIF

;
; 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:
;

	IF USERST
vkhack:	lxi	h,0E1H+2300H	;pop h - inx h
	shld	rstloc		; put at "RST 6" location (or wherever)
	lxi	h,023H+0E900H	;inx h - pchl
	shld	rstloc+2
	ret
	ENDIF

	IF NOT USERST
vkhack:	ret
	ENDIF

	IF NOT USERST AND PRESRV
	ds 12
	ENDIF

;
; 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	CPM		;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
	ENDIF

	jmp	fexitv		;done closing...now return
				; to CP/M or whatever.


;
; Close the file whose fd is 1st arg:
;

	IF	CPM	;here comes a lot of CP/M stuff...
vclose:
	call	ma1toh	;get fd in A
	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

	ENDIF

	IF CPM AND NOT MPM2	;if not MP/M, and
	jz	close2	;the file isn't open for write, don't bother to close
	ENDIF

	IF CPM AND MPM2	AND PRESRV  ;always close all files under MP/M
	nop
	nop
	nop
	ENDIF

	IF CPM
	push	h	;save fd table entry addr
	call	ma2toh	;get the fd in A again
	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

;
; 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 (/).

vstfcu: 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
	ENDIF

	IF	CPM AND USAREA
	call	bdos	;get current user area if implemented
	ENDIF

	IF	CPM AND NOT USAREA
	mvi	a,0
	nop
	ENDIF

	IF	CPM
	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
	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
	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
; use 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
	ENDIF

	IF	CPM AND USAREA
	call	bdos
	ENDIF

	IF 	CPM AND NOT USAREA
	mvi	a,0
	nop
	ENDIF

	IF CPM
	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
	ENDIF

	IF	CPM AND USAREA
	call	bdos
	ENDIF

	IF	CPM AND NOT USAREA AND PRESRV
	nop
	nop
	nop
	ENDIF

	IF	CPM
	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

	ENDIF		;end of CP/M-related file I/O routines


	IF	NOT CPM
main:	equ	$	;where main program resides when not under CP/M
			;(under CP/M, the data area comes first)
	ENDIF


;
; Ram area:
;

	IF	CPM	; Plug this value into BDS.LIB before CASM'ing
ram	equ	$	; the new library. The "org ram" at the end of this
	ENDIF		; source file should cause the assembler to print
			; the value of "ram" at the end of the assembly.

	IF	NOT CPM
	org	ram	;if not under CP/M, use custom ram area address
	ENDIF

errnum:	ds	1	;error code from file I/O operations
rseed:	ds	8	;the random generator seed
args:	ds	14	;"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:	ds	2	;highest location to be made available to the
			;storage allocator

			;20 bytes of misc. scratch & state variables:
tmp	ds	1
tmp1	ds	1
tmp2	ds 	2
tmp2a	ds	2
unused	ds	2

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

			;Console I/O control data:
chmode	db	0	;0: single char mode, 1: line buffered mode
nleft	db	0	;# of chars left in buffer (if chmode == 1)
ungetl	db	0	;"ungetch" data byte (0 if no char pushback)
iobrf	db	1	;check for break on character input/output

spsav	ds	2	;BDOS's saved SP value upon entry from CCP

	ds	4	;total of 20 bytes of misc. data area

;
;--------------------------------------------------------------------------
; The following data areas are needed only if running under CP/M:
;

	IF	CPM
;
; 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: three bytes per file specifying r/w/open as follows:
;   BYTE 1:
; 	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)
;   BYTES 2&3:
;	Highest sector number seen so far during I/O (for cfsize calls)
;

fdt:	ds	3*nfcbs

;
; The command line is copied here by init:
;

comlin:	ds	131	;copy of the command line pointed to by entries
			;in arglst


;
; This is where "init" places the array of argument pointers:
;

arglst:	ds	40	;the "argv" paramater points here (well,
			;actually to 2 bytes before arglst). Thus,
			;up to 20 parameters may be passed to "main"
	ENDIF

;
; End of CP/M-only data area
;---------------------------------------------------------------------------

	IF	CPM
main	equ	$	;where "main" program will be loaded under CP/M
	ENDIF

	IF NOT M80
	org	ram	;set next pc value back to ram origin, so the value
	ENDIF		;will be displayed by the assembler for convenience

	end

