Subversion Repositories NedoOS

;
; cc2b.asm:
;
; Expression evaluator (code generator)
;  The text pointer is always assumed to be in HL
;  when evaluating expressions...
;
; Note that several of the high-level routines have
;  several entry points, some of which "force a value
;  result" (if the name ends with "v") and some that don't.
;  This is to allow optimization for expressions which don't
;  really need to produce a value; for example, the statement:
;               foo++;
;  obviously doesn't need to produce a result that was the old
;  value of foo, as if it were being used in a larger expression.
;  Thus, whenever possible, we try to detect stuff like this and
;  avoid needless code generation by using the appropriate entry
;  point within the expression evaluation routines.

;
; Top level expression evaluation entry point. Called
; from expression-statement processor only (never need return
; value when expression is entire statement):
;

exprnv: xor a
        sta val         ;allow optimizing for no ret val
        jp expr0

;
; General expression evaluator entry point from outside
; itself (i.e from within the statement processor as opposed to
;         from within expr itself):
;  Note that we might need a value here, if for example this
;  gets called from the "if" statement processor...
;

expr:   call ckabrt     ;check for abortion of complilation
        ld a,1
        sta val         ;we want a resulting value
expr0:  
        push hl         ;save current line count for general error diagnosis
        lhld nlcnt
        shld savnlc
        pop hl

        call opsin      ;initialize operator stack
        xor a
        sta faflg       ;clear func-arg flag
        sta lflg        ;clear logical-expr flag
        call expr1      ;evaluate
        call igsht      ;skip trailing gunk (white space)
        ret

;
; Recursive entry point. Handles:
;       expr
;       expr,expr (except when in fun arg list or 3rd ?: expr)
;
;       Upon entry, register A tells what we want:
;               00 = rvalue
;               01 = lvalue if possible
;               02 = must have lvalue
;       (this convention remains active down to many of the
;        lower level routines also...)

;
; Special entry point to force value result:
;

expr1v: ld b,a          ;save old A value
        lda val         ;and old val value
        push af
        or 01h          ;force value result
        sta val
        ld a,b          ;restore A value
        call expr1      ;evaluate
        ld b,a          ;save next char of text
        pop af          ;restore old val value
        sta val
        ld a,b          ;get back next char of text
        ret             ;and done

;
; Normal entry point:
;

expr1:  push af

exp1a:  call expr2      ;process expression
        lda faflg       ;in arg list?
        or a            ;if so, don't recognize comma operator
        jp nz,exp1b
                        ;process comma operator:
        call igsht      ;no. check for , operator
        cp comma
        jp nz,exp1ay    ;if none, go on
                        ;else process rest of comma expression:
        inc hl          ;pass over the comma
        call rpshp      ;reset push-op not to conflict with info from
        pop af          ;get back result-type-needed flag     \first sub-expr
        push af
        call expr1      ;call recursively to handle rest of comma expr
        call ppshp      ;restore push-opt table

exp1ay: call asgnop     ;check for assignment operator (covers hole
        jp nz,exp1b     ;       in expr syntax parser)
        ld de,stg8b
        jp perrab

exp1b:  pop af
        ret

;
; Secondary entry point...
; Handles:
;       expr
;       expr ? expr : expr
;

;
; Call this if we must generate a value
;

expr2v: ld b,a
        lda val
        push af
        or 01h          ;force value result
        sta val
        ld a,b
        call expr2
        ld b,a
        pop af
        sta val
        ld a,b
        ret

;
; Or call this if we don't care
;

expr2:  push af
        call pxpr3      ;peek past binary expression
        cp qmark        ;?: expression?
        jp nz,expr2a
        call ltabmp     ;yes, bump logical branch table
        call expr3
        jp qexpr        ;and go finish up in ?: handler

expr2a: pop af
        push af
        call expr3
        pop af          ;else done
        ret

;
; Little kludge routine to pass over simple and/or binary expressions:
;

pxpr3:  push hl         ;save text ptr and line count
        lhld nlcnt
        ex (sp),hl
        push hl
pxpr3a: call sexpas     ;pass by simple expression
        call binop      ;followed by binop?
        jp z,morpp3
        call igsht      ;make sure we get next char in A
        pop hl          ;no--all done
        ex (sp),hl              ;restore text ptr and line count
        shld nlcnt
        pop hl
        ret

morpp3: inc hl          ;yes--pass it and keep scanning
        jp pxpr3a


;
; Handles:
;       sexpr binop sexpr
;       sexpr asgnop sexpr
;       sexpr
;
;       Note: "sexpr" means "simple expression", defined here as
;             an expression having no binary, assignment, or ternary
;             operators at the top level (although it may have them
;             within parentheses)       

expr3:  push af
        call sexpasl    ;peek at token past simple expr
        jp nc,expr3b    ;carry from sexpasl indicates illegal
        pop af          ;  simple expression: error.
        ret

expr3b:
        call binop      ;binary operator?
        jp z,bexpr      ;if so, go handle binary expression
        call asgnop     ;assignment operator?
        jp nc,aexpr     ;if so, go handle assignment expression
        cp qmark        ; ?-: expr?
        jp nz,expr3a
        pop af          ;yes. don't care if lvalue wanted
        lda val
        push af ;save old val
        ld a,1          ;force value result, but don't force flag
        sta val         ;   result to be converted to hard value
        xor a           ;force rvalue of first expr
        call sgenv
        pop af
        sta val         ;restore val
        ret

expr3a: pop af          ;not ?: expr.
        call sgen       ;evaluate simple expression
        ret

sexpasl: push hl                ;peek past sexpr to see next
        lhld nlcnt      ;non-white-space character
        ex (sp),hl
        push hl
        call sexpas
        pop hl
        ex (sp),hl
        shld nlcnt
        pop hl
        ret


;
; Process simple (non-binary operator involved) expression
; of form:
;       * sexpr
;       & sexpr
;       - sexpr
;       ! sexpr
;       ~ sexpr
;       sizeof expr
;       pexpr   (primary expression)
;

;
; Recursive entry point to force value result:
;

sgenv:  ld b,a
        lda val
        push af
        or 01h
        sta val
        ld a,b
        call sgen
        ld b,a
        pop af
        sta val
        ld a,b
        ret

;
; Normal entry point:
;

sgen:   call sgen0
        call igsht
        ret

sgen0:  push af
        shld cdp        ;update code buffer pointer

        xor a
        sta klujf       ;clear short-cut-fetch-kludge flag

        call igsht      ;check for unary ops
        cp mulcd        ;indirection operator?
        jp nz,sgen3
        inc hl
        xor a
        call rpshp
        call sgenv      ;yes. evaluate operand.
        call ppshp
        xor a
        sta value
        pop af
        push af
        or a            ;need an address?
        jp nz,sgen2     ;if so, don't gen indirection
        call t2dim      ;else do. 2-dim array?
        jp z,sgen2a     ;if so, generate no code
        call tptrf
        jp z,sgen2a     ;same for ptr to func
        call tsptr      ;simple ptr?
        jp z,sgen0a     ;if so, go handle indirection
        call flshh1
        call maca0c     ;else get value of ptr to ptr
        jp sgen2a       ;and do internal indirection once only

maca0c: push af
        lda optimf      ;optimizing mem indirection?
        and 4
        jp z,maca0e
        ld a,0dfh       ;rst3: ld a,(hl);inc hl;ld h,(hl);ld l,a;ret
        call genb
maca0d: pop af
        ret
maca0e: ld de,maca0
        call mcrog
        pop af
        ret

sgen0a: lda typ1        ;ptr to struct?
        and 7
        cp 6
        jp z,sgen2a     ;if so, no code
sgen2:  call indir      ;do internal indirection on data type
        ld a,1          ;force a val result, so code such as: "*foo;" by itself
        sta val         ;used to clear a memory-mapped status port, works.
        jp sgen8        ;and wrap-up.

sgen2a: call indir
        pop af
        ret

sgen3:  cp ancd ;address-of operator?
        jp nz,sgen4
        ld a,2          ;if so, get address of operand
        inc hl          ;now HL -> operand
        call rpshp
        call sgenv      ;evaluate
        call ppshp
        call tptrf      ;ptr to func?
        jp z,sgen3b     ;if so, obscure.
        call tstar      ;array?
        jp z,sgen3b     ;if so, we can't represent it. just smirk.
        lda indc1       ;else bump indirection count
        inc a
        sta indc1
sgen3b: pop af          ;we don't care what was asked for here.
        ret

sgen4:  cp mincd        ;minus operator?
        jp nz,sgen5
        inc hl
        xor a
        call rpshp
        call sgenv      ;yes. eval argument
        call ppshp
        pop af
        call ckvok      ;make sure we don't need lvalue
        call tcnst1
        jp nz,sgen4a    ;constant?
        push hl         ;yes...
        lhld svv1
        call cmh
        shld svv1
        pop hl
        ret

