;
; cc2e.asm:
; Non-text utility routines:
;

;
; Complement HL register:
; (Good 'ole simple subroutine. Aint too many like this one 
;  around anymore...)
;

cmh:	push psw
	mov a,h
	cma
	mov h,a
	mov a,l
	cma
	mov l,a
	inx h
	pop psw
	ret

;
; Generate a new label number:
;

glbl:	lhld lbln
	inx h
	shld lbln
	dcx h
	ret

;
; Get a label and put it in sr0:
;

glblr0:	push h
	call glbl
	shld sr0
	pop h
	ret


;
; Given symbol number in HL, assume that the given
; st entry is a structure, and return the size of 
; the structure in HL. Note that if the value has
; high order byte set to FF, then the structure was
; never properly defined and using it constitutes an
; error.
;

getsz:	push d
	dad h
	dad h
	dad h
	lxi d,st+4
	dad d
	mov a,m
	inx h
	mov h,m
	mov l,a
	pop d
	mov a,h
	cpi 255
	rnz
	push d
	lxi d,stg17a
	call perr
	pop d
	ret

;
; Generate a byte of code given in A:
;

genb:	push psw
	call genb1
	pop psw
	ret

genb1:	push h
	push b
	mov b,a		;save byte in B
	lda codflg	;code generation enabled?
	ora a
	jz genb3	;return if not
	lhld pshpp	;need to push some prior value
	mov a,m
	ani 0a0h	; in a register?
	cnz genpsh	;if so, go do it.
	lhld codp
	mov m,b
	inx h
	shld codp

;
; Check for memory overflow:
;

genb1a:	lda cdp+1	;get high byte of CCI text ptr
	mov l,a
	mov a,h		;get high byte of code area pointer
	cmp l		;less than CCI pointer?
	jc genb3

	IF MARC
	lda maxmd	;maxmem call done?
	ora a 
	jz genb2	;if not, go try it...
	ENDIF

	IF CPM
	lda ccpok	;CCP still intact?
	ora a
	jnz genb2	;if so, go get rid of it
	ENDIF

genb1b:	lxi d,stgom	;if all that can be done has been done, error...
	jmp perrab
	
;
; Now get more memory by calling maxmem (MARC) or overwriting the shell (CP/M):
;

genb2:
	IF CPM
	xra a
	sta ccpok	;CCP not intact anymore
	push d
	push h
	call nudge	;move code up a bit

	lhld bdosp
	mvi l,0
	shld curtop	;new current top of memory
	pop h
	pop d
	ENDIF

genb3:	pop b		;wrap up and return
	pop h
	mov a,b
	ret

;
; Move cci text up into the memory space just vacated by making
; the shell go away:
;

nudge:	lhld cdp	;compute size of block to be moved
	call cmh
	xchg
	lhld curtop	;get EOF address in HL
	dcx h
	dcx h		;this was the destination of the "mvup" move
	dad d		;subtract starting address
	inx h		;add one to get block size

	mov b,h		;move to BC
	mov c,l

	lhld bdosp	;put destination address in DE
	mvi l,0

	dcx h
	push h		;save for later computations
	xchg
	lhld curtop	;put eof address (source area pointer) in HL
	dcx h
	dcx h
	mvi a,2		;check if we're on a Z80 or 8080
	inr a
	jpe nudge80
	db 0edh, 0b8h	;Z80: do block move	
	jmp nudge2

nudge80:mov a,m
	stax d
	dcx h
	dcx d
	dcx b
	mov a,b
	ora c
	jnz nudge80	
	
nudge2: pop d		;pop curtop-1 into DE
	lhld curtop	;get old eof address
	dcx h
	dcx h
	call cmh
	dad d		;HL now equals the offset for the block move.
	xchg		;put offset in DE
	lhld cdp	;bump cdp by the offset
	dad d
	shld cdp
	lhld stgad	;and bump the string address by the offset
	dad d
	shld stgad
	ret		;all done
	


;
; This is the main code generation routine. Given a macro pointed
; to by DE, it decodes special bytes and uses the genb routine to
; actually generated bytes of code:
;

mcrog:	push psw
	call mcrog1
	pop psw
	ret

mcrog1:	lda codflg	;code generation enabled?
	ora a
	rz		;if not, don't generate any code!
	push h
	push b
mg1:	ldax d
	cpi 38h		;end of macro?
	jnz mg1a
	pop b		;yes. return.
	pop h
	ret

mg1a:	cpi 0cbh	;code to enter relocation parameter
	jnz mg2		;for current code location?
	call entr	;yes. Enter in ref table
	inx d		;and go for next macro byte.
	jmp mg1

