Subversion Repositories NedoOS

;
; 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