sgen4a: call flshh1
        call tschr      ;simple char value to negate?
        ld de,mac0e
        jp nz,mcrog     ;if not, assume a 2 byte value
        ld de,mac01     ;else character. turn into "int"
        ld a,1
        sta typ1
        jp mcrog        ;and negate.

sgen5:  cp notcd        ;logical negation?
        jp nz,sgen6

        pop bc          ;get saved value code
        lda notklg      ;save notkludge
        push af
        push bc         ;and push saved value code back on stack

        xor a
        sta notklg      ;by default, no notkludge is to be performed

        inc hl          ;bump txt ptr to arg of !
        call igsht      ;check for "(" for a special case...
        cp open
        jp nz,sgen5z    ;if not, go handle normally
        lda val
        or a
        jp p,sgen5z     ;if don't need value, also go handle normally
        ld a,81h
;       sta val         ;turn into high force factor ;???why comment out???
        sta notklg      ;set "notkludge" flag

sgen5z: lda val         ;get result-type-needed flag
        cp 81h          ;if we need a value, then make sure we don't jump
        call z,ltabmp   ; out of range of the following expression

        call ltbflp     ;flip ltab label entries and used bit bits. (No effect
                        ;if a value is needed, since both T & F addrs are same)
        xor a
        call rpshp
        call sgenv
        call ppshp
        call ltbflp     ;flip ltab entries back to normal (if val is false)
        call ckaok      ;make sure arg is val or ptr

        lda val
        cp 81h          ;was a value needed?
        jp nz,sgen50    ;if not, don't clean up the range restriction
        call ltabtd     ;otherwise clean up possible jump references
        call ltabfd
        call ltabpp

sgen50: pop af
        call ckvok      ;details, details.

        call tcnst1     ;was expr a constant?
        jp nz,sgen5a
        push hl         ;yes. invert the logic.
        lhld svv1
        ld a,h
        or l
        jp z,sgn50a
        ld hl,-1
sgn50a: inc hl
        shld svv1
        pop hl
        pop af          ;restore notkluge
        sta notklg
        ret

sgen5a: lda notklg      ;was notkludge flag set?
        or a
        jp z,sgen5y     
                        ;OK--now we have to explicitly force into HL the value
                        ;that resulted from the expression...
        pop af
        sta notklg      ;first restore the kludge flag

        lda sval1       ;result a flag setting?
        and 4
        jp nz,sgn5ba    ;if so, make sure not to flush it!

        jp sgen5b       ;otherwise don't skip the flushing business.

sgen5y: pop af          ;restore old notkludge flag
        sta notklg

        lda sval1       ;was result of expr a flag being set?
        and 4   
        jp z,sgen5b

        lda sbmap1      ;yes. simply invert the logic of the flag setting
        xor 1
        sta sbmap1
        lda val         ;absolutely need value?
        cp 81h
        ret nz
        lda sval1       ;if so, make sure we convert current flag setting
        and 0dfh        ;into an absolute value
        sta sval1
        call cvtlvh
        ret

sgen5b: 
        call flshh1
sgn5ba: call tschr      ;character argument?
        ld de,mcn11     ;"ld a,l - or a"
        jp nz,sgen5c
        lda typ1        ;if so, make into int
        inc a
        sta typ1
        jp sgen5d
sgen5c: ld de,mcn10     ;else int.
sgen5d: call mcrog
        lda sval1       ;tell that flag is now set
        or 4
        sta sval1
        xor a           ;flags: Z true
        sta sbmap1
        lda val         ;need a REAL value in HL?
        or a
        ret p           ;if not, all done.
        ld de,macf1     ;else gen call to routine to set HL to 1 if
        call mcrog      ;Z is true
        lda sval1
        or 20h          ;tell that value is in HL as well as in flags
        sta sval1
        ld a,1
        sta typ1
        ret

ltbflp: push hl         ;hack routine to flip the true and false ltab
        push bc         ;entries, so that the not operator is real efficient
        lhld ltabp
        ld de,-5
        add hl,de               ;get HL pointing to start of current ltab entry
        ld e,(hl)               ;get true entry in DE
        inc hl
        ld d,(hl)
        inc hl
        push de         ;save it on stack
        ld e,(hl)               ;get false entry in DE
        inc hl
        ld d,(hl)
        inc hl
        ld a,(hl)               ;get flag byte
        call flpa       ;flip bits 0 and 7 of flag byte
        ld (hl),a               ;save it back
        dec hl
        pop bc          ;put back true entry where false entry was
        ld (hl),b
        dec hl
        ld (hl),c
        dec hl
        ld (hl),d               ;and put back false entry where true entry was
        dec hl
        ld (hl),e
        pop bc
        pop hl
        ret
;
; Switch bits 0 and 7 of the value in A:
;

flpa:   ld b,0
        or a            ;is bit 7 on?
        jp p,flpa2
        inc b
flpa2:  and 1           ;is bit 0 on?
        ld a,b
        ret z           ;if not, return with b7 of result off also
        or 80h          ;else turn on b7 of result
        ret

sgen6:  cp circum       ;bitwise negate?
        jp nz,sgen7
        inc hl
        xor a
        call rpshp
        call sgenv
        call ppshp
        call ckval      ;you get this all by now, right?
        pop af
        call ckvok
        call tcnst1
        jp nz,sgen6a
        push hl
        lhld svv1
        call cmh
        dec hl
        shld svv1
        pop hl
        ret

sgen6a: call flshh1
        call tschr
        ld de,mac1b
        jp nz,mcrog
        ld de,mac1a
        jp mcrog        ;was 'jp sgen5a'...why? ;???

sgen7:  cp sizcd        ;sizeof?
        jp nz,sgen7b
        pop af          ;clean up stack
        inc hl
        lda codflg
        push af
        xor a
        sta codflg      ;don't generate any code while doing this
        ld a,1          ;get lvalue if possible
        call sgenv
        pop af
        sta codflg      ;restore code generation flag
        push hl
        call analyz     ;set asize equal to size of object
        lhld asize
        call tptr       ; was it a pointer?
        jp nz,sgen7a
        ld hl,2         ;if so, size is always gonna be 2 bytes
sgen7a: shld sr0
        shld svv1
        ld hl,100h      ;set indc1 to 0 and typ1 to 1
        shld indc1
        dec h
        shld dimsz1     ;and zero dim size
        pop hl
        ld a,1
        sta sval1       ;make result a constant
        ret
        
sgen7b: pop af          ;well... no unary operator. must be
        push af ;just a plain ole' primary expr
        call rpshp
        call primg      ;evaluate it
        call ppshp

sgen8:  pop af          ;need address?
        cp 2
        jp nz,sgen8a
        call analyz     ;yes. Let's see if we got one...
        lda aadrf
        or a
        ret nz          ;if so, all ok.
        ld de,stg8      ;else look out!
        jp perr

sgen8a: ld b,a          ;address not mandatory.
        lda val         ;need we bother with value?
        and 1
        ret z           ;if not, we don't.
        lda value       ;pre-processed value?
        or a
        ret nz          ;if so, leave it alone
        call tsval      ;else...simple value?
        ret z           ;if so, fine.
        ld a,b
        dec a           ;else, is an lvalue OK?
        ret z           ;if so, done
        call tsptr      ;simple pointer?
        jp z,sgen8c     ;if so, OK.
        call tstar      ;array?
        jp z,sgen8c     ;that's OK too.
        call tsstr      ;structure?
        ret z           ;if so, just grin and bear it {It MIGHT
                        ; be something like (foo).bar}
                        ;is it a function? (i.e., a function name
        call tfun       ;without being a call or having addr taken?)
        ret z           ;if so, leave it alone.

sgen8c: call tptrf      ;ptr to func?
        jp z,sgen8g

        call tstar      ;array?
        jp nz,sgen8d

        lda frml1       ;yes. formal array?
        or a
        ret z           ;if not, all done.
        xor a           ;else make it NOT formal
        sta frml1       ;and indirect to get real base addr
        jp sgen8g

sgen8d: call tptr       ;pointer?
        jp z,sgen8g     ;if so, 2 byte indirect

        xor a           ;else must be simple lvalue.
        sta indc1       ;make it an rvalue
        call tschr      ;char?
        jp nz,sgen8g    ;if not, do full 2 byte indirection

;
; handle a character lvalue indirection:
;

        lda sval1       ;external char?
        and 8
        jp z,sgn8d4     ;if not, don't bother with kluge-fetch

        lda sval1       ;yes.
        and 1           ;abs lvalue?
        jp z,sgn8d3     ;if not, go do call hack

sgn8d9: ld de,mac40     ;yes. do lhld sr0, even tho we only need a char
        push hl         ;get address, stick in sr0
        lhld svv1
        shld sr0
        pop hl
        call mcrog
        xor a
        sta sval1
        ret


sgn8d3: lda optimf      ;optimize for space?
        or a
        jp z,sgn8d4     ;if not, go do normal speed optimization

        lda sval1       ;do we have a const lvalue to do it on?
        and 3
        jp nz,sgn8d5    ;if so, go do it

                        ;no.