mg2:	cpi 0efh	;code to enter symbolic reference?
	jnz mg2a
	call entr	;yes. Enter relocation parameter
	inx d		;get following sr code
	ldax d
	push d		; (note: sr means `special register')
	call tstsr
	call cnvsr	;get the value in the sr
	xchg
	call entrf	;and enter symbolic reference
	pop d		;restore macro text pointer
	jmp mg1		;and go for next byte
mg2a:	cpi litrl	;do we take the next 2 bytes literally?
	jnz mg3

	push h
	push b
	inx d		;yes. get them, add them to cccadr and generate...
	ldax d
	mov c,a
	inx d
	ldax d
	mov b,a
	lhld cccadr
	dad b
	mov a,l
	call genb
	mov a,h
	call genb
	pop b
	pop h

	inx d
	jmp mg1

		
mg3:	call tstsr	;sr code?
	jc mg4
	push d		;yes. Convert to value in sr and generate
	call cnvsr
	mov a,l
	call genb
	mov a,h
	call genb
	pop d
	inx d
	jmp mg1

mg4:	mov b,a		;symbolic label definition?
	ori 38h
	inr a
	mov a,b
	jnz mg6
	cpi 0e8h
	jnc mg6		;yes. Figure out which sr to get label
	cmc		;value from...
	rar
	rar
	rar
	ani 7
	push d
	call cnvsr	;get the value
	xchg
	call entl	;enter in label table
	pop d
	inx d
	jmp mg1

mg6:	call genb	;if none of the above, take the
	inx d		;value literally
	jmp mg1

;
; Tests if the value in A is a special register (sr) code; i.e.,
;  8 or 10h or 18h or 20h or 28h or 30h. 
; If not, returns C set.
; If so, return 0 for sr0, 1 for sr1, 2 for sr2, etc.
;

tstsr:	mov b,a
	ani 38h
	cmp b
	mov a,b
	stc
	rnz
	ora a
	stc
	rz
	cpi 31h
	cmc
	rc
	rar
	rar
	rar
	dcr a
	ret

;
; Given A equal to the return value of a successful tstsr
; call, returns (in HL) the value of the corresponding sr:
;

cnvsr:	push d
	mov e,a
	mvi d,0
	lxi h,sr0
	dad d
	dad d
	mov a,m
	inx h
	mov h,m
	mov l,a
	pop d
	ret

;
; Enters the value of the code-generation PC into the relocation
; table, so that a relocation parameter gets generated for the
; location:
;

entr:	push h
	push d
	lhld cdstrt
	call cmh
	xchg
	lhld codp
	dad d
	xchg
	lhld relp
	mov m,e
	inx h
	mov m,d
	inx h
	shld relp
	lhld relc
	inx h
	shld relc
	pop d
	pop h
	ret

;
; Enters the current code generation PC as the value for the
; symbolic label given in DE:
;


entl:	push h
	push d
	lhld lblp
	mov m,e
	inx h
	mov m,d
	inx h
	xchg
	lhld codp
	xchg
	push h
	lhld cdstrt
	call cmh
	dad d
	xchg
	pop h
	mov m,e
	inx h
	mov m,d
	inx h
	shld lblp
	lhld lblc
	inx h
	shld lblc
	pop d
	pop h
	ret

;
; Enters, in the symbol reference table, a reference
; to the symbolic label given in DE:
;

entrf:	push h

	push d		;save label code
	lxi h,0		;check for table overflow by seeing
	dad sp		;if the ref table pointer has approached
	xchg		;the stack...
	lhld lbrp
	push h
	inx h		;if lbrp+4 isn't greater than the current SP,
	inx h		;then complain and abort.
	inx h
	inx h
	call checkb	;this function checks HL against DE (HL must be < DE)f
	pop h		;no problem.	
	pop d		;restore label code and go ahead with the table entry

	mov m,e
	inx h
	mov m,d
	inx h
	xchg
	lhld codp
	xchg
	mov m,e
	inx h
	mov m,d
	inx h
	shld lbrp
	lhld lbrc
	inx h
	shld lbrc
	pop h
	ret

;
; Process a function:
;

dofun:	lxi h,pshptb	;initialize pushop table so genb's won't
	shld pshpp	;cause stray D5's and E5's all over
	mvi m,0		;the place during pre-statement code generation!

	call idir	;insert the name in the directory
	call ifun	;build the list of needed function names
	lxi h,relt	;initialize the relocation parameter table
	shld relp
	lxi h,lblt	;and the label definition table
	shld lblp
	lxi h,lbrt	;and the label reference table
	shld lbrp

	lxi h,0
	shld relc	;and the relocation parameter count,
	shld lblc	;	the label count,
	shld lbrc	;	and the label reference count.
	shld strtb	;and clear the string table

	lhld codp	;do some more nitty-gritty initialization
	shld modsa	;to make the crufty flush routine work
	inx h		;correctly (once it did, I completely forgot
	inx h		;how it works and don't know what most of these
	shld codp	;values do. And it really doesn't matter anyway...)
	call insjl	;insert the jump vector list.
	call paslst	;pass formal parameter list
	call fentry	;generate upon-entry-to-function code segment
	call glbl	;get function-exit location label
	shld fexlab	;save for use by "return" processor
	lhld cdp
	call igsht
	cpi lbrcd	;function body begin with a `{' ?
	jz dofun1	;if so, Ok

	lxi d,stgmlb	;else bitch
	call perr

dofun1:	call state0	;generate code for the body of the function (actually
	shld cdp	;  a function is just a big compound statement)
	call fexit	;generate exit code
	call flshst	;flush string texts onto end of the function
	call cktbf	;check for table overflows
	call rslvl	;resolve label references
	lhld cdstrt
	call cmh
	xchg
	lhld codp
	dad d		;get length of function code
	xchg		;put into DE
	lhld modsa	;store following list of needed functions
	mov m,e
	inx h
	mov m,d
	call insrd	;and append relocation parameter list
	ret

;
; Pass formal parameter list:
;

paslst:	lhld cdp
	call igsht
	cpi varcd
	cnz ierror
	inx h! inx h! inx h	;pass over function name
	call igsht
	inx h		;pass over open paren
	xra a
	sta nofrmls	;clear no-formals flag
	call igsht	;first thing a close paren?
	cpi close
	jnz pasl2
	sta nofrmls	;yes: set no-formals flag to optimize entry code
pasl0:	call igsht
pasl1:	cpi close	;close paren (end of arg list)?
	jnz pasl2
	inx h		;yes. pass it and return.
	call igsht
	shld cdp
	ret

pasl2:	call lookup
	cpi comma	;if not comma,
	jnz pasl1	;check for close
	inx h
	jmp pasl0

;
; Generate code to handle function entry (this goes at top of
; every function to allocate local stack space and set new BC,
; saving old BC on stack:
;

fentry:	lxi d,mfntry
	lhld sfsiz	;null stack frame size?
	mov a,h
	ora l
	jnz fntry2	;if not, go handle that case.

	lda nofrmls	;we have null frame. null formal param list also?
	ora a
	rnz		;if so, don't generate any code
	lxi d,mfntr2	;else like normal, except no "sphl" (big deal)
;	jmp fntry3	;go try for -z optimized entry sequence
	jmp fntry4	;woops...doesn't quite work if sfsiz = 0; do bulky

fntry2:	mov a,h		;ok, we have at least some stack frame to deal with
	ora a		;more than 255 bytes?
	jnz fntry4	;if so, handle with normal bulky code sequence

fntry3:	lda optimf	;doing function entry optimization?
	ani 1
	jz fntry4	;if not, go handle with normal code sequence	

 	mvi a,0cfh	;else generate rst 1 followed by negated 
	call genb	; 	8-bit stack offset
	mov a,l
	cma	
	inr a
	call genb
	ret

fntry4:	call cmh
	shld sr0
	call mcrog
	ret


;
; Generate function exit code (this goes at end of every function
; to de-allocate local stack space and restore old BC):
;

inxsp:	equ 33h		;"inx sp" op

fexit:	lhld fexlab	;ready to define exit sequence label
	shld sr1

	lxi d,mfex1	;define exit label
	call mcrog

	lhld sfsiz	;set up stack size to reset SP
	shld sr0

	mov a,h
	ora l		;was stack frame size 0?
	jnz fexit2	;if so, go handle simple cases

	lxi d,mfex4	;OK, frame size is 0...
	lda nofrmls	;null formal parameter list?
	ora a
	jnz mcrog	;if so, use trivial exit sequence

	lxi d,mfex3	;0 frame size w/formal parms exit sequence
	jmp mcrog

fexit2:	lxi d,mfex2	;non-0 frame size.
	mov a,h		;frame size > 255?
	ora a
	jnz mcrog	;if so, handle with bulky exit sequence

	lda optimf	;-z optimizing exit sequence
	ani 2	
	jz fexit3	;if not, use in-line code
	mvi a,0d7h	;rst 2
	call genb
	mov a,l		;SP offset value
	call genb
	ret

fexit3:	lxi d,6		;cmpdh compares d to h
	call cmpdh	;return Cy set if stack size less than 7
	lxi d,mfex2
	jc mcrog	;if frame size >= 7, go do long exit sequence
	
fexit4:	mvi a,inxsp	;generate "inx sp" n times, where n is stack
	call genb	;frame size
	dcr l
	jnz fexit4
	lxi d,mfex3	;generate final pop b and return
	call mcrog
	ret

;
; Flush string constants that have been built up in strtb
; onto the tail end of the function:
;

flshst:	lxi h,strtb
flst1:	mov e,m		;get label code (or terminating 0000)
	inx h
	mov d,m
	inx h
	mov a,d		;all done?
	ora e
	rz		;if so, return
	call entl	;else register the label code for this string
	mov e,m		;get text pointer into DE
	inx h
	mov d,m
	inx h
	ldax d		;get length byte
	mov b,a		;store in B
	inr b
flst3:	dcr b		;done with body of text?
	jz flst4
	inx d		;no. get and generate next byte
	ldax d
	call genb
	jmp flst3

flst4:	xra a		;generate trailing null byte
	call genb
	jmp flst1	;and go for next string	


;
; This routine looks at all the table pointers and
; makes sure we didn't have an overflow; if we did,
; complain and abort.
;

cktbf:
	lxi d,lblt
	lhld relp
	call checkb	;check that HL < DE
	lxi d,lbrt
	lhld lblp
	call checkb
	ret		;no overflows.

checkb:	mov a,h
	cmp d
	rc
	jnz ftberr
	mov a,l
	cmp e
	rc
ftberr:	call pmodnc
	lxi d,stgftb
	call pstg
	lhld namsav	;print name of bad function
pnamlp:	mov a,m
	cpi 9dh		;main?
	jz pmain	;if so, handle specially
	ani 7fh
	call outch
	mov a,m
	inx h
	ora a
	jp pnamlp

pnam2:
	lxi d,stgtb2	;print rest of message
	call pstg
	jmp errab	;and abort

;
; The representation of "main" is a keyword, so we
; have to kludge it:
;

pmain:	lxi d,stgmn
	call pstg
	jmp pnam2

stgmn:	db 'main',0


;
; Enter the name of the function in the CRL directory:
;

idir:	lhld nlcnt
	push h
	lhld cdp
	call igsht
	cpi varcd
	cnz ierror

	push h		;initialize for Kirkland interrupt generation
	lhld nlcnt
	shld kblin	;save line number where function begins
	lxi h,0
	shld kllin	;null out last line value
	pop h

	inx h
	mov e,m
	inx h
	mov d,m
	pop h
	shld nlcnt
	push d
	call lookp2
	xra a
	sta ftypec
	lda indc1
	ora a
	jnz idirz
	lda typ1
	ani 7
	jnz idirz
	inr a
	sta ftypec

idirz:	lhld fntb
	pop d
	call ifntf
	xchg
	lhld dirp
	shld namsav	;save pointer to name of function
idir1:	ldax d
	call mapuc
	mov m,a
	inx h
	inx d
	ora a
	jp idir1

	push h
	lhld codp
	xchg
	lhld cdao
	dad d
	xchg
	pop h
	mov m,e
	inx h
	mov m,d
	inx h
	shld dirp
	lxi d,endir-3
	call cmpdh	;return Cy set if DE < HL
	lxi d,s2a	;directory overflow
	cc perrab
	mov h,b
	mov l,c
	dad h
	dad h
	dad h
	lxi d,st+2
	dad d
	mov a,m
	inx h
	mov h,m
	mov l,a
	shld sfsiz
	ret

ifntf:	mov c,m
	inx h
	mov b,m
	inx h
	mov a,b
	cmp d
	jnz ifnf2
	mov a,c
	cmp e
	rz
ifnf2:	mov a,m
	inx h
	ora a
	jp ifnf2
	jmp ifntf

;
; Generate list of needed function names by going through
; the symbol table and sticking in the name of any function
; reference whose entry number is the same as that for the
; current function being processed:
;

ifun:	lxi h,st
	shld stmp
	lxi h,relt
	shld relp
	mvi b,0
	lhld stno
	xchg
ifun1:	mov a,d
	ora e
	jz ifun2
	lhld stmp
	mov a,m
	inx h
	ani 3
	cpi 3
	jnz ifun3
	lda entn
	mov c,a
	mov a,m
	ani 3fh
	cmp c
	jz ifuni

ifun3:	push d
	lxi d,7
	dad d
	shld stmp
	pop d
	dcx d
	jmp ifun1

ifun2:	lhld relp
	mvi m,0
	inx h
	mov a,b
	sta nfns
	xchg
	lxi h,relt
	call cmh
	dad d
	mov b,h
	mov c,l
	lxi d,relt

ifun4:	ldax d
	call genb
	inx d
	dcx b
	mov a,b
	ora c
	jnz ifun4
	ret

ifuni:	push h
	push d
	lhld stno
	xchg
	call cmh
	dad d
	xchg
	lhld fntb
	push b
	call ifntf
	mov a,m
	cpi 9dh
	jz ifuni3
	xchg
	lhld relp
ifuni2:	ldax d
	call mapuc
	mov m,a
	inx h
	inx d
	ora a
	jp ifuni2
	shld relp
ifuni3:	pop b
	inr b
	pop d
	pop h
	jmp ifun3

;
; Insert a "jmp 0" for each function in the list of needed functions:
;

insjl:	lhld codp
	shld cdstrt
	call glbl
	push h
	shld sr0
	lda nfns	;if no functions, don't generate the
	ora a		;  jump around non-existent jump list.
	jz insjl2
	lxi d,mac37	;generate jmp around jump list
	call mcrog
	lda nfns

insj1:	push psw
	lxi d,mac38
	call mcrog	;generate dummy jmp instruction, the
	pop psw		;operand of which is later filled in
	dcr a		;by CLINK
	jnz insj1
insjl2:	pop h
	xchg
	call entl	;define beginning of actual function code
	ret

;	
; Generate the code for a single C statment (may be a single COMPOUND
; statment, of course) pointed to by HL:
;

levno:	ds 1

state0:	xra a
	sta levno	;level number, so we know when at top level

state:	call igsht	;pass by crap
	cpi lblcd	;is it a label code?
	jz st1

	cpi labrc
	jnz st2
	call ierror	;call, but never to return...

st1:	inx h		;yes. enter it into the label table
	mov e,m
	inx h
	mov d,m
	inx h
	call entl
	jmp state	;and go for the REAL statment

st2:	cpi lbrcd	;left curly-bracket?
	jnz st4
	
	lda levno	;bump level count
	inr a
	sta levno

	inx h		;yes. Keep doing statements until
st2a:	call igsht	;a matching right curly-bracket is found...
	cpi rbrcd
	jnz st3
	lda levno	;debump level number
	dcr a
	sta levno
	inx h		;found it. all done.
	ret

st3:	call state	;inside curly brackets. Do a statement
	jmp st2a	;and loop

st4:	cpi semi	;null statement?
	jnz stgoto
	inx h		;yes.
	ret		;don't do much in that case.

kirkli:	push psw	;save PSW while we take care of kirkland interrupt
	lda cdbflg
	ora a
	jz kirkdn	;if not in Kirkland mode, don't generate interrupt

	push b		;save BC
	push h		;save HL
	rlc		;rotate interrupt number into bits 3-5
	rlc
	rlc
	ori 0c7h	;make into restart op
	call genb	;and generate the restart

	lhld kllin	;get last line that had interrupt generated
	xchg		;put in DE
	lhld nlcnt	;get current line number in HL
	call cmpdh	;still on same current line?
	mvi a,0
	jnz dok3	;if not, clear count
	lda klcnt	;else bump count of interrupts on this line
	inr a
dok3:	sta klcnt	;save current line interrupt count
	shld kllin	;make current line the last interrupt line	
	
	xchg		;put current line in DE
	lhld kblin	;get function starting line
	call cmh	;subtract from current line
	dad d
	inx h		;and bump for true line number (first = 1)
	mov a,l
	call genb	;generate line number word
	lda klcnt	;get current line interrupt count
	rlc		;put in high order 4 bits
	rlc
	rlc
	rlc
	ani 0f0h	;keep only high bits
	add h		;add to line number's high order byte
	call genb	;and send it out
	pop h		;restore registers
	pop b
kirkdn:	pop psw
	ret

stgoto:	cpi gotcd	;goto?
	jnz stif
	call kirkli	;handle kirkland interruprt
	inx h		;yes.
	call igsht
	cpi labrc	;must be followed by a label reference code
	cnz ierror
	inx h		;OK, we found a label reference code. Enter
	mov e,m		;it in the label reference table.
	inx h
	mov d,m
	inx h
	xchg
	shld sr0
	xchg
	lxi d,mac37	;and generate a jmp instruction
	call mcrog
	call psemi	;pass by semi
	ret

stif:	cpi ifcd	;"if" statement?
	jnz stwhil
	call kirkli	;handle kirkland interrupt
	call ltabmp	;bump label table
	inx h		;yes.
	call igsht	;look for open paren
	cpi open

	push d
	lxi d,stgeop
	cnz perrab	;internal error: missing {
	pop d

	inx h		;pass over it
	call rpshp
	call expr	;evaluate condition
	call ppshp
	cpi close	;followed by close paren?

	push d
	lxi d,stgecp
	cnz perrab
	pop d

	inx h
	call gncjf
	call ltabtd
	call state
	call igsht
	cpi elscd
	jz stifel
	call ltabfd
	call ltabpp
	ret

stifel:	call gfjmp
	call ltabfd
	call ltabpp
	inx h
	call state
	call plvdl
	ret


stwhil:	cpi whlcd	;"while" statement?
	jnz stdo
	inx h		;yes.
	mov a,m
	cpi lblcd
	cnz ierror
	inx h
	mov e,m
	inx h
	mov d,m
	inx h
	call entl
	call ltabmp
	call igsht
	call igsht
	cpi open

	push d
	lxi d,stgeop
	cnz perrab
	pop d

	call kirkli	;insert kirkland interrupt
	inx h
	call rpshp
	call expr	;evaluate condition
	call ppshp
	cpi close	;close paren?

	push d
	lxi d,stgecp
	cnz perrab
	pop d

	inx h
	call gncjf
	call ltabtd
	call state	;generate code for the body of the statment
	call state	;and eat up the trailing "goto" stuck in by CC1
	call ltabfd
	call ltabpp
	ret

stdo:	cpi docd	;"do" statement?
	jnz stret
	inx h
	call ltabmp
	call fltbtd
	call state	;generate code for body
	call igsht
	cpi whlcd	;make sure there's a "while"
	cnz ierror
	inx h		;ok, there is.
	call igsht
	cpi lblcd
	jnz stdo1
	inx h
	inx h
	inx h
stdo1:	call kirkli	;insert kirkland interrupt
	call rpshp
	call expr	;evaluate condition
	call ppshp
	call gncjt
	call ltabfd
	call ltabpp
	call igsht	;check for trailing semicolon
	cpi semi

	push d
	lxi d,s4
	jnz perrab
	pop d

	inx h		;and pass over it if it is there (should be)
	ret

stret:	cpi rencd	;"return" statment?
	jnz stswit

	call kirkli	;insert kirkland interrupt
	inx h		;yes.
	call igsht
	cpi semi	;does it have an argument?
	jz stret2	;if not, go handle trivial case

	call ltabmp	;bump ltab with dummy entry
	mvi a,81h
	sta val		;MUST have value, at all costs.
	call rpshp
	call expr0	;else evaluate argument.
	call ppshp
	call flshh1	;make sure we get a value
	call ltabtd	;define true and false
	call ltabfd	;ltab locations
	call ltabpp	;and pop ltab entry

	lda ftypec	;and zero out the high-
	ora a		;order byte if either the type
	jz stret1	;of the function is char, or...
	lxi d,mac61
	call mcrog
	jmp stret2

stret1:	call tschr
	jnz stret2
	lxi d,mac61	;the type of the function is int and
	call mcrog	;the type of the return value is char.

stret2:	push h
	lhld fexlab	;get exit label
	shld sr0
	pop h
	call psemi
	call peeknxt	;peek at next token
	cpi rbrcd	;next token a close curly brace?
	jnz stret3
	lda levno	;yes. are we at top level of function?
	cpi 1
	rz		;if so, don't generate any jumps or exit code
	
stret3:	push h
	lhld sfsiz	;if sfsiz is non-zero
	mov a,h
	ora l
	pop h
	jnz stret4	;then go handle that case

	lxi d,mfex4	;else frame size is 0...
	lda nofrmls	;null formal parameter list?
	ora a
	jnz mcrog	;if so, use trivial exit sequence

	lxi d,mfex3	;0 frame size w/formal parms exit sequence
	jmp mcrog

stret4:	push h
	lhld sfsiz	;get frame size again
	mov a,h
	ora a		;if frame size > 255,
	jnz stret5	; go use bulky sequence
	lda optimf	;else check for -z function exit optimization
	ani 2
	jz stret5
	mvi a,0d7h	;rst 2
	call genb
	mov a,l		;SP offset byte
	call genb
	pop h		;and all done
	ret

stret5:	lxi d,mac36	;use this for "jmp fexlab"
	call mcrog	;use "jmp fexlab" if non-zero stack frame size
	pop h
	ret


stswit:	cpi swtcd	;"switch" statment?
	jz st11		;if so, go process
	cpi rbrcd	;right curly bracket?
	rz		;if so, ignore it
	call kirkli	;insert kirkland interrupt for expression statement
	call ltabmp
	call rpshp
	call exprnv	;else must be expression statment. Evaluate it
	call ppshp
	call igsht	;without requiring a return value.
	cpi semi	;followed by semi?
	jz stexp2	;if so, normal. pass the semi

	lxi d,stg10
	call perrsv	;else print an error with saved line number

	call fsemi	;and look for semi

stexp2:	call psemi
	call ltabtd
	call ltabfd
	call ltabpp
	ret

st11:	inx h		;process switch statment.
	call kirkli	;insert kirkland interrupt
	call opsin	;init op stack
	call igsht
	mvi b,0
	mvi a,1
	sta val
	call rpshp
	call sprmp	;evaluate switch value
	call ppshp

	call tschr	;char value?
	jnz st11x
	lda sval1	;yes. get it into A so we can do cpi's later
	ani 0c0h	;value in L?
	mvi a,7dh	;do mov a,l if so
	jz st11w
	mvi a,7bh	;else do mov a,e
st11w:	call genb

st11x:	mov a,m		;skip newlines
	cpi nlcd	; this is a special kludge to fix
	jnz st11y	; an obscure bug
	inx h
	xchg
	lhld nlcnt
	inx h
	shld nlcnt
	xchg
	jmp st11x

st11y:	mov a,m
	inx h
	cpi swtbc	;special switch table prefix code?
	jnz ierror	;if not, we're not quite debugged...

	mov b,m		;else get case count byte

st12:	mov a,b
	ora a		;done with all case tests?
	jz st13
	xchg		;no. generate code for a test
	mvi l,3eh
	inx d
	ldax d
	mov h,a
	shld sr0
	inx d
	ldax d
	mov h,a
	shld sr2
	inx d
	ldax d
	mov l,a
	inx d
	ldax d
	mov h,a
	shld sr3
	call glbl
	shld sr1
	xchg

	call tschr	;switch variable a char?
	jnz st12a	;if not, go handle 16 bit value
	lxi d,mac35c	;yes. do the short version for chars,
	mvi a,0feh	;using 'cpi' instead of the hairy test.
	sta sr0
	jmp st12b

st12a:	lda sval1	;else 16 bit value. In HL?
	ani 0c0h
	lxi d,mac35	;do this if so
	jz st12b
	lxi d,mac35d	;else do this.
	
st12b:	call mcrog	;high and low order bytes.
	dcr b
	jmp st12	;go on to next case.

st13:	inx h
	mov e,m		;handle default case
	inx h
	mov d,m
	inx h
	xchg
	shld sr0
	xchg
	lxi d,mac36
	call mcrog
	call state	;evaluate body of switch
	ret


;
; Routine to resolve all "symbolic label" references in a function:
;

rslvl:	lhld lblc
	xchg
	lxi h,lblt

rslv2:	mov a,d
	ora e
	rz
	push d
	mov e,m
	inx h
	mov d,m
	inx h
	mov a,m
	inx h
	push h
	mov h,m
	mov l,a
	xchg
	call scanr
	pop h
	inx h
	pop d
	dcx d
	jmp rslv2

scanr:	mov b,h
	mov c,l
	lhld lbrc
	push d
	xchg
	lxi h,lbrt

scan0:	mov a,d
	ora e
	jnz scan1
	pop d
	ret

scan1:	mov a,m
	inx h
	cmp c
	jnz scan3
	mov a,m
	cmp b
	jz scan4

scan3:	inx h
	inx h
	inx h
	dcx d
	jmp scan0

scan4:	xchg
	xthl
	push h
	inx d
	ldax d
	mov l,a
	inx d
	ldax d
	mov h,a
	inx d
	xchg
	xthl
	mov a,l
	stax d
	inx d
	mov a,h
	stax d
	shld temp
	pop h
	pop d
	dcx d
	push h
	lhld temp
	xthl
	jmp scan0

;
; Routine to tack on the relocation parameters to the function
; just completed evaluating:
;

insrd:	lhld relc	;generate # of relocation parms value
	mov a,l
	call genb
	mov a,h
	call genb

	dad h		;byte count in HL
	lxi b,relt	;list of parameters

insd1:	mov a,h
	ora l
	rz
	ldax b
	call genb
	inx b
	dcx h
	jmp insd1


;
; Data Area:
;


;
; Binary-to-Ascii conversion text area:
;

ascb:	ds 4		;the area in which the ASCII value of the current
	db ': ',0	;line number is computed for error reports


;
; RED-related  stuff:
;

redfcb:	 db 0,'PROGERRS$$$',0,0,0,0
	 ds 17	;rest of fcb for RED error file
redbuf:	ds 128	;text buffer for RED error file
redbp:	ds 2	;pointer into text buffer
errsin: ds 1	;true if RED output is active

werrs:	ds 1	;true to write out RED file, else false (default)
		;(set upon auto-chain from CC.COM)

;
; Module stack stuff:
;

modstk:	ds (fnlen + 2) * (nestmax + 1)
modstp:	ds 2	;pointer to currently active filename
modstc:	ds 1	;counter


;
; CDB control stuff:
;

klcnt:	ds 1	;count of interrupts on current line
kllin:	ds 2	;last line where interrupt was generated
kblin:	ds 2	;line on which function begins

;
; Flags used by new alugen:
;

hbn1cf:	ds 1
key:	ds 1
spval:	ds 2
spmac:	ds 2

;
; Other stuff:
;

ssval:	ds 1		;temporary storage
namsav:	ds 2		;name of func being processed
nlcnts:	ds 2		;save line # of start of include file
subval:	ds 2		;scratch space used by primb
sgflg:	ds 1
ftypec:	ds 1
val:	ds 1		;used for optimizing ++ & -- exprs
arith:	ds 1		;used by bexpr
value:	ds 1
par2pf:	ds 1
errf:	ds 1		;tells if any fatal errors ocurred
entn:	ds 1		;contains the number of the function being processed
argcnt:	ds 1
simpf:	ds 1
op:	ds 1
faflg:	ds 1		;true when evaluating arguments in a function call
lflg:	ds 1
eofad:	ds 2		;contains address of end of file in memory
dirp:	ds 2		;pointer to next space in CRL directory to be filled
stgad:	ds 2		;address of string texts compiled by CC1
stno:	ds 2		;number of symbols in symbol table (computed by CC1)
fntb:	ds 2		;pointer to list function names created by CC1
nlcnt:	ds 2		;new line count (keeps track of current line number)
savnlc:	ds 2		;save ine count for lines with long logical errors
lbln:	ds 2		;symbolic label source (starts at 8000h for CC2)
prnsav:	ds 2		;temp store used to save addr of open parenthesis
prnflg:	ds 1
sr0:	ds 2		;the Special Registers
sr1:	ds 2		;used for code generation by mcrog
sr2:	ds 2
sr3:	ds 2
sr4:	ds 2
sr5:	ds 2
modsa:	ds 2		;the address at which the size of a function goes
sfsiz:	ds 2		;size of the current function's stack frame
cdp:	ds 2		;code pointer, used internally for code generation
cdao:	ds 2		;	even more
nfns:	ds 1
stmp:	ds 2
temp:	ds 2
vext:	ds 1
codflg:	ds 1		;true if code generation enabled (only disabled
			;	during "sizeof" evaluation)
notklg:	ds 1		;flag used by sgen5 to fix Gary Kildall's bug

;
; The attributes of a sub-expression, as it is being evaluated, are
; stored in one or the other of the two following blocks. The first
; one is the primary block, and the second is used when a binary
; expression is being processed:
;

sval1:	ds 1		;constant, flag and push-optimization data
sbmap1:	ds 1		;flag and misc bit info
svv1:	ds 2		;constant value (if constant)
indc1:	ds 1		;0=constant 1=lvalue 2=pointer 3=ptr-to-ptr 
			;4=ptr-to-ptr-to-ptr etc.
typ1:	ds 1		;0=char 1=int 2=uns 3-5 unused 6=struct
strsz1:	ds 2		;size of structure, if struct or pointer to struct
dimsz1:	ds 2		;if 0: scalar. if high byte=FF: 1-dim array. 
			;	else: value is 1st dim of 2-dim array 
frml1:	ds 1		;true if formal parameter (formal arrays treated
			;	differently than non-formal arrays)

sval2:	ds 1
sbmap2:	ds 1
svv2:	ds 2
indc2:	ds 1		;attributes of alternate result of expreesion
typ2:	ds 1		;evaluator. Each means same as counterpart above.
strsz2:	ds 2
dimsz2:	ds 2
frml2:	ds 1

;
; Values set by the "Analyze" routine, which, given the info in the
; first block above, sets these values accordingly:
;

asize:	ds 2		;size of object, in bytes
aadrf:	ds 1		;true (non-zero) if object has an address
asnokf:	ds 1		;true if object may be assigned to
amathf:	ds 1		;true if object may have math done on it
avar:	ds 1		;true if object is a variable

;
; Misc. storage used by the more grungy parts of the compiler:
;

opstp:	ds 2
infsp:	ds 2
nofrmls: ds 1
fncnt:	ds 1
start:	ds 2
relp:	ds 2
relc:	ds 2
lblp:	ds 2
lblc:	ds 2
lbrp:	ds 2
lbrc:	ds 2
codp:	ds 2
cdstrt:	ds 2
klujf:	ds 1
fexlab:	ds 2		;symbolic label of exit code for current function
savtxt:	ds 2		;used by sargs routine
savcnt:	ds 2		;used by sargs also
prerrs:	ds 1		;true if printing errors
retadd:	ds 2		;used by label-generating stack-hacking routines


;
; Initialization code, placed over table storage not used until
; after completion of initialization
;

c2init:

	IF CPM
	lxi d,tbuff
	mvi c,sdma
	call bdos	;set default DMA buffer
	ENDIF

	lda erasub	;bit 1 of erasub is werrs flag
	mov b,a
	ani 2
	sta werrs	;set werrs
	mov a,b
	ani 1
	sta erasub	
	

	mvi a,1
	sta prerrs	;print out errors
	sta entn
	sta codflg	;enable code generation
	dcr a
	sta errf	;no errors yet
	sta prnflg	;not inside parentheses
	sta modstc	;clear module nesting count
	sta errsin

	call clrdir	;clear 512 byte directory area
	call opsin	;initailize operator stacks
	call minit	;adjust macro table for -z optimizations

	call readf	;read in CCI file, or copy down from hi ram
	shld eofad	;set EOF address

	lxi h,direc	;init directory pointer
	shld dirp

	lhld st-4
	push h
	mvi b,3
cc21:	xra a		;compute # of entries in symbol table
	mov a,h		;by dividing size of table by 8
	rar
	push psw
	ani 7fh
	mov h,a
	pop psw
	mov a,l
	rar
	mov l,a
	dcr b
	jnz cc21
	shld stno	;and store # of entries
	pop h		;HL is size of symbol table

	lxi d,st	;get base of sym tab in DE
	dad d		;now HL is base of func name tab
	shld fntb
	xchg		;put in DE
	lhld st-2	;get length of sym tab
	dad d		;now HL is start of CCI code
	push h		;as well as base of generated code area. Save it
	shld start	;on stack and at "start"

	dcr h		;compute code area offset, which
	dcr h		; when added to a pointer to an absolute
	call cmh	; location in generated code during code
	shld cdao	; generation, yields final addr of that code
			; in the generated CRL file.
	pop h		;get start of CCI code area
	push h
	call mvup	;move CCI code up to high memory
	shld cdp	;Save pointer to CCI code at "cdp".
	pop h		;get back code area pointer

	lda eflag	;has -e option been used?
	ora a
	jz cc22		;if not, go put zeroes in the first 3 bytes of code

	mvi m,0bdh	;else stick in a famous "BD" byte to indicate
	inx h		;an explicit external address for CLINK
	xchg
	lhld exaddr	;get the explicit external address
	xchg
	mov m,e
	inx h
	mov m,d
	jmp cc23	;and rejoin the mainstream.
	
cc22:	xra a		;fill first 3 bytes of 5th sector with zeros
	mov m,a		;if explicit external starting address not given.
	inx h
	mov m,a
	inx h
	mov m,a

cc23:	inx h
	xchg
	lhld st-6	;get external data area size
	xchg		;and put it here at 4th byte of 5th sector
	mov m,e
	inx h
	mov m,d
	inx h
	shld codp	;save code area pointer

	lxi h,lblt	;Initialize label table
	shld lblp

	lxi h,modstk	;initialize module stack
	shld modstp

	call fstgs	;find the collected text strings

	lxi h,ltab	;initialize logical conditional branch label table
	shld ltabp	;(first 5 bytes aren't used, but why play with fire?)

	lxi h,pshptb	;initialize "push optimization" table
	shld pshpp

	lxi h,8000h	;and "symbolic label" name (number) generator
	shld lbln

	lxi h,modstk	;initialize module stack
	shld modstp

	lxi h,0
	shld nlcnt	;initialize line count
	ret


	IF NOT ALPHA
s0:	db 'BD Software C Compiler'
	ENDIF

	IF ALPHA
s0:	db 'BDS Alpha-C Compiler'
	ENDIF

	IF NOT ZSYSTEM
	db ' v1.'
	db version
	db updatn + '0'
	ENDIF

	IF ZSYSTEM
	db ' (for ZCPR3) vZ'
	db version
	db '.'
	db updatn + '0'
	ENDIF

	db ' (part II)+'

;
; Clear new directory for the CRL file about to be created:
;

clrdir:	lxi b,512
	lxi h,direc
clrdr2:	mvi m,0
	inx h
	dcx b
	mov a,b
	ora c
	jnz clrdr2
	ret



;
; Initialize operator stack and operand
; information stack:
;

opsin:	push h
	lxi h,opstk
	shld opstp
	mvi m,0ffh
	lxi h,infstk
	shld infsp
	pop h
	ret


;
; Read in the CCI file from disk, or move it down from high
; memory if left there by CC1:
;

readf:	lda chainf		;chained to from CC1?
	ora a

	IF CPM
	  jz readf0		;if not, load cci file under CP/M
	ENDIF

	lhld curtop		;yes. copy down to low ram
	lxi d,-35
	dad d
	push h			;save last addr + 1
	mov a,m
	inx h
	mov h,m
	mov l,a			;HL = first address
	inx h			;or rather, it does now
	mov b,h
	mov c,l			;BC = 1st address of text
	mvi a,st/256		;make sure we have enough room...
	cmp b			;hi byte of symbol table area must be less 
	jnc rdf4		;than high byte of cci code area

	call cmh
	pop d
	dad d
	xchg			;DE = length
	lxi h,st-6		;HL = destination
rloop:	ldax b
	mov m,a
	inx h
	inx b
	dcx d
	mov a,d
	ora e
	jnz rloop
	shld eofad	;save end address
	mvi m,1ah
	ret


readf0:
	IF CPM
	lxi h,fcb+9
	mvi m,'C'
	inx h
	mvi m,'C'
	inx h
	mvi m,'I'

	call fopen

	lxi h,st-6
rdf2:	call reads
	jnc rdf2a
	call fclose
	ret

rdf2a:	lxi d,tbuff
	mvi b,80h
rdf3:	ldax d
	mov m,a
	inx h
	inx d
	dcr b
	jnz rdf3

	lda curtop+1
	mov c,a
	dcr c
	mov a,h
	cmp c
	jc rdf2
	ENDIF

rdf4:	lxi d,stgom
	call perrab



;
; Move the CCI code up out of the way to make room for
; code generation:
;

mvup:	call cmh	;put -(base of cci code)...
	xchg		;  ...into DE
	lhld eofad	;end of cci code
	push h		;save end of source area
	dad d		;end of cci code - base of cci code
	inx h		;end of code - base of code + 1
	mov b,h		;this is the length of the code;
	mov c,l		;block length in  BC

	pop d		;DE is end of source area

	lhld curtop	;HL is end of memory (destination area)
	dcx h		;just below BDOS
	dcx h		; but one more for good measure

mvup2:	mvi a,2		;check to see if we're on a Z80
	inr a
	jpe mvup80

	xchg		;Z80. put source in HL and destination in DE
	db 0edh,0b8h	;Z80 block move
	xchg		;flip registers again
	jmp mvup3

mvup80:	ldax d		;get byte of source
	mov m,a		;move up
	dcx h		;debump dest
	dcx d		;and source
	dcx b		;and count
	mov a,b
	ora c	
	jnz mvup80	;loop till done

mvup3:	inx h		;restore HL to first character of CCI code
	ret		;and return with HL pointing to start of CCI code




;
; Find the location of the string constant table in
; the just-read-in .CCI file:
;

fstgs:	lhld cdp
fstg1:	call pascd2
	push psw
	cpi swtcd
	jnz fstg2
	inx h
	call igsht
	call mtchp
fstg1a:	mov a,m
	cpi nlcd
	inx h
	jz fstg1a
	mov e,m
	mvi d,0
	inx h
	dad d
	dad d
	dad d
	dad d
	inx h
fstg2:	pop psw
	inx h
	jnz fstg1
	shld stgad
	ret


;
; The following data storage is overlayed on pass 2 initialization code:
;

	org c2init

opstk:	ds 40		;operator stack for expression evaluation
infstk:	ds 250		;info stack for expression evaluation (where
			;info on each value is pushed and popped as
			;needed.)

relt:	ds 1600		;relocation table

lblt:	ds 1700		;label table

lbrt: 	ds 1600		;label reference table

	ds 300
stack:	equ $

strsz:	equ 200

strtb:	ds strsz+3	;up to (strsz/4) intelligently handled  strings

ltab:	ds 200		;logical label table
ltabp:	ds 2		;logical label table pointer

pshptb:	ds 30		;push-optimization history table
pshpp:	ds 2		;push-optimization table pointer

direc:	ds 512		;area where CRL directory is built up
endir:	equ $

;
; This is where the .CCI file gets loaded:
;

	ds 6
st:	equ $


	IF LASM
	end
	ENDIF
