;
; cc2e.asm:
; Non-text utility routines:
;
;
; Complement HL register:
; (Good 'ole simple subroutine. Aint too many like this one
; around anymore...)
;
cmh: push af
ld a,h
cpl
ld h,a
ld a,l
cpl
ld l,a
inc hl
pop af
ret
;
; Generate a new label number:
;
glbl: lhld lbln
inc hl
shld lbln
dec hl
ret
;
; Get a label and put it in sr0:
;
glblr0: push hl
call glbl
shld sr0
pop hl
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 de
add hl,hl
add hl,hl
add hl,hl
ld de,st+4
add hl,de
ld a,(hl)
inc hl
ld h,(hl)
ld l,a
pop de
ld a,h
cp 255
ret nz
push de
ld de,stg17a
call perr
pop de
ret
;
; Generate a byte of code given in A:
;
genb: push af
call genb1
pop af
ret
genb1: push hl
push bc
ld b,a ;save byte in B
lda codflg ;code generation enabled?
or a
jp z,genb3 ;return if not
lhld pshpp ;need to push some prior value
ld a,(hl)
and 0a0h ; in a register?
call nz,genpsh ;if so, go do it.
lhld codp
ld (hl),b
inc hl
shld codp
;
; Check for memory overflow:
;
genb1a: lda cdp+1 ;get high byte of CCI text ptr
ld l,a
ld a,h ;get high byte of code area pointer
cp l ;less than CCI pointer?
jp c,genb3
if 1==0
IF MARC
lda maxmd ;maxmem call done?
or a
jp z,genb2 ;if not, go try it...
ENDIF
IF CPM
lda ccpok ;CCP still intact?
or a
jp nz,genb2 ;if so, go get rid of it
ENDIF
endif
genb1b: ld de,stgom ;if all that can be done has been done, error...
jp perrab
if 1==0
;
; Now get more memory by calling maxmem (MARC) or overwriting the shell (CP/M):
;
genb2:
IF CPM
xor a
sta ccpok ;CCP not intact anymore
push de
push hl
call nudge ;lde code up a bit
ld hl,NEDOOSMEMTOP;lhld bdosp
ld l,0
shld curtop ;new current top of memory
pop hl
pop de
ENDIF
endif
genb3: pop bc ;wrap up and return
pop hl
ld a,b
ret
if 1==0
;
; lde cci text up into the memory space just vacated by making
; the shell go away:
;
nudge: lhld cdp ;compute size of block to be lded
call cmh
ex de,hl
lhld curtop ;get EOF address in HL
dec hl
dec hl ;this was the destination of the "mvup" lde
add hl,de ;subtract starting address
inc hl ;add one to get block size
ld b,h ;lde to BC
ld c,l
ld hl,NEDOOSMEMTOP;lhld bdosp ;put destination address in DE
ld l,0
dec hl
push hl ;save for later computations
ex de,hl
lhld curtop ;put eof address (source area pointer) in HL
dec hl
dec hl
ld a,2 ;check if we're on a Z80 or 8080
inc a
jp pe,nudge80
db 0edh, 0b8h ;Z80: do block lde
jp nudge2
nudge80:ld a,(hl)
ld (de),a
dec hl
dec de
dec bc
ld a,b
or c
jp nz,nudge80
nudge2: pop de ;pop curtop-1 into DE
lhld curtop ;get old eof address
dec hl
dec hl
call cmh
add hl,de ;HL now equals the offset for the block lde.
ex de,hl ;put offset in DE
lhld cdp ;bump cdp by the offset
add hl,de
shld cdp
lhld stgad ;and bump the string address by the offset
add hl,de
shld stgad
ret ;all done
endif
;
; 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 af
call mcrog1
pop af
ret
mcrog1: lda codflg ;code generation enabled?
or a
ret z ;if not, don't generate any code!
push hl
push bc
mg1: ld a,(de)
cp 38h ;end of macro?
jp nz,mg1a
pop bc ;yes. return.
pop hl
ret
mg1a: cp 0cbh ;code to enter relocation parameter
jp nz,mg2 ;for current code location?
call entr ;yes. Enter in ref table
inc de ;and go for next macro byte.
jp mg1
mg2: cp 0efh ;code to enter symbolic reference?
jp nz,mg2a
call entr ;yes. Enter relocation parameter
inc de ;get following sr code
ld a,(de)
push de ; (note: sr means `special register')
call tstsr
call cnvsr ;get the value in the sr
ex de,hl
call entrf ;and enter symbolic reference
pop de ;restore macro text pointer
jp mg1 ;and go for next byte
mg2a: cp litrl ;do we take the next 2 bytes literally?
jp nz,mg3
push hl
push bc
inc de ;yes. get them, add them to cccadr and generate...
ld a,(de)
ld c,a
inc de
ld a,(de)
ld b,a
lhld cccadr
add hl,bc
ld a,l
call genb
ld a,h
call genb
pop bc
pop hl
inc de
jp mg1
mg3: call tstsr ;sr code?
jp c,mg4
push de ;yes. Convert to value in sr and generate
call cnvsr
ld a,l
call genb
ld a,h
call genb
pop de
inc de
jp mg1
mg4: ld b,a ;symbolic label definition?
or 38h
inc a
ld a,b
jp nz,mg6
cp 0e8h
jp nc,mg6 ;yes. Figure out which sr to get label
ccf ;value from...
rra
rra
rra
and 7
push de
call cnvsr ;get the value
ex de,hl
call entl ;enter in label table
pop de
inc de
jp mg1
mg6: call genb ;if none of the above, take the
inc de ;value literally
jp 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: ld b,a
and 38h
cp b
ld a,b
scf
ret nz
or a
scf
ret z
cp 31h
ccf
ret c
rra
rra
rra
dec 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 de
ld e,a
ld d,0
ld hl,sr0
add hl,de
add hl,de
ld a,(hl)
inc hl
ld h,(hl)
ld l,a
pop de
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 hl
push de
;jr $
lhld cdstrt
call cmh
ex de,hl
lhld codp
add hl,de
ex de,hl
lhld relp
ld (hl),e
inc hl
ld (hl),d
inc hl
shld relp
lhld relc
inc hl
shld relc
pop de
pop hl
ret
;
; Enters the current code generation PC as the value for the
; symbolic label given in DE:
;
entl: push hl
push de
lhld lblp
ld (hl),e
inc hl
ld (hl),d
inc hl
ex de,hl
lhld codp
ex de,hl
push hl
lhld cdstrt
call cmh
add hl,de
ex de,hl
pop hl
ld (hl),e
inc hl
ld (hl),d
inc hl
shld lblp
lhld lblc
inc hl
shld lblc
pop de
pop hl
ret
;
; Enters, in the symbol reference table, a reference
; to the symbolic label given in DE:
;
entrf: push hl
push de ;save label code
ld hl,0 ;check for table overflow by seeing
add hl,sp ;if the ref table pointer has approached
ex de,hl ;the stack...
lhld lbrp
push hl
inc hl ;if lbrp+4 isn't greater than the current SP,
inc hl ;then complain and abort.
inc hl
inc hl
call checkb ;this function checks HL against DE (HL must be < DE)f
pop hl ;no problem.
pop de ;restore label code and go ahead with the table entry
ld (hl),e
inc hl
ld (hl),d
inc hl
ex de,hl
lhld codp
ex de,hl
ld (hl),e
inc hl
ld (hl),d
inc hl
shld lbrp
lhld lbrc
inc hl
shld lbrc
pop hl
ret
;
; Process a function:
;
dofun: ld hl,pshptb ;initialize pushop table so genb's won't
shld pshpp ;cause stray D5's and E5's all over
ld (hl),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
ld hl,relt ;initialize the relocation parameter table
shld relp
ld hl,lblt ;and the label definition table
shld lblp
ld hl,lbrt ;and the label reference table
shld lbrp
ld hl,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
inc hl ;correctly (once it did, I completely forgot
inc hl ;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
cp lbrcd ;function body begin with a `{' ?
jp z,dofun1 ;if so, Ok
ld de,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
ex de,hl
lhld codp
add hl,de ;get length of function code
ex de,hl ;put into DE
lhld modsa ;store following list of needed functions
ld (hl),e
inc hl
ld (hl),d
call insrd ;and append relocation parameter list
ret
;
; Pass formal parameter list:
;
paslst: lhld cdp
call igsht
cp varcd
call nz,ierror
inc hl
inc hl
inc hl ;pass over function name
call igsht
inc hl ;pass over open paren
xor a
sta nofrmls ;clear no-formals flag
call igsht ;first thing a close paren?
cp close
jp nz,pasl2
sta nofrmls ;yes: set no-formals flag to optimize entry code
pasl0: call igsht
pasl1: cp close ;close paren (end of arg list)?
jp nz,pasl2
inc hl ;yes. pass it and return.
call igsht
shld cdp
ret
pasl2: call lookup
cp comma ;if not comma,
jp nz,pasl1 ;check for close
inc hl
jp 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: ld de,mfntry
lhld sfsiz ;null stack frame size?
ld a,h
or l
jp nz,fntry2 ;if not, go handle that case.
lda nofrmls ;we have null frame. null formal param list also?
or a
ret nz ;if so, don't generate any code
ld de,mfntr2 ;else like normal, except no "ld sp,hl" (big deal)
; jp fntry3 ;go try for -z optimized entry sequence
jp fntry4 ;woops...doesn't quite work if sfsiz = 0; do bulky
fntry2: ld a,h ;ok, we have at least some stack frame to deal with
or a ;more than 255 bytes?
jp nz,fntry4 ;if so, handle with normal bulky code sequence
fntry3: lda optimf ;doing function entry optimization?
and 1
jp z,fntry4 ;if not, go handle with normal code sequence
ld a,0cfh ;else generate rst 1 followed by negated
call genb ; 8-bit stack offset
ld a,l
cpl
inc 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 ;"inc sp" op
fexit: lhld fexlab ;ready to define exit sequence label
shld sr1
ld de,mfex1 ;define exit label
call mcrog
lhld sfsiz ;set up stack size to reset SP
shld sr0
ld a,h
or l ;was stack frame size 0?
jp nz,fexit2 ;if so, go handle simple cases
ld de,mfex4 ;OK, frame size is 0...
lda nofrmls ;null formal parameter list?
or a
jp nz,mcrog ;if so, use trivial exit sequence
ld de,mfex3 ;0 frame size w/formal parms exit sequence
jp mcrog
fexit2: ld de,mfex2 ;non-0 frame size.
ld a,h ;frame size > 255?
or a
jp nz,mcrog ;if so, handle with bulky exit sequence
lda optimf ;-z optimizing exit sequence
and 2
jp z,fexit3 ;if not, use in-line code
ld a,0d7h ;rst 2
call genb
ld a,l ;SP offset value
call genb
ret
fexit3: ld de,6 ;cmpdh compares d to h
call cmpdh ;return Cy set if stack size less than 7
ld de,mfex2
jp c,mcrog ;if frame size >= 7, go do long exit sequence
fexit4: ld a,inxsp ;generate "inc sp" n times, where n is stack
call genb ;frame size
dec l
jp nz,fexit4
ld de,mfex3 ;generate final pop bc and return
call mcrog
ret
;
; Flush string constants that have been built up in strtb
; onto the tail end of the function:
;
flshst: ld hl,strtb
flst1: ld e,(hl) ;get label code (or terminating 0000)
inc hl
ld d,(hl)
inc hl
ld a,d ;all done?
or e
ret z ;if so, return
call entl ;else register the label code for this string
ld e,(hl) ;get text pointer into DE
inc hl
ld d,(hl)
inc hl
ld a,(de) ;get length byte
ld b,a ;store in B
inc b
flst3: dec b ;done with body of text?
jp z,flst4
inc de ;no. get and generate next byte
ld a,(de)
call genb
jp flst3
flst4: xor a ;generate trailing null byte
call genb
jp 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:
ld de,lblt
lhld relp
call checkb ;check that HL < DE
ld de,lbrt
lhld lblp
call checkb
ret ;no overflows.
checkb: ld a,h
cp d
ret c
jp nz,ftberr
ld a,l
cp e
ret c
ftberr: call pmodnc
ld de,stgftb
call pstg
lhld namsav ;print name of bad function
pnamlp: ld a,(hl)
cp 9dh ;main?
jp z,pmain ;if so, handle specially
and 7fh
call outch
ld a,(hl)
inc hl
or a
jp p,pnamlp
pnam2:
ld de,stgtb2 ;print rest of message
call pstg
jp errab ;and abort
;
; The representation of "main" is a keyword, so we
; have to kludge it:
;
pmain: ld de,stgmn
call pstg
jp pnam2
stgmn: db 'main',0
;
; Enter the name of the function in the CRL directory:
;
idir: lhld nlcnt
push hl
lhld cdp
call igsht
cp varcd
call nz,ierror
push hl ;initialize for Kirkland interrupt generation
lhld nlcnt
shld kblin ;save line number where function begins
ld hl,0
shld kllin ;null out last line value
pop hl
inc hl
ld e,(hl)
inc hl
ld d,(hl)
pop hl
shld nlcnt
push de
call lookp2
xor a
sta ftypec
lda indc1
or a
jp nz,idirz
lda typ1
and 7
jp nz,idirz
inc a
sta ftypec
idirz: lhld fntb
pop de
call ifntf
ex de,hl
lhld dirp
shld namsav ;save pointer to name of function
idir1: ld a,(de)
call mapuc
ld (hl),a
inc hl
inc de
or a
jp p,idir1
push hl
lhld codp
ex de,hl
lhld cdao
add hl,de
ex de,hl
pop hl
ld (hl),e
inc hl
ld (hl),d
inc hl
shld dirp
ld de,endir-3
call cmpdh ;return Cy set if DE < HL
ld de,s2a ;directory overflow
call c,perrab
ld h,b
ld l,c
add hl,hl
add hl,hl
add hl,hl
ld de,st+2
add hl,de
ld a,(hl)
inc hl
ld h,(hl)
ld l,a
shld sfsiz
ret
ifntf: ld c,(hl)
inc hl
ld b,(hl)
inc hl
ld a,b
cp d
jp nz,ifnf2
ld a,c
cp e
ret z
ifnf2: ld a,(hl)
inc hl
or a
jp p,ifnf2
jp 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: ld hl,st
shld stmp
ld hl,relt
shld relp
ld b,0
lhld stno
ex de,hl
ifun1: ld a,d
or e
jp z,ifun2
lhld stmp
ld a,(hl)
inc hl
and 3
cp 3
jp nz,ifun3
lda entn
ld c,a
ld a,(hl)
and 3fh
cp c
jp z,ifuni
ifun3: push de
ld de,7
add hl,de
shld stmp
pop de
dec de
jp ifun1
ifun2: lhld relp
ld (hl),0
inc hl
ld a,b
sta nfns
ex de,hl
ld hl,relt
call cmh
add hl,de
ld b,h
ld c,l
ld de,relt
ifun4: ld a,(de)
call genb
inc de
dec bc
ld a,b
or c
jp nz,ifun4
ret
ifuni: push hl
push de
lhld stno
ex de,hl
call cmh
add hl,de
ex de,hl
lhld fntb
push bc
call ifntf
ld a,(hl)
cp 9dh
jp z,ifuni3
ex de,hl
lhld relp
ifuni2: ld a,(de)
call mapuc
ld (hl),a
inc hl
inc de
or a
jp p,ifuni2
shld relp
ifuni3: pop bc
inc b
pop de
pop hl
jp ifun3
;
; Insert a "jp 0" for each function in the list of needed functions:
;
insjl: lhld codp
shld cdstrt
call glbl
push hl
shld sr0
lda nfns ;if no functions, don't generate the
or a ; jump around non-existent jump list.
jp z,insjl2
ld de,mac37 ;generate jp around jump list
call mcrog
lda nfns
insj1: push af
ld de,mac38
call mcrog ;generate dummy jp instruction, the
pop af ;operand of which is later filled in
dec a ;by CLINK
jp nz,insj1
insjl2: pop hl
ex de,hl
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: xor a
sta levno ;level number, so we know when at top level
state: call igsht ;pass by crap
cp lblcd ;is it a label code?
jp z,st1
cp labrc
jp nz,st2
call ierror ;call, but never to return...
st1: inc hl ;yes. enter it into the label table
ld e,(hl)
inc hl
ld d,(hl)
inc hl
call entl
jp state ;and go for the REAL statment
st2: cp lbrcd ;left curly-bracket?
jp nz,st4
lda levno ;bump level count
inc a
sta levno
inc hl ;yes. Keep doing statements until
st2a: call igsht ;a matching right curly-bracket is found...
cp rbrcd
jp nz,st3
lda levno ;debump level number
dec a
sta levno
inc hl ;found it. all done.
ret
st3: call state ;inside curly brackets. Do a statement
jp st2a ;and loop
st4: cp semi ;null statement?
jp nz,stgoto
inc hl ;yes.
ret ;don't do much in that case.
kirkli: push af ;save PSW while we take care of kirkland interrupt
lda cdbflg
or a
jp z,kirkdn ;if not in Kirkland mode, don't generate interrupt
push bc ;save BC
push hl ;save HL
rlca ;rotate interrupt number into bits 3-5
rlca
rlca
or 0c7h ;make into restart op
call genb ;and generate the restart
lhld kllin ;get last line that had interrupt generated
ex de,hl ;put in DE
lhld nlcnt ;get current line number in HL
call cmpdh ;still on same current line?
ld a,0
jp nz,dok3 ;if not, clear count
lda klcnt ;else bump count of interrupts on this line
inc a
dok3: sta klcnt ;save current line interrupt count
shld kllin ;make current line the last interrupt line
ex de,hl ;put current line in DE
lhld kblin ;get function starting line
call cmh ;subtract from current line
add hl,de
inc hl ;and bump for true line number (first = 1)
ld a,l
call genb ;generate line number word
lda klcnt ;get current line interrupt count
rlca ;put in high order 4 bits
rlca
rlca
rlca
and 0f0h ;keep only high bits
add h ;add to line number's high order byte
call genb ;and send it out
pop hl ;restore registers
pop bc
kirkdn: pop af
ret
stgoto: cp gotcd ;goto?
jp nz,stif
call kirkli ;handle kirkland interruprt
inc hl ;yes.
call igsht
cp labrc ;must be followed by a label reference code
call nz,ierror
inc hl ;OK, we found a label reference code. Enter
ld e,(hl) ;it in the label reference table.
inc hl
ld d,(hl)
inc hl
ex de,hl
shld sr0
ex de,hl
ld de,mac37 ;and generate a jp instruction
call mcrog
call psemi ;pass by semi
ret
stif: cp ifcd ;"if" statement?
jp nz,stwhil
call kirkli ;handle kirkland interrupt
call ltabmp ;bump label table
inc hl ;yes.
call igsht ;look for open paren
cp open
push de
ld de,stgeop
call nz,perrab ;internal error: missing {
pop de
inc hl ;pass over it
call rpshp
call expr ;evaluate condition
call ppshp
cp close ;followed by close paren?
push de
ld de,stgecp
call nz,perrab
pop de
inc hl
call gncjf
call ltabtd
call state
call igsht
cp elscd
jp z,stifel
call ltabfd
call ltabpp
ret
stifel: call gfjp
call ltabfd
call ltabpp
inc hl
call state
call plvdl
ret
stwhil: cp whlcd ;"while" statement?
jp nz,stdo
inc hl ;yes.
ld a,(hl)
cp lblcd
call nz,ierror
inc hl
ld e,(hl)
inc hl
ld d,(hl)
inc hl
call entl
call ltabmp
call igsht
call igsht
cp open
push de
ld de,stgeop
call nz,perrab
pop de
call kirkli ;insert kirkland interrupt
inc hl
call rpshp
call expr ;evaluate condition
call ppshp
cp close ;close paren?
push de
ld de,stgecp
call nz,perrab
pop de
inc hl
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: cp docd ;"do" statement?
jp nz,stret
inc hl
call ltabmp
call fltbtd
call state ;generate code for body
call igsht
cp whlcd ;make sure there's a "while"
call nz,ierror
inc hl ;ok, there is.
call igsht
cp lblcd
jp nz,stdo1
inc hl
inc hl
inc hl
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
cp semi
push de
ld de,s4
jp nz,perrab
pop de
inc hl ;and pass over it if it is there (should be)
ret
stret: cp rencd ;"return" statment?
jp nz,stswit
call kirkli ;insert kirkland interrupt
inc hl ;yes.
call igsht
cp semi ;does it have an argument?
jp z,stret2 ;if not, go handle trivial case
call ltabmp ;bump ltab with dummy entry
ld 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-
or a ;order byte if either the type
jp z,stret1 ;of the function is char, or...
ld de,mac61
call mcrog
jp stret2
stret1: call tschr
jp nz,stret2
ld de,mac61 ;the type of the function is int and
call mcrog ;the type of the return value is char.
stret2: push hl
lhld fexlab ;get exit label
shld sr0
pop hl
call psemi
call peeknxt ;peek at next token
cp rbrcd ;next token a close curly brace?
jp nz,stret3
lda levno ;yes. are we at top level of function?
cp 1
ret z ;if so, don't generate any jumps or exit code
stret3: push hl
lhld sfsiz ;if sfsiz is non-zero
ld a,h
or l
pop hl
jp nz,stret4 ;then go handle that case
ld de,mfex4 ;else frame size is 0...
lda nofrmls ;null formal parameter list?
or a
jp nz,mcrog ;if so, use trivial exit sequence
ld de,mfex3 ;0 frame size w/formal parms exit sequence
jp mcrog
stret4: push hl
lhld sfsiz ;get frame size again
ld a,h
or a ;if frame size > 255,
jp nz,stret5 ; go use bulky sequence
lda optimf ;else check for -z function exit optimization
and 2
jp z,stret5
ld a,0d7h ;rst 2
call genb
ld a,l ;SP offset byte
call genb
pop hl ;and all done
ret
stret5: ld de,mac36 ;use this for "jp fexlab"
call mcrog ;use "jp fexlab" if non-zero stack frame size
pop hl
ret
stswit: cp swtcd ;"switch" statment?
jp z,st11 ;if so, go process
cp rbrcd ;right curly bracket?
ret z ;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.
cp semi ;followed by semi?
jp z,stexp2 ;if so, normal. pass the semi
ld de,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: inc hl ;process switch statment.
call kirkli ;insert kirkland interrupt
call opsin ;init op stack
call igsht
ld b,0
ld a,1
sta val
call rpshp
call sprmp ;evaluate switch value
call ppshp
call tschr ;char value?
jp nz,st11x
lda sval1 ;yes. get it into A so we can do cp's later
and 0c0h ;value in L?
ld a,7dh ;do ld a,l if so
jp z,st11w
ld a,7bh ;else do ld a,e
st11w: call genb
st11x: ld a,(hl) ;skip newlines
cp nlcd ; this is a special kludge to fix
jp nz,st11y ; an obscure bug
inc hl
ex de,hl
lhld nlcnt
inc hl
shld nlcnt
ex de,hl
jp st11x
st11y: ld a,(hl)
inc hl
cp swtbc ;special switch table prefix code?
jp nz,ierror ;if not, we're not quite debugged...
ld b,(hl) ;else get case count byte
st12: ld a,b
or a ;done with all case tests?
jp z,st13
ex de,hl ;no. generate code for a test
ld l,3eh
inc de
ld a,(de)
ld h,a
shld sr0
inc de
ld a,(de)
ld h,a
shld sr2
inc de
ld a,(de)
ld l,a
inc de
ld a,(de)
ld h,a
shld sr3
call glbl
shld sr1
ex de,hl
call tschr ;switch variable a char?
jp nz,st12a ;if not, go handle 16 bit value
ld de,mac35c ;yes. do the short version for chars,
ld a,0feh ;using 'cp' instead of the hairy test.
sta sr0
jp st12b
st12a: lda sval1 ;else 16 bit value. In HL?
and 0c0h
ld de,mac35 ;do this if so
jp z,st12b
ld de,mac35d ;else do this.
st12b: call mcrog ;high and low order bytes.
dec b
jp st12 ;go on to next case.
st13: inc hl
ld e,(hl) ;handle default case
inc hl
ld d,(hl)
inc hl
ex de,hl
shld sr0
ex de,hl
ld de,mac36
call mcrog
call state ;evaluate body of switch
ret
;
; Routine to resolve all "symbolic label" references in a function:
;
rslvl: lhld lblc
ex de,hl
ld hl,lblt
rslv2: ld a,d
or e
ret z
push de
ld e,(hl)
inc hl
ld d,(hl)
inc hl
ld a,(hl)
inc hl
push hl
ld h,(hl)
ld l,a
ex de,hl
call scanr
pop hl
inc hl
pop de
dec de
jp rslv2
scanr: ld b,h
ld c,l
lhld lbrc
push de
ex de,hl
ld hl,lbrt
scan0: ld a,d
or e
jp nz,scan1
pop de
ret
scan1: ld a,(hl)
inc hl
cp c
jp nz,scan3
ld a,(hl)
cp b
jp z,scan4
scan3: inc hl
inc hl
inc hl
dec de
jp scan0
scan4: ex de,hl
ex (sp),hl
push hl
inc de
ld a,(de)
ld l,a
inc de
ld a,(de)
ld h,a
inc de
ex de,hl
ex (sp),hl
ld a,l
ld (de),a
inc de
ld a,h
ld (de),a
shld temp
pop hl
pop de
dec de
push hl
lhld temp
ex (sp),hl
jp scan0
;
; Routine to tack on the relocation parameters to the function
; just completed evaluating:
;
insrd: lhld relc ;generate # of relocation parms value
ld a,l
call genb
ld a,h
call genb
add hl,hl ;byte count in HL
ld bc,relt ;list of parameters
insd1: ld a,h
or l
ret z
ld a,(bc)
call genb
inc bc
dec hl
jp insd1
if 1==1
;
; Initialize operator stack and operand
; information stack:
;
opsin: push hl
ld hl,opstk
shld opstp
ld (hl),0ffh
ld hl,infstk
shld infsp
pop hl
ret
endif
;
; 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 ;temporry storge
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. storge 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