sgn8d4: call flshh1     ;generate address of char, the hard way
        ld a,6eh        ;do an indirection
        call genb
        xor a
        sta sval1       ;all done
        ret

sgn8d5: lda svv1+1
        or a
        jp nz,sgn8d7    
        ld de,ssei
sgn8d6: ld a,0cdh
        call genb
        call addccc
        call gende
        jp sgen8j

sgn8d7: ld de,lsei
        jp sgn8d6

sgn8d8: call genb
        jp sgen8j       


;
; Handle 16 bit lvalue indirection:
;

sgen8g: lda sval1       ;if we have abs external object, always use lhld
        and 1
        jp nz,sgn8d9

        lda optimf      ;not abs external; ok to do c.ccc fetch optimization?
        or a
        jp z,sgn8g0     ;if so, go deal with it

        lda sval1       ;ok to optimize for space, if an lvalue const
        and 3           ;is it an lvalue constant?
        jp nz,sgn8g1    ;if not, go do the hard way

sgn8g0: call flshh1     ;else get address the hard way
        call maca0c     ;and do hard indirection
        ret

sgn8g1: lda sval1       ;external variable?
        and 8
        jp z,sgn8g3

        lda svv1+1
        or a
        jp nz,sgn8g2

        ld de,sdei
        jp sgn8d6

sgn8g2: ld de,ldei
        jp sgn8d6

sgn8g3: lda svv1+1      ;short or long displacement?
        or a
        jp z,sgn8g4
        ld de,ldli
        lda optimf
        and 20h
        jp z,sgn8d6
        ld a,0f7h       ;rst 6: jp ldli
        jp sgn8d8

sgn8g4: ld de,sdli
        lda optimf
        and 10h
        jp z,sgn8d6
        ld a,0efh       ;rst 5: jp sdli
        jp sgn8d8


sgen8j: lda svv1        ;now generate displacement.
        call genb       ;always do low order byte.
        lda svv1+1      ;but do high-order only if non-zero.
        or a
        call nz,genb
        xor a
        sta sval1
        ret


gende:  push de         ;generate code equal to DE:     
        ld a,e  
        call genb
        pop de
        ld a,d
        call genb
        ret

        
addccc: push hl
        lhld cccadr
        add hl,de
        ex de,hl
        pop hl
        ret


;
; Evaluate primary expression of form:
;       ++pexpr
;       --pexpr
;       pexpr++
;       pexpr--
;       pexpr[expr]
;       pexpr(arg list opt)
;       pexpr.identifier
;       pexpr->identifier
;       spexpr  (i.e, simple primary expr)
;
;  Note that whenever possible, this routine generates the
;  address of the object. Only special cases like constants
;  and functions may evaluate to constant values.
;

primg:  ld c,a
        xor a
        sta value       ;clear pre-processed-value flag
        sta indc1
        sta frml1
        sta klujf
        sta sbmap1
        xor a
        sta sval1
        push hl
        ld hl,0
        shld svv1
        shld dimsz1     ;clear array size
        pop hl
        call igsht
        cp pplus        ;leading ++ ?
        ld b,0
        jp z,prmg2a
primg2: cp mmin ;leading -- ?
        jp nz,primg3
        ld b,2          ;yes.
prmg2a: push bc
        inc hl
        ld a,2
        call sgenv      ;evaluate the lvalue
        pop bc  
        call tsclv      ;if character lvalue,
        jp z,prmg2b     ;  always get address into HL before doing ++ or --
        lda sval1       
        and 1
        jp nz,prim30    ;if abs external lvalue, DON'T flush addr into HL
        
prmg2b: call flshh1     ;flush to get lvalue in HL if not abs external non-char
        jp prim30       ;and perform the ++ or -- operation

primg3: call sprimg     ;process simple primary expr
primg4: call igsht      ;check for primary expr op
        cp open ;function call?
        jp z,primf
        cp openb        ;subscripting?
        jp z,primb
        cp period       ; . ?
        jp z,primp
        cp arrow        ; -> ?
        jp z,prima
primg6: call igsht
        cp pplus        ;trailing ++ ?
        jp nz,primg7
        ld b,1
        jp primg8

primg7: cp mmin ;trailing -- ?
        jp z,prmg7a

        cp varcd        ;primary expression followed by a name? if not,
        ret nz          ;all done with this primary expression.
        
        ld de,s4        ;probably a missing semicolon
        call perrsv
        ret
        
prmg7a: ld b,3
primg8: inc hl
        call tsclv      ;if simple character lvalue, always flush addr  
        jp z,primg9
        lda sval1       ;if abs external lvalue, DON'T flush
        and 1
        jp nz,prmg10
        
primg9: call flshh1     ;flush into HL for prim30
prmg10: call prim30     ;yes. perform post-decrement
        jp primg4




;
; Evaluate simple primary expression of form:
;       (expr)
;       string constant
;       numeric constant
;       identifier (variable name, that is)
;

sprimg: call igsht
        cp open ;left parenthesis?
        jp nz,sprms
        ld b,c
        call sprmp      ;yes. process expr in parens
        call igsht
        ret

;
; Process expression in parentheses:
;

trbnop: ds 1            ;trailing-binop flag, for use by sprmp

sprmp:  lda faflg       ;save old fun-arg flag
        push af
        lda trbnop
        push af ;save trailing binop flag
        xor a
        sta faflg       ;clear fun-arg flag
        sta trbnop      ;clear trailing binop flag
        lda val
        push af
        push hl         ;peek after (), looking for a primop
        lhld nlcnt
        ex (sp),hl
        push hl
        call mtchp
        call igsht
        cp pplus
        jp z,sprmp2
        cp mmin
        jp nz,sprmp3
sprmp2: lda val         ;we found a ++ or --; force lvalue result
        or 1            ;and thus force value result
        sta val
        ld a,2
        jp sprmp6

sprmp3: push bc
        call binop      ;() followed by binary operator?
        pop bc
        jp nz,sprmp4
        call lbinop     ;yes...if logical, don't worry about it
        jp z,sprmp4
        call ltabmp     ;not logical. bump ltab,
        ld a,81h
        sta val         ; and force value result
        sta trbnop      ;set trailing binop flag (so that
        ld a,b          ;restore evaluation code
        jp sprmp6       ; ltab will be popped later)

sprmp4: call primop
        ld a,b          ;if other primop
        jp nz,sprmp6
        lda val
        or 1
        sta val         ;force result
        xor a           ;get rvalue no matter what

sprmp6: pop hl
        ex (sp),hl              ;restore text pointer and line count
        shld nlcnt      ;to what they were before the
        ex (sp),hl              ;peek-ahead
        inc hl
        call expr1      ;evaluate inside of parens
        pop de
        pop af
        sta val         ;restore old val
        lda trbnop      ;trailing binop flag set?
        or a
        jp z,sprmp7

        call ltabtd     ;if so, define true and false ltab entries
        call ltabfd
        call ltabpp     ;and pop off the ltab entry

sprmp7: pop af
        sta trbnop      ;restore former trailing binop flag
        pop af
        sta faflg       ;restore old fun arg flag
        push de
        call igsht
        cp close        ;check for matching )
        jp z,sprmp8
        ex (sp),hl              ;if none, error.
        push hl
        lhld nlcnt
        ex (sp),hl
        shld nlcnt
        ld de,stg9
        call perr
        pop hl
        shld nlcnt
        pop hl
        call psemi
        ret

sprmp8: pop de          ;wrap up
        inc hl
        ld a,1  
        sta value
        ret

;
; If string constant, put string in-line, generate a 
; pointer to it and a jump around it:
;

sprms:  cp strcd        ;string constant?
        jp nz,sprmc
        xor a           ;yes. make type "pointer to chars"
        sta typ1
        ld a,2          ;and set up other type info
        sta indc1
        sta value
        inc hl          ;get the string code number in DE
        ld e,(hl)
        inc hl
        ld d,(hl)
        inc hl
        push hl         ;save text pointer
        lhld stgad      ;now search for the given string in the string pool
sprms1: ld c,(hl)
        inc hl
        ld b,(hl)
        inc hl
        ld a,b
        cp d
        jp nz,sprms2
        ld a,c
        cp e
        jp z,sprms3     ;found string code match?
sprms2: push de         ;no. try next string in pool
        ld e,(hl)
        ld d,0
        inc de
        add hl,de
        pop de
        jp sprms1

sprms3: push hl         ;found string. check for folding potential and
        call entstr     ;enter into table if a new unique string...
        pop hl
        jp c,sprms4     ;was the table out of space?
        ex de,hl                ;no. put label code for the string into HL
        shld sr0
        ld de,mac98a    ;ld hl,sr0 (with a forward reference)
        call mcrog
        pop hl          ;restore text pointer
        ret             ;all done

sprms4: push hl         ;generate ld hl,foo - jp bar - foo: <text>,0 - bar:
        call glbl       ;set up some symbolic labels
        shld sr0
        call glbl
        shld sr1
        ld de,mac98
        call mcrog
        pop hl
        ld b,(hl)               ;found it. B holds length; now generate the
sprms5: inc hl          ;string characters.
        ld a,b
        or a
        jp z,sprms6     ;done?
        ld a,(hl)               ;no. generate next byte
        call genb
        dec b
        jp sprms5       ;and go for more

sprms6: xor a           ;generate trailing null byte
        call genb
        lhld sr1        ;and define the symbolic label
        ex de,hl                ;at the end of the string (this is the object
        call entl       ;of the jump after the ld hl,string instruction
        pop hl
        ret

entstr: push hl         ;calculate label code for a new string
        ld hl,strtb     ;if already in table, return old code, else enter it.
ntstr0: ld e,(hl)               ;get next label # from table into DE
        inc hl
        ld d,(hl)
        inc hl
        ld a,d          ;end of table?
        or e
        jp nz,ntstr0

        push hl         ;yes. check to see if table is full
        push de
        call cmh        ;HL := -(table pointer)
        ld de,strtb+strsz
        add hl,de               ;calcualate (end - current_pointer)
        pop de
        ld a,h
        pop hl
        or a            ;overflow?
        jp p,ntstr1
        pop hl          ;yes.
        scf             ;return carry
        ret

ntstr1: ex de,hl                ;there is room for another entry
        call glbl       ;get new label code
        ex de,hl                ;put into DE
        dec hl
        ld (hl),d               ;enter label code in table
        dec hl
        ld (hl),e
        inc hl
        inc hl          ;now enter pointer to text
        pop bc          ;which was on the stack
        ld (hl),c
        inc hl
        ld (hl),b
        inc hl          ;and clear next field as end flag
        xor a
        ld (hl),a
        inc hl
        ld (hl),a
        ret             ;all done.


        IF 0            ;disable string-folding, since it isn't standard...

ntstr2: ld c,(hl)               ;compare current table entry with given text
        inc hl
        ld b,(hl)               ;BC :=  --> current table entry text
        inc hl
        ex (sp),hl              ;HL := new string entry being processed
        push hl         ;save the starting addr of the label
        push de         ;save the label code
        ld a,(bc)               ;check length bytes against each other
        cp m
        jp z,ntstr4     ;same length?
ntstr3: pop de          ;no, so a mismatch right off.
        pop hl
        ex (sp),hl              ;restore stuff for another try
        jp ntstr0

ntstr4: ld d,a          ;ok, lengths match. now compare text
        inc d           ;D holds char count
ntstr5: dec d           ;done?
        jp nz,ntstr6
        pop de          ;yes...we have a match. use old label code (in DE now)
        pop hl
        pop hl          ;restore HL
        ret             ;and done

ntstr6: inc bc          ;keep on comparing the two strings
        inc hl
        ld a,(bc)
        cp m
        jp z,ntstr5     ;still matching? if so, keep going.
        jp ntstr3       ;no. go on to next entry

        ENDIF


;
; If numeric constant, generate "ld hl,whatever"
;

sprmc:  cp concd        ;constant?
        jp nz,sprmv
        inc hl          ;yes. get the value in DE
        ld e,(hl)
        inc hl
        ld d,(hl)
        inc hl
        ex de,hl                ;generate ld hl,value
        shld svv1
        ex de,hl
        ld a,1          ;make type integer
        sta typ1
        sta sval1       ;make it a constant
        call igsht
        ret

;
; Process an identifier. If not an identifier, error.
;

sprmv:  cp varcd        ;identifier?
        jp z,sprmv2
        ld de,stg10     ;no. At this point it can't be anything
        call perrsv     ;else except an error. Find the next semicolon
        call fsemi      ;and attempt to keep going from there.
        ret

sprmv2: call lookup     ;look up the identifier in the symbol table.
        ex de,hl
        shld sr0        ;save displacement for later code generating use
        shld svv1
        ex de,hl                ;and leave in DE also
        lda typ1        ;is it a struct or union element?
        and 80h
        jp z,sprmv3
        ld de,stg20     ;if so, error.
        call perr
sprmv3: lda typ1        ;is it a function?
        and 40h
        jp z,sprmv5
        sta simpf       ;yes. set "simple function" (as opposed to a pointer
        lda indc1       ; to a function) flag. Then fudge the indirection
        or a            ; count if necessary.
        jp z,sprmv4
        inc a
        sta indc1
sprmv4: call igsht      ;followed by an open paren?
        cp open
        ret z           ;if so, is a simple function and may be ignored.
        push hl         ;else is not so simple.
        lhld dimsz1     ; used to generate ld hl,addr; NOW generate:
        inc hl          ;               lhld addr+1
        shld sr0
        ld hl,0
        shld dimsz1
        ld de,mac40r    ; lhld sr0 (relocated)
        call mcrog
        pop hl
        xor a           ;and reset the simple function call flag.
        sta simpf
        ret

sprmv5: call tptrf      ;pointer to func?
        jp z,sprv5a     ;if so, don't touch indir count
        lda indc1       ;else do.
        inc a
        sta indc1
sprv5a: ld a,2
        sta sval1
        lda vext        ;external?
        or a            ;if not, all done
        ret z

        ld a,0ah        ;yes; make it external and an lvalue
        sta sval1       ;set the external bit.
        lda eflag       ;absolute external mode enabled?
        or a
        ret z           ;if not, all done

        push hl         ;if absolute externals enabled,
        lhld exaddr     ;get the base address
        add hl,de               ;add to offset
        shld svv1       ;and make that the value
        ex de,hl                ;leave it in DE also
        pop hl
        ld a,0bh        ;now: external, an lvalue, and a constant!
        sta sval1       
        ret

genllv: push hl
        lhld sr0
        ld a,h
        or l
        pop hl
        jp z,genlv2
        ld de,mac41
        call mcrog
        ret

genlv2: ld a,60h        ;if has local displacement of zero,
        call genb       ;can skip the "ld hl,disp add hl,bc" and
        ld a,69h        ;just do a "ld h,b  ld l,c" instead.
        call genb       ;(a little optimization here, a bit there...)
        ret

;
; Process subscript expression (on entry, HL -> "[")
;

primb:  call analyz     ;check for pointer base
        lda amathf      ; (weed out illegal bases)
        or a
        jp z,prmb2a
        call tstar      ;array?
        jp z,prmb1      ;if so, not pointer base.
        lda value       ;pre-processed value?
        or a
        jp nz,prmb1
        call tptr       ;no. pointer?
        jp nz,prmb1
        call indnoc
prmb1:  xor a
        sta value
        inc hl
        lda frml1
        or a
        jp z,prmb2
        call tstar
        jp nz,prmb2
        call indnoc
        xor a
        sta frml1

prmb2:  call tptr
        jp z,prmb3
prmb2a: ld de,stg16     ;illegal array base error
        call perr

prmb3:  ex de,hl
        lhld indc1
        push hl
        lhld dimsz1
        push hl
        lhld strsz1
        push hl
        lhld asize
        push hl
        lhld sval1
        push hl
        lhld svv1
        push hl
        ex de,hl
        lda faflg
        push af
        xor a
        sta faflg
        call tcnst1
        call z,rpshp
        call nz,spshp
        xor a
        call expr1v     ;evaluate subscript
        lda sval1
        sta ssval
        and 1
        call z,flshh1   ;if not constant, flush subscript
        xor a
        sta value
        pop af
        sta faflg
        xor a
        sta frml1
        call tsval
        lda typ1
        ex de,hl
        lhld svv1
        shld subval
        pop hl
        shld svv1
        pop hl
        shld sval1
        pop hl
        shld asize
        pop hl
        shld strsz1
        pop hl
        shld dimsz1
        pop hl
        shld indc1
        ex de,hl
        jp z,prmb4
        ld de,stg15
        call perr
        inc hl
        jp primg4

prmb4:  push hl
        push af
        lda ssval
        and 1           ;was subscript a constant?
        jp z,prmb4b
        call ppshp      ;yes.
        lda sval1       ;is base a constant too?
        and 3
        jp z,prmb4a
        lhld asize      ;yes; entire expression can be constant
        call mult
        ex de,hl
        lhld svv1
        add hl,de
        shld svv1
        pop af
        jp prmb6d

prmb4a: pop af
        lhld asize      ;we have const subscript, but NOT constant base
        call mult       ;entire subscrip expr can be a constant
        push hl         ;..add it to the base.  
        call flshh1     ;generate code for the base
        pop de
        call maddd      ;and code to add subscript to it
        jp prmb6c       ;and go wrap up

prmb4b: pop af          ;NOT constant subscript; has been flushed into HL
        or a            ;char value?
        jp nz,prmb5
        ld de,mac61     ;yes, clear H
        call mcrog

prmb5:  lhld asize      ;get final subscript value into HL
        call gnmulh     ;gen code to mult HL by asize
        call ppshp
        call tcnst1     ;was base a constant lvalue?
        jp z,prmbts     ;if so, go handle that scwewy case.
                        ;this stuff commented out for now; perhaps forever.

        call gpopd      ;gen code to pop base into DE

prmbad: ld a,19h        ;"add hl,de"
        call genb

prmb6c: xor a           ;result in HL
        sta sval1

prmb6d: pop hl          ;clean up.
        inc hl
        call indir
        jp primg4

indnoc: call flshh1
        call maca0c
        ret

prmbts: lhld svv1
        shld sr0
        lda sval1
        and 8
        jp nz,prbts2
        call gexdehl    ;'ex de,hl' subscript into DE
        call genllv
        jp prmbad

prbts2: lda sval1
        and 1
        jp z,prbts3
        ld de,mac0c
        call mcrog
        jp prmb6c

prbts3: ld a,h          ;save adjusted subscript on stack, unless base 
        or l            ; address of array is zero...
        call nz,gpushh  ;either save adjusted subscript 
        call z,gexdehl  ;or just put it in DE for a while
        ld de,mac6a
        call mcrog      ;do 'lhld extbas'
        ex de,hl                ;add relative external address to extbas
        push de
        call maddd
        pop hl
        ld a,h
        or l            ;now, if subscript was pushed on the stack,
        call nz,gpopd   ;get back adjusted subscript (else don't)
        jp prmbad       ;and go add it


;
; Process function call:
;

primf:  call tfun       ;was thing before '(' a function?
        jp z,prmf2
        ld de,stg11     ;if not, error.
        call perr
        call mtchp
        jp primg4

prmf2:  xor a
        sta argcnt      ;clear arg count
        lda simpf       ;OK...is it a simple function call?
        or a
        jp z,prmf4
        call sargs      ;yes. process args
        ld de,mac08     ;generate "call" op

prmf3:  call mcrog

        lda argcnt      ;now restore stack. more than 6 args?
        cp 7
        jp c,prmf3a

        push hl         ;yes. use the long sequence.
        ld l,a
        ld h,0          ;HL = argcnt
        add hl,hl               ;HL = # of bytes of stack used
        shld sr0
        pop hl
        ld de,mac8ar    ;long code sequence to reset SP
        call mcrog      
        jp prmf3c

prmf3a: ld b,a          ;save count in B
        inc b
prmf3b: dec b
        jp z,prmf3c
        call gpopd      ;"pop de" for each arg
        jp prmf3b       

prmf3c: lda typ1        ;set type of returned value
        and 0bfh
        sta typ1
        ld a,1
        sta value
        call igsht
        jp primg4

prmf4:  call flshh1
        call gpushh     ;handle non-simple function call
                        ;gen code to push func address
        call sargs      ;process args
        lda argcnt      ;bump arg count to account for pushed func addr
        inc a           ;   later when we reset the SP after returning
        sta argcnt      

        push hl         ;generate code to retrieve function addr we
        ld l,a          ;pushed before processing args.
        ld h,0
        add hl,hl               
        shld sr1        ;special displacement needed by mac8a
        pop hl

        ld de,mac8a     ;special non-simple function call code sequence
        jp prmf3

; 
; Process function argument list:
;

sargs:  ex de,hl                ;save HL
        lhld dimsz1
        push hl
        lhld indc1
        push hl
        lhld strsz1
        push hl
        lhld sval1
        push hl
        lhld svv1
        push hl
        lda simpf
        push af

        ex de,hl                ;restore HL

;
; Now push the beginning address of the text of each function
; argument: (# of addresses pushed will end up in argcnt)
;

srgs0:  inc hl
srgs1:  call igsht
        cp close
        jp z,srgs3      ;if end of arg list, go backtrack and evaluate...

srgs2:  push hl         ;else another arg to push text address of.

        ex de,hl                ;save text ptr in DE
        lhld nlcnt      ;save the line number associated with the arg text
        push hl
        ex de,hl                ;restore text ptr

        push bc
        lda argcnt
        inc a
        sta argcnt
                        ;pass over an arg. This is much neater than the old
        call pasarg     ;way of disabling code generation and evaluating the
                        ;arg!
        pop bc
        call igsht
        cp comma        ;arg followed by comma?
        inc hl
        jp z,srgs2      ;if so, bump text pointer and look for more args
        dec hl          ;else look for close paren

srgs2a: cp close
        call nz,plerr   ;if not followed by a close paren, error

srgs3:  push hl
        lhld nlcnt
        shld savcnt     ;save line count for end of list
        pop hl

;
; Now, for each saved address, generate the code for
; the argument and push it:
;

srgs4:  shld savtxt     ;save text pointer to end of list

        lda argcnt      ;get arg count  
srgs5:  or a
        jp z,srgs6      ;done?
        push af ;save argcount
        call igsht      ;if not, we'd better be staring at a comma!
        cp comma
        jp z,srgs5a
        cp close
        call nz,plerr   ;tell about it if we aren't
srgs5a: pop af          ;get back argcount
        pop hl          ;restore the line number matching the arg
        shld nlcnt
        pop hl          ;get text of previous arg and evaluate
        push af ;save argcnt

        lda val
        push af ;save current state of val
        or 81h          ;force value result even for logical expressions
        sta val
        call doarg
        call igsht
        pop af
        sta val         ;restore former state of val

        lda sval1
        and 0c0h
        call z,gpushh   ;generate "push hl" if value in HL
        call nz,gpushd  ;else "push de" is called for

        pop af          ;get back argcnt
        dec a           ;de-bump
        jp srgs5        ;and go do next arg     

;
; Come here to diagnose a parameter list error:
;

plerr:  ld de,stgbf     ;else must've been a parameter list error
        call perr
        call fsemi
        dec hl
        ret

;
; This routine passes over the text of a function arg--all parens,
; brackets get matched, and first comma or close paren at upper
; level terminates the scan.
;

pasarg: call pascd2     ;ignore codes and cruft
        cp openb        ;if [,
        jp nz,pasrg2
        call mtchb      ;find matching ]
        jp pasarg       ;and go on

pasrg2: cp open ;if (,
        jp nz,pasrg3    ;find matching )
        call mtchp
        jp pasarg       ;and go on

pasrg3: cp comma        ;if comma
        ret z           ;found end
        cp close        ;same for top level )
        ret z
        call badxch     ;is character OK in an expression?
        ret c           ;return w/carry set if no good
pasrg4: inc hl          ;else scan to next character
        jp pasarg

;
; Return C set if keyword code in A is illegal within an expr:
;

badxch: cp semi ;semicolon no good
        scf
        ret z
        cp sizcd        ;sizeof OK
        ret z
        cp rbrcd+2      ;if <= maincode, no good
        ret

;
; Restore everything and prepare to generate calling sequence:
;

srgs6:  pop af
        sta simpf
        lhld savcnt     ;get line count for end of list
        shld nlcnt      ;restore as current count
        pop hl
        shld svv1
        pop hl
        shld sval1
        pop hl
        shld strsz1
        pop hl
        shld indc1
        pop hl
        shld sr3
        ld hl,0
        shld dimsz1
        lhld sfsiz
        shld sr0
        call glbl
        shld sr2

        lhld savtxt     ;get back text pointer
        inc hl
        ret

;
; Process the arg at HL, either generating code or not depending
; on the state of codflg:
;

doarg:  lda faflg       ;bump funarg flag so commas are treated
        inc a           ;as terminators instead of operators.
        sta faflg

        lda argcnt
        push af

        ex de,hl
        lhld savtxt
        push hl
        lhld savcnt
        push hl
        lhld nlcnt      ;save nlcnt of START of arg for error reports
        push hl
        ex de,hl

        call rpshp
        call ltabmp     ;bump ltab, to keep logical branches from escaping
        xor a           ;evaluate arg
        call expr1v
        
        call igsht      ;make sure arg is followed by comma or close paren
        cp comma
        jp z,doarg1     ;if comma, OK
        cp close

        ex de,hl                ;get nlcnt that was valid at START of arg, so error
        pop hl          ;report points to beginning of illegally-terminated
        shld nlcnt      ;parameter
        push hl
        ex de,hl

        call nz,plerr   ;if nor comma or close paren, complain

doarg1: call ltabfd     ;come here whether false
        call ltabtd     ;               of true
        call ltabpp     ;value results from arg expression
        call ppshp

        lda sval1       ;if a constant,
        and 3
        call nz,flshh1  ;flush into HL
                        ;else might be in either HL or DE
        ex de,hl                ;restore state
        pop hl          ;clean up stack (pushed nlcnt earlier)
        pop hl
        shld savcnt
        pop hl
        shld savtxt
        
        ex de,hl

        pop af
        sta argcnt

        call tschr      ;and generate code to zero high byte 
        jp nz,doarg2    ;if arg is a char
        lda sval1       ;clear H if value in HL
        and 0c0h
        ld de,mac61
        call z,mcrog
        ld de,mac62     ;else clear D
        call nz,mcrog

doarg2: lda faflg       ;reset funarg flag to handle commas correctly
        dec a
        sta faflg
        ret

;
; Handle -> operator:
;

prima:  inc hl
        call analyz
        call tptrf
        jp z,prmae      ;ptr to func no good as base
        lda amathf
        or a
        jp z,prmae      ;base no good if can't do math on it
        lda aadrf       
        or a
        jp z,prma2      ;if not an address, don't need to indirect
        lda avar
        or a
        jp z,prma0      ;if not a variable, also don't need to indirect
        call tschr      ;no characters allowed as base
        jp z,prmae

prma0:  call tstar      ;is the base an array?
        jp nz,prma1
        lda frml1       ;yes...a formal one?
        or a
        jp z,prma2      ;if not, don't indirect
prma1:  lda value       ;if base already a value, don't indirect
        or a
        jp nz,prma2
        call sgen8g     ;else get the value of the pointer on left of ->
        jp prma2        ;and go add the member address

prmae:  ld de,stg17     
        call perr

prma2:  call igsht
        cp varcd
        jp z,prma3

prmae2: call sexpas
        ld de,stg19
        jp perr

prma3:  call lookup
        lda typ1
        and 80h
        jp nz,prma4
prma3b: ld de,stg19     ;bad member name found
        call perr
        jp primg4

prma4:  call primap
        call tcnst1     ;now, if base is a constant, don't bother generating
        jp nz,prma5     ;any code. is it a constant?
        push hl
        lhld svv1       ;yes. Add member offset to svv1.
        add hl,de
        shld svv1       ;now wasn't that easy?
        pop hl
        jp primg4       ;go skip over the code generation part

prma5:  push de
        call flshh1     ;make sure base is in HL
        pop de
        call maddd
prma6:  xor a
        sta sval1
        jp primg4

;
; Handle "." operator:
;

primp:  call tsval
        jp nz,primp2
        ld de,stg17
        call perr
primp2: inc hl
        call igsht
        cp varcd
        jp nz,prmae2
        call lookup
        lda typ1
        and 80h
        jp z,prma3b
        call tcnst1
        jp z,primp3
        push de
        call flshh1     ;if not constant, get base in HL
        pop de
        jp prma4        ;and go add member displacement value

primp3: push hl
        lhld svv1
        add hl,de
        shld svv1
        pop hl
        call primap
        jp primg4

primap: lda typ1
        and 7fh
        sta typ1

;       and 20h
;       ret nz

        ;nop
        ;nop
        ;nop ;???

        lda indc1
        inc a
        sta indc1
        xor a
        sta value
        ret


;
; Handle ++ and -- operation on lvalue:
;

prim30: lda val
        or a            ;check if we need result value
        jp nz,prim30b   ;if so, get it.
        call igsht      ;else no value explicitly needed
        call primop     ;trailing primary operator?
        jp z,prim30a    ;if so, play safe & force value
        ld a,b          ;else optimize for no result value!
        and 0feh        ;and make post ops into pre ops
        ld b,a
        jp prim30b

prim30a: ld a,1
         sta val

prim30b: call prm30
        xor a
        sta frml1
        ret

prm30:  ld a,1
        sta value
        call analyz
        lda asnokf
        or a
        jp z,p30err
        lda amathf
        or a
        jp nz,p30a
p30err: ld de,stg8a
        jp perr

p30a:   lda avar
        or a
        jp z,p30b
        xor a
        sta indc1
        lda typ1
        or a
        jp nz,p30a2
        lda val
        ld c,0
        or a
        jp z,domac
        inc c
        jp domac

p30a2:  lda sval1       ;abs external addr?
        and 1
        jp nz,p30a3

        ld c,2          ;no.
        call domac
        inc c
        lda val
        or a
        call nz,domac
        ld a,40h
        sta sval1
        ret

p30a3:  push hl         ;yes.
        lhld svv1
        shld sr0
        pop hl
        ld c,8
        call domac
        inc c
        lda val
        or a
        call nz,domac
        xor a
        sta sval1
        ret


p30b:   lda sval1       ;abs external addr?
        and 1
        jp nz,p30g

        ld de,m20       ;no.
        lda optimf      ;-z7 in effect?
        and 40h
        jp z,p30ba
        ld de,m20z

p30ba:  call mcrog
        lda val
        or a
        jp z,p30c
        call ckle2
        jp z,p30c
        ld c,4
        call domac
p30c:   call ckle2
        jp nz,p30d
        ld c,5
        call domac
        lda asize
        dec a
        jp z,p30e
        ld c,5
        call domac
        jp p30e

p30d:   push hl
        lhld asize
        shld sr0
        ld a,l
        sta sr1+1
        ld a,h
        sta sr2+1
        ld a,0d6h
        sta sr1
        ld a,0deh
        sta sr2
        pop hl
        ld c,6
        call domac
p30e:   ld de,m28
        call mcrog
        ld a,40h
        sta sval1
        lda val
        or a
        ret z

        call ckle2
        jp z,p30f
        ld c,7
        jp domac

p30f:   ld c,3
        call domac
        lda asize
        dec a
        ld c,3
        call nz,domac
        ret

p30g:   push hl         ;yes, abs external addr.
        lhld svv1
        shld sr0
        pop hl
        ld de,mac40     ;do 'lhld foo'
        call mcrog
        lda val         ;need value result?
        or a
        jp z,p30h
        call ckle2      ;yes.
        jp z,p30h
        ld c,10 ;push old value
        call domac
p30h:   call ckle2
        jp nz,p30i
        ld c,11
        call domac
        lda asize
        dec a
        jp z,p30j
        ld c,11
        call domac
        jp p30j

p30i:   push hl
        lhld asize
        shld sr1
        call cmh
        shld sr2
        pop hl
        ld c,12
        call domac
p30j:   ld de,mac09     ;do: 'shld foo'
        call mcrog
        xor a
        sta sval1       ;result in HL
        lda val         ;need result?
        or a
        ret z           ;if not, all done
        call ckle2      ;else restore former value...
        jp z,p30k
        ld c,13
        jp domac

p30k:   ld c,9
        call domac
        lda asize
        dec a
        ld c,9
        call nz,domac
        ret


ckgt2:  lda asize+1
        or a
        jp nz,invrt
        lda asize
        cp 3
        ret c
        xor a
        ret

ckle2:  call ckgt2
        jp invrt

mact:   dw m12a,m12a,m14a,m14a          ;c = 0
        dw m12,m13,m14,m15              ;c = 1
mactz:  dw m16b,m16b,m18,m18            ;c = 2
        dw mnul,m23,mnul,m22            ;c = 3
        dw mnul,m21,mnul,m21            ;c = 4
        dw m22,m22,m23,m23              ;c = 5
        dw m26,m26,m27,m27              ;c = 6
        dw mnul,m30,mnul,m30            ;c = 7

        dw me16b,me16b,me18,me18        ;c = 8
        dw mnul,me23,mnul,me22          ;c = 9
        dw mnul,me21,mnul,me21          ;c = 10
        dw me22,me22,me23,me23          ;c = 11
        dw me26,me26,me27,me27          ;c = 12
        dw mnul,me30,mnul,me30          ;c = 13


;
; New ALU code generator for v1.4
;       info2 OP inf1 --> destination
;
; where info2 is either: a) in a reg, b) a constant, or c) on the stack,
;  and  info1 is either: a) in a reg, b) a constant, or c) a flag setting
;  and  destination is either a register or a constant.
;

alugen: sta op          ;save operator code
        xor a           ;clear "make result type that of info2" flag
        sta par2pf      ;and clear "two pointers" flag
        call nolvs      ;make sure there aren't any flag settings
        call tpshd      ;info2 pushed?
        jp nz,alugo     ;if not, all set to compute
        call tcnst1     ;yes. is info1 a constant?
        jp z,alu1               ;if so, go pop info2 into DE
        lda sval1       ;no...is info1 value in HL?
        and 0c0h
        jp nz,alu2      ;if not, pop info2 into HL
alu1:   call gpopd      ;pop info2 into DE
        ld a,40h
        jp alu3
alu2:   call gpoph      ;pop info2 into HL
        xor a
alu3:   sta sval2       ;tell that value is now in the appropriate reg
        jp alugo


;
; Make sure we don't have any flag settings to bum around with
;

nolvs:  lda sval1       ;info1 a flag setting?
        and 4
        jp z,nolvs2
        lda sval1       ;yes. value too?
        and 24h
        cp 24h
        jp nz,nolvs1
        lda sval1       ;yes-make value only (preserving register bits)
        and 0c0h
        sta sval1
        jp nolvs2

nolvs1: lda sval2       ;info1 is flag only. is info2 in HL?    
        and 0c3h
        jp z,flshd1     ;if so, put value in DE
        jp flshh1       ;else put it in HL

nolvs2: lda sval2       ;info2 a flag setting?
        and 4
        ret z
        lda sval2       ;yes. do we have a value already?
        and 24h
        cp 24h
        jp nz,nolvs3
        lda sval2       ;yes. make value only, preserving register
        and 0c0h
        sta sval2
        ret

nolvs3: lda sval1       ;info2 is flag only. info1 in HL?
        and 0c3h
        jp z,flshd2     ;if so, put value in DE
        jp flshh2       ;else put in HL

;
; Flush all relative constants into registers
;

flrcn:  lda sval1       ;info1 a rel const?
        and 2
        jp z,frcn2      ;if not, go check out info2
        call tcnst2     ;info2 a constant?
        jp nz,frcn1

        call flshh1     ;yes-flush info1 into HL
        jp flrcn        ;and go take care of info2

frcn1:  lda sval2       ;info1 is rel lv. bummer. push info2
        and 0c0h
        call z,gpushh
        call nz,gpushd
        call flshh1     ;flush info1 into HL
        call gpopd      ;get info2 back into DE
        ld a,40h        ;tell that info2 is in DE
        sta sval2
        ret


frcn2:  lda sval2       ;info1 NOT a rel constant. info2 a rel const lv?
        and 2
        ret z           ;if not, all done

        call tcnst1     ;yes--info1 an abs constant?
        jp nz,frcn3
        call flshh2     ;yes, so flush info2 into HL
        ret     

frcn3:  lda sval1       ;info2 is rel lv. bummer. push info1
        and 0c0h
        call z,gpushh
        call nz,gpushd
        call flshh2     ;flush info2 into HL
        call gpopd      ;get info2 back into DE
        ld a,40h        ;tell that info2 is in DE
        sta sval1
        ret


alugo:  push hl         ;do this to preserve text ptr in HL
        xor a
        sta wierdp
        call alugo1
        pop hl
        ret

wierdp: ds 1            ;true for: (info2 - info1), when info2 ptr & info1 val

alugo1: lhld svv1
        shld sr0
        lhld svv2
        shld sr1
        lda op

        cp eqcd ;== and not= are special
        jp z,alueq
        cp neqcd
        jp z,alune

        call analyz
        lda amathf
        or a
        jp z,parerr

        call anal2
        lda amathf
        or a
        jp z,parerr

        xor a
        sta hbn1cf

        lhld indc1      ;turn all characters into
        call aluadj     ;integers, and adjust attributes
        shld indc1      ;as required.
        call z,clhbn1
        lhld indc2
        call aluadj
        shld indc2
        call z,clhbn2

        lda op
        cp mulcd
        jp nz,aludiv


        call usuals     ;handle `*' op
        ld de,smmulu
        jp z,spcash
        ld de,smmuls
        jp spcash

aludiv: cp divcd
        jp nz,alumod
        call usuals     ;handle `/' op
        ld de,smdivu
        jp z,spcash
        ld de,smdivs
        jp spcash

alumod: cp modcd
        jp nz,aluadd
        call usuals     ;handle `%' op
        ld de,smmodu
        jp z,spcash
        ld de,smmods
        jp spcash

aluadd: cp plus
        jp nz,alusub
        call nolvwr     ;permit no rel-lvalue/reg-value combinations
        call paradj     ;handle `+' op

        call tbabsc
        ld de,smadd
        jp nz,spcash

        lhld svv1       ;handle simple constants here
        ex de,hl
        lhld svv2
        add hl,de
        shld svv1
        lda wierdp      ;need to copy sval2 to sval1?
        or a
        ret z

aluad3: lda sval2
        and 3fh
        ld b,a
        lda sval1
        and 0c0h
        or b
        sta sval1       ;yes, so do it
        ret

;
; Make sure we don't end up with one operand being a relative lvalue
; constant and the other a value in a register:
;

nolvwr: lda sval1
        and 3           ;info1 in a reg?
        jp z,flrcn      ;if so, go flush info2 if it is a rel lvalue
        lda sval2
        and 3           ;info2 in a reg?
        jp z,flrcn      ;if so, go flush info1 if it is a rel lvalue
        ret

alusub: cp mincd
        jp nz,alusr
        call nolvwr     ;permit no rel-lvalue/reg-value combinations
        call paradj     ;handle `-' op
        call tbabsc
        ld de,smsub
        call nz,spcash
        lhld svv1       ;do this just in case we had two constants
        call cmh
        ex de,hl
        lhld svv2
        add hl,de
        shld svv1

        lda par2pf      ;two pointers?
        or a
        jp nz,alus1     ;if so, go scale result by object size
        
        lda wierdp      ;no. Was it an (ptr - val) expression?
        or a
        jp nz,aluad3    ;if so, go set info1 to type of info2
        ret             ;else info1 is correct type-all done.


alus1:  lhld asize      ;we've gotta scale result by object size
        shld sr0
        dec hl
        ld a,h
        or l            ;size = 1?
        jp z,alus2      ;if so, don't do nuthin'
        ld de,macad3    ;else gen code to divide by object size
        call tbabsc
        call nz,mcrog   ;but don't bother if both constants
        call z,divs1a   ;in case they're constants, calculate value here
alus2:  ld hl,0
        shld dimsz1
        xor a
        sta indc1
        inc a
        sta typ1
        call tbabsc     ;if both were abs constants,
        ret nz
        ld a,1
        sta sval1       ;result is ABS constant (even if both args were lv's)
        ret

alusr:  cp srcd
        jp nz,alusl
        call ckval2     ;handle `>>' op
        call flrcn
        call tbabsc
        ld de,smsr
        jp nz,spcash
        lhld svv2       ;do constant case
        lda svv1
        ld b,a
        inc b
alusr2: dec b
        jp z,alusl3
        xor a
        ld a,h
        rra     
        ld h,a
        ld a,l
        rra
        ld l,a
        jp alusr2


alusl:  cp slcd
        jp nz,alugt
        call ckval2     ;handle `<<' op
        call flrcn
        call tbabsc
        ld de,smsl
        jp nz,spcash
        lhld svv2       ;do constant case
        lda svv1
        inc a
alusl2: dec a
        jp z,alusl3
        add hl,hl
        jp alusl2

alusl3: shld svv1
        ret

alugt:  cp gtcd
        jp nz,aluge
alugt2: call usual2     ;do '>' op
        ld de,smgtu
        jp z,spcash
        ld de,smgts
        jp spcash

aluge:  cp gecd
        jp nz,alult
        call alult2     ;do '>=' (simply inverse of '<')
        jp alune1

alult:  cp ltcd
        jp nz,alule
alult2: call usual2     ;do '<' op
        ld de,smltu
        jp z,spcash
        ld de,smlts
        jp spcash

alule:  cp lecd
        jp nz,aluand
        call alugt2     ;do '<=' (simply inverse of '>')
        jp alune1

aluand: cp ancd
        jp nz,aluxor
        call ckval2     ;do '&' op
        call flrcn
        call tbabsc
        ld de,smand
        jp nz,spcash
        lhld svv1       ;handle trivials constant case
        lda svv2
        and l
        ld l,a
        lda svv2+1
        and h
        ld h,a
        shld svv1
        ret

aluxor: cp xorcd
        jp nz,aluor
        call ckval2     ;do '^' op
        call flrcn
        call tbabsc
        ld de,smxor
        jp nz,spcash
        lhld svv1       ;do simple constants case
        lda svv2
        xor l
        ld l,a
        lda svv2+1
        xor h
        ld h,a
        shld svv1
        ret

aluor:  cp orcd

        push de
        ld de,stgbbo    ;'expecting binary operator'
        call nz,perrab  ;no other operators; better be '|'
        pop de

        call ckval2
        call flrcn
        call tbabsc
        ld de,smor
        jp nz,spcash
        lhld svv1       ;do trivial constants case
        lda svv2
        or l
        ld l,a
        lda svv2+1
        or h
        ld h,a
        shld svv1
        ret

alune:  call alueq      ;for not=, first call the == routine
alune1: lda sval1       ;and invert the result.
        and 4           ;was it a flag setting?
        jp z,alune2
        lda sbmap1      ;yes-invert bit 0
        xor 1
        sta sbmap1
        ret

alune2: lda sval1
        and 3           ;result a constant?
        call z,ierror   ;if not, must've screwed up somewhere
        lhld svv1       ;get result of == test
alun2a: ld a,h
        or l
        ld hl,0         ;was it zero?
        jp nz,alune3    ;if not, new result IS zero
        inc hl          ;if so, new result is 1
alune3: shld svv1
        ret
                        ;handle == operator:
alueq:  call flrcn      ;flush rel lvalue constants
        call tbabsc
        jp nz,alueq2    ;both constants?
        lhld svv1       ;yes.
        ex de,hl
        lhld svv2       ;compare them
        call cmh
        add hl,de               ;set HL to zero if two are equal
        jp alun2a

alueq2: lda sval1
        sta ssval
        call tschr      ;info1 a simple char?
        jp nz,aleq3
        call tschr2     ;yes. info2 also a char?
        jp nz,aleq2b
        ld de,mac71c    ;yes--do simple ld a,e-cp l
        call mcrog
aleq20: xor a
aleq2a: sta sbmap1
        ld a,4
        sta sval1
        ret

aleq2b: call tcnst2     ;info1 is a char, info2 isn't..
        jp nz,aleq2e    ;is info2 a constant?
        lhld svv2
        shld svv1       ;if so, xfer value over to common area
alq2b2: lda svv1+1      ;info1 is a char. is info2 (const) <= 255?
        or a
        jp nz,aleq2d
        lda ssval       ;yes.
        and 0c0h        ;get low byte of non-constant into A
        ld a,7dh
        call z,genb             ;if non-constant in H, do "ld a,l"
        ld a,7bh
        call nz,genb    ;else do "ld a,e"
        lda svv1        ;special case constant of 0?
        or a
        jp nz,aleq2g
        ld a,0b7h       ;if so, do "or a"
        call genb
        jp aleq20

aleq2g: ld a,0feh       ;do 'cp value'
        call genb
        lda svv1
        call genb
        jp aleq20

aleq2d: ld hl,0         ;if char value and two byte constant,
        shld svv1       ;can't possibly be equal
        ld a,1
        sta sval1
        ret

aleq2e: ld de,mac61     ;zero high-order byte of char value
        lda ssval
        and 0c0h
        call z,mcrog
        ld de,mac62
        call nz,mcrog
        ld de,mac71
        call mcrog
        jp aleq20

aleq3:  call tschr2     ;info1 NOT char, but is info2?
        jp nz,aleq4
        lda sval2       ;yes--set up info2 attributes in common area
        sta ssval
        call tcnst1     ;if info1 not constant, go zero high byte of
        jp nz,aleq2e    ;info2 and do 16-bit test
        jp alq2b2       ;else optimize for character constant

aleq4:  ld de,smeq      ;do the normal macro for 2 values or one constant
        jp spcash       ;and one big value.




;
; If one or two pointers appear in a + or - operation, scale
; the non-pointer by the size of the object the pointer points to:
;

paradj: call unsadj     ;adjust for unsigned operands
        call tptr2      ;info2 a pointer?
        jp z,prdj2
        call tptr       ;no. info1 a pointer?
        ret nz          ;if not, nothin' to do.
        lda op
        cp mincd
        jp z,parerr     ;2nd arg can't be pointer in binary `-' operation
        call analyz
        lhld svv2
        shld subval
        lhld asize
        shld sr0
        lda sval2
        call sclabh     ;scale object described by A by HL bytes
        shld svv2       ;save value in case of constant (such as array base)
        ret

prdj2:  call tptr       ;info2 is ptr-is info1 ptr too?
        jp nz,prdj3
        lda op          ;yes. Can only subtract 2 ptrs if op is `-'
        cp mincd
        jp nz,parerr
        call analyz
        push hl
        lhld asize
        push hl         ;save size of object 1
        call anal2
        lhld asize      ;get size of object 2 in HL
        pop de          ;get size of object 1 in DE
        ld a,h          ;compare size of both objects--must be =
        cp d
        ld a,l
        pop hl
        jp nz,parerr
        cp e
        jp nz,parerr
        ld a,1
        sta par2pf
        ret

prdj3:  call anal2      ;info2 is a pointer.
        lhld svv1
        shld subval
        lhld asize
        shld sr0
        lda sval1
        call sclabh     ;scale asize by HL
        shld svv1

        lhld indc2      ;lde info2 info into info1, but
        shld indc1      ;preserve info1's old sval1 and svv1
        lhld dimsz2     ;for register allocation/optimization
        shld dimsz1     ;purposes.
        lhld strsz2
        shld strsz1
        ld a,1
        sta wierdp
        ret

sclabh: ld b,a          ;object to scale a constant?
        and 3
        jp z,scl2
        call mult       ;yes--simple
        ret

scl2:   ld a,h          ;multiply by 0?
        or l
        ret z           ;if so, just grin and scratch hair.
        dec hl          ;multiply by 1?
        ld a,h
        or l
        ret z           ;if so, don't do a darned thing
        ld a,b          ;else, is value to scale in HL?
        and 0c0h
        jp nz,sclde
        call trydad     ;yes, try to do it with 'add hl,hl's
        ret z           ;all done if it worked
        ld de,macad2    ;else scale HL the hard way
        call mcrog
        ret

sclde:  lda codflg      ;if value in DE, first see if we can use 'add hl,hl's
        push af
        xor a
        sta codflg      ;disable code generation the first time...
        push hl
        call trydad
        pop hl  
        jp nz,sclde2    ;can we use "add hl,hl"'s?
        pop af          ;yes. restore codeflag
        sta codflg
        call gexdehl    ;get the value from DE into HL
        call trydad     ;do the add hl,hl's for real
        lda op          ;if + operator, don't worry about restoring
        cp plus ;proper registers (leave them switched)
        call nz,gexdehl ;but put them back if - operator
        ret

sclde2: pop af          ;restore codflg
        sta codflg
        ld de,macad1    ;and scale DE the hard way
        call mcrog
        ret


trydad: ld a,h
        or a            ;if high byte is non-zero, forget about
        ret nz          ;using add hl,hl's!
        ld c,29h
        ld a,l
        dec a
        jp z,dad1               ;if HL was originally 2, go do single add hl,hl
        sub 2
        jp z,dad2               ;if it was 4, do two add hl,hl's
        sub 4
        jp z,dad3               ;if it was 8, do three add hl,hl's
        sub 8           ;if wasn't 16, give up
        ret nz
        ld a,c
        call genb       ;it was 16--do four add hl,hl's
dad3:   ld a,c
        call genb
dad2:   ld a,c
        call genb
dad1:   ld a,c
        call genb
        ret



;
; svv1 <-- svv1/asize, signed
;

divs1a: lhld svv1
        ld a,h
        or a
        jp p,divpos     ;svv1 positive? if so, do simple unsigned divide
        call cmh        ;else negate to make it positive,
        call divpos     ;do the divide
        lhld svv1       ;and negate the result
        call cmh
        shld svv1
        ret

;
; svv1 <-- HL/asize, unsigned:
;

divpos: ld bc,-1        ;quotient result
        ex de,hl
        lhld asize
        call cmh
        ex de,hl                ;put -asize in DE
divtst: ld a,h
        or a            ;if HL negative, all done
        jp p,keepon
        ld h,b
        ld l,c
        shld svv1       ;store quotient
        ret

keepon: add hl,de               ;subtract asize again
        inc bc
        jp divtst       ;and test for negative numerator


;
; Some common tests performed by alugen operator handlers:
;

usuals: call ckval2
usual2: call flrcn
        call tbabsc
        call z,fcnsts
        call unsadj
        ret

;
; Clear high byte of info1's register:
;

clhbn1: ld a,0afh       ;get 'xor a'
        call genb
        lda sval1
clhb1a: and 0c0h        
        ld a,67h        ;'ld h,a'
        call z,genb
        ld a,57h        ;'ld d,a'
        call nz,genb
        sta hbn1cf
        ret

;
; Clear high byte of info2's register:
;

clhbn2: lda hbn1cf
        or a
        lda sval2       ;if info1 already cleared, use the 0 in A again
        jp nz,clhb1a
        ld de,mac61     ;else generate ld x,0
        and 0c0h
        call z,mcrog    ;ld h,0 if value in HL
        ld de,mac62
        call nz,mcrog   ;else ld d,0
        ret

;
; Return Z set if both info1 and info2 are constants of some kind:
;

tbabsc: lda sval1
        and 3
        jp z,invrt
        lda sval2
        and 3
        jp invrt

;
; Flush any and all constants into registers
;

fcnsts: lda sval1       ;info1 a const?
        and 3
        jp z,fcn2               ;if not, go check out info2
        lda sval2       ;yes. info2 a const?
        and 3
        jp z,fcn1
        call flshd1     ;yes-flush info1 into DE
        jp fcnsts       ;and go take care of info2

fcn1:   lda sval1       ;info1 constant, info2 isn't. info1 absolute?
        and 1
        jp z,fcn1a
        lda sval2       ;yes, so flush into wherever info2 isn't...
        and 0c0h
        jp z,flshd1     ;either DE, if info2 in HL
        jp flshh1       ;or into HL if info2 in DE

fcn1a:  lda sval2       ;info1 is rel lv. bummer. push info2
        and 0c0h
        call z,gpushh
        call nz,gpushd
        call flshh1     ;flush info1 into HL
        call gpopd      ;get info2 back into DE
        ld a,40h        ;tell that info2 is in DE
        sta sval2
        ret


fcn2:   lda sval2       ;info1 NOT a constant. info2 a const?
        and 3
        ret z           ;if not, all done
        lda sval2       ;yes. absolute constant?
        and 1
        jp z,fcn2a
        lda sval1       ;yes-flush into wherever info1 isn't
        and 0c0h
        jp z,flshd2     ;into DE if info1 in HL
        jp flshh2       ;into HL if info1 in DE

fcn2a:  lda sval1       ;info2 is rel lv. bummer. push info1
        and 0c0h
        call z,gpushh
        call nz,gpushd
        call flshh2     ;flush info2 into HL
        call gpopd      ;get info2 back into DE
        ld a,40h        ;tell that info2 is in DE
        sta sval1
        ret

        ;IF LASM
        ;link cc2c
        ;ENDIF