Subversion Repositories NedoOS

;
; ccd.asm:
;

;
; preprocessor directive handler:
;

defstr: db '#defin', 'e'+80h
undfst: db '#unde','f'+80h
ifst:   db '#i','f'+80h
ifdfst: db '#ifde','f'+80h
ifndst: db '#ifnde','f'+80h
endfst: db '#endi','f'+80h
elsest: db '#els','e'+80h
prepw:  db 'Warning: Ignoring unknown preprocessor directive',cr,lf,0
stgppo: db 'String overflow; call BDS+'
stgmmp: db 'EOF found when expecting #endif+'
stgbds: db 'Bad parameter list syntax+'
stgbd1: db 'Missing parameter list+'
stgbd2: db 'Parameter mismatch+'
stgnwc: db 'Not in a conditional block+'
stgbce: db 'Conditional expr bad or beyond implemented subset+'

prep:   ld hl,lblt      ;set pointer to start of string space table
        shld def2p

        xor a
        sta bcnstf      ;supress errors on bad constants till later on...

        ld hl,lblt+strsiz
        shld stp
        ld (hl),0

        call initps     ;initialize for pass through text

        xor a           ;initialize nested conditional control variables
        sta nestl       ;current conditional nesting level
        sta didelse     ;didn't see an #else yet in current macro
        sta dstgf       ;not in a string (for prlin)
        inc a
        sta active      ;currently conditionally active

prep1:  call nextch     ;handle bookkeeping
        jp nc,prep1a    ;EOF?

        lda nestl       ;Yes. In a conditional block?
        or a
        ld hl,stgmmp
        jp nz,perrab    ;if so, go complain and abort
        xor a
        sta preflag     ;not in preprocessor anymore
        ret             ;otherwise done with preprocessor

prep1a: lhld nlcnt      ;save line count
        shld nlcsav
        cp cr           ;line only a lone CR?
        jp nz,prep1b    ;if not, process the line

        dec hl          ;else debump line count
        shld nlcsav
        jp prep2a       ;and go wrap up

prep1b: push de         ;process #defined substitutions on current line,
        lda active      ;but only if active
        or a
        call nz,prlin
        pop de

        call igwsp
        ld a,(de)               ;a preprocessor directive?
        cp '#'
        jp nz,prep2     ;if not, don't bother with rest of this stuff

        ld hl,endfst    ;#endif?
        call stcmp
        jp z,pendif

        ld hl,elsest    ;#else?
        call stcmp
        jp z,pelse

        ld hl,ifdfst    ;#ifdef?
        call stcmp
        jp z,pifdef

        ld hl,ifndst    ;#ifndef?
        call stcmp
        jp z,pifndef

        ld hl,ifst      ;#if?
        call stcmp
        jp z,pif

        lda active
        or a            ;if not active, don't do any more processing
        jp z,prep2

        ld hl,defstr    ;#define?
        call stcmp
        jp z,pdef

        ld hl,undfst    ;#undef?
        call stcmp
        jp z,pundef

        push de         ;check for possible '#' on a line by itself; this
prpwlp: inc de          ;should be ignored by turning the line into FF's:
        ld a,(de)
        cp 0ffh ;we'll allow this between # and NL
        jp z,prpwlp
        cp cr           ;end of line?
        jp z,prpwrn0

prpwrn: ld hl,prepw     ;print this warning ONLY if
        call pwarn
prpwrn0: pop de
        jp prep2b


;
; Come here when current line is NOT a preprocessor directive:
;

prep2:  lda active      ;active?
        or a
        jp z,prep2b
        
prep2a: call nextch     ;find CR or EOF
        ret c
        cp cr
        inc de
        jp nz,prep2a
        jp prep2c

prep2b: call dellin     ;delete line
prep2c: lhld nlcsav     ;bump saved line count
        inc hl
        shld nlcnt
        jp prep1        ;and go for more text


;
; Delete current line of text at DE, up to CR:
;       

dellin: ld a,(de)
        cp cr
        jp nz,dell2
        inc de
        ret

dell2:  ld a,0ffh
        ld (de),a
        inc de
        jp dellin


;
; Process #endif:
;

pendif: lda nestl       ;if not in a conditional, complain
        or a
        jp nz,pendf2
pendf1: ld hl,stgnwc    ;"Not within conditional block"
        jp perrab

pendf2: dec a           ;decrement nest level
        sta nestl

        pop af          ;pop old activity state
        sta active
        pop af
        sta didelse

        jp prep2b       

                
;
; Process #else:
;

pelse:  lda nestl       ;if not in a conditional block, error
        or a
        jp z,pendf1
        lda didelse     ;have we already done an #else this block?
        or a
        jp nz,pendf1    ;if so, error

        pop af          ;peek at last activity state
        push af
        or a
        jp z,pelse2     ;last level active? If not, leave this one inactive

        lda active      ;yes. flip current state
        or a
        ld a,1          ;was active false?
        jp z,pelse1     ;if so, make it true
        xor a           ;else was true: make it false
pelse1: sta active
pelse2: ld a,1          ;set didelse
        sta didelse
        jp prep2b       

;
; Process #ifdef:
;

pifdef: push de         ;save text pointer
        lda active      ;if not active, don't bother evaluating identifier
        or a
        jp z,doif
        call defined    ;test to see if identifier defined
        jp doif ;go wrap up

;
; Process #ifndef:
;

pifndef: push de                ;just like for #ifdef, 
        lda active
        or a
        jp z,doif
        call defined
        cpl             ;execpt flip the logical result
        jp doif

;
; Process #if:
;

pif:    push de         ;save text pointer
        lda active
        or a
        jp z,doif               ;if not active, don't bother evaluating line
        ld hl,3 
        add hl,de
        ex de,hl
        call ifexp      ;otherwise evaluate conditional expression
        jp doif

;
; Evaluate conditional expression at DE, having  BNF:
;
;       ifexp :=  <ifexp2> 
;           (or)  <ifexp2> && <ifexp>
;           (or)  <ifexp2> || <ifexp>
;
;       ifexp2 := <constant>
;           (or)  <(ifexp)>
;           (or)  not<ifexp2>   ("not" is an exclamation point)
;

ifexp:  call ifexp1     ;evaluate expression
        ld b,a          ;save result in B
        call gndch      ;make sure there isn't anything after it
        cp cr
        ld a,b          ;get back the result
        ret z           ;if CR, all done
ifexp0: ld hl,stgbce    ;bad conditional expression
        jp perrab

;
; Recursive entry point for conditional expression evaluator:
;

ifexp1: call ifexp2     ;evaluate subexpression
        jp c,ifexp0     ;error if not legal expression
        ld b,a          ;put result in B
        call igwsp      ;check for operators
        ld c,'&'
        cp c
        jp z,ifxp1a
        ld c,'|'
        cp c
        jp z,ifxp1a
        ld a,b          ;no legal operators..return evaluated value.
        ret

ifxp1a: inc de          ;check for second identical character
        ld a,(de)
        cp c
        jp nz,ifexp0    ;if not, syntax error
        push bc         ;OK, save last result (B) and operator (C)
        inc de          ;evaluate next operand
        call ifexp1
        ld l,a          ;put result in L
        pop bc          ;get back previous result and operator
        ld a,c          ;look at operator
        cp '&'          ;logical and?
        ld a,b          ;get previous result in A
        jp nz,ifxp1b
        and l           ;if so, AND the two and return result
        ret
ifxp1b: or l            ;else OR the two and return result
        ret

ifexp2: call igwsp      ;skip leading whitespace
        cp '('          ;parenthesized expression?
        jp nz,ifxp2a
        inc de          ;yes. pass the opening paren
        call ifexp1     ;evaluate inner expression
        ld b,a
        call igwsp      ;check for closing paren
        cp ')'
        scf             ;return Cy if not closed
        ret nz
        inc de          ;otherwise pass the close paren
        ld a,b          ;get back result
        ccf             ;clear Cy
        ret             ;and return

ifxp2a: cp '!'          ;negation operator?
        jp nz,ifxp2b
        inc de          ;yes. evaluate operand
        call ifexp2
        ret c           ;ignore if error
        or a            ;otherwise flip result
        ld a,1
        ret z           ;return 1 if result was 0
        dec a           ;return 0 if result was 1
        ret

ifxp2b: call digt       ;otherwise must be decimal constant
        ret c           ;return error if not
ifxp2c: ld a,(de)               ;check a char of the constant
        call digt       ;digit?
        jp nc,ifxp2     ;if so, go process
        xor a           ;else result is zero.
        ret

ifxp2:  inc de          ;bump ptr to next digit
        or a            ;was last digit zero?
        jp z,ifxp2c     ;if so, go loop
ifxp3:  ld a,(de)               ;otherwise find end of value
        call digt
        inc de
        jp nc,ifxp3     ;keep looping till we find a non-digit
        dec de          ;all done
        xor a           ;return no Cy
        inc a           ;and a value of 1
        ret


;
; Come here after #if, #ifdef or #ifndef condition has been
; evaluated, with A = <condition>, either 0 or non-0:
;

doif:   ld b,a          ;save condition in B
        lda nestl       ;bump nesting level
        inc a
        sta nestl

        pop de          ;get back text pointer

        lda didelse     ;push current activity state
        push af
        lda active
        push af

        or a            ;currently active
        jp z,doif2      ;if not, remain inactive
        ld a,b          ;look at conditional test result
        or a
        jp z,doif2      ;if false, active = 0;
        ld a,1          ;else active = 1.
doif2:  sta active

        xor a
        sta didelse     ;clear didelse for the new level
        jp prep2b       ;and go clean up


;
; Process #undef:
;

pundef: push de
        call defined
        pop de
        jp c,prep2b     ;if already not defined, ignore it
        ld (hl),'*'     ;otherwise place a strange char there to erase it
        jp prep2b       ;and go wrap up

;
; Process #define definition:
;

pdef:   push de         ;found #define line. Save text ptr for later deletion.
        call defined    ;re-defining an identifier?
        jp c,pdef2
        call prepa      ;yes. go do that
        jp pdef3

;
; Install the identifier at DE for the first time:
;

pdef2:  lhld stp
        call prepa      ;install identifier
        shld stp
        ld (hl),0

;
; Collect up the substitution text in the string table:
;

pdef3:  push af
        call igwsp
        pop af
        or a            ;parameterized?
        jp nz,prargs    ;if so, go handle elsewhere

        call gndch      ;a null definition?
        cp cr
        jp nz,pdef4a
        ld a,0ffh       ;if so, define as a whitespace (FF) byte
        jp pdef4b

pdef4:  call gndch      ;else install simple text, till end of line
pdef4a: ld (bc),a
        inc bc
        cp cr
        jp nz,pdef4
        dec bc          ;turn b7 high on last char of replacement text
        dec bc
        ld a,(bc)
        or 80h
pdef4b: ld (bc),a
        inc bc
        ld h,b          ;and replace text table pointer
        ld l,c

pdef5:  shld def2p      ;make sure def2p hasn't collided with identifier table
        ld de,lblt+strsiz
        call cmphd      ;return C if def2p < end of table2 (ie. no overflow)
        jp c,pdef6      ;if no overflow, no problem

        ld hl,stgppo    ;preprocessor overflow: complain and abort
        jp pstgab

pdef6:  pop de
        jp prep2b       ;go delete line and finish up

;
; Process parameterized substitution text: replace arg keywords with
; special codes (80, 81, etc.) as it is stored in string table:
;

        IF 0
stgflg: ds 1            ;in a string flag, for parameterized definitions
escflg: ds 1            ;escaped char in text string flag
        ENDIF

prargs: ld h,b          ;copy string table address into HL
        ld l,c
        and 7fh         ;strip b7 off arg count
        ld c,a          ;put in C
        inc c           ;C = # of args + 1


prarg0: call gndch      ;see if text at DE matches one of the formal args

        call varch2
        jp nc,prarg2

prarg1: ld (hl),a               ;no match...just store it
        inc hl
        cp cr
        jp nz,prarg0    ;and go for more
        jp pdef5        ;when done, go wrap up.

prarg2: dec de          ;go back to start of the identifier
        push bc         ;get set to search arg text table for match
        push hl
        ld b,80h
        ld hl,deformt
prarg3: dec c           ;done searching list?
        jp z,prarg6
        ld a,(hl)               ;no. compare strings
        inc hl
        push hl
        ld h,(hl)
        ld l,a
        push bc
        call idcmp
        jp nz,prarg5    ;match?
prarg4: inc de          ;yes.
        dec c           ;replace arg with code number
        jp nz,prarg4
        pop bc
        ld a,b          ;get code number
        pop hl
        pop hl
        pop bc
        jp prarg1       ;and go store it

prarg5: pop bc          ;no match. try next table entry
        pop hl          ;get table pointer
        inc hl          ;point to next arg string
        inc b           ;bump current code number
        jp prarg3

prarg6: pop hl
        pop bc          ;no match. Copy identifier literally
        ld a,(de)
prarg7: ld (hl),a
        inc hl
        inc de
        ld a,(de)
        call varch      ;still part of identifier?
        jp nc,prarg7    ;if so, keep on storing
        jp prarg0       ;else go for next piece of text
        
;
; Install the identifier at DE in the defined constant id table. For
; parameterized defines, count up formal args and make sure the count
; gets into the table.
;
; On entry, HL points to the spot in the table where the id is to be
; inserted:
;
; Return A == argcount (b7 high if args present), BC --> text area
; where key text is to be stored.
;

prepa:  push hl         ;push id table pointer
        lhld stp        ;get id table free slot pointer
        ex (sp),hl              ;push on stack, get back id table pointer
        shld stp        ;make id pointer act as free slot pointer for now
        call instt      ;install identifier at DE

        push hl         ;save pointer to argcount byte
        ld l,c          ;put identifier length in HL
        ld h,0
        add hl,de               ;now HL -> char after identifier in text
        ld a,(hl)               ;look at it
        cp '('          ;parameterized define?
        ld a,0
        jp nz,prepa2    ;if not, install 0 in argcount byte position
        call deform     ;else go count up formal args, return A = # of args
        jp nc,prepa1
        ld hl,stgbds
        jp perrab

prepa1: or 80h          ;set b7 to indicate parameterized define
prepa2: ex (sp),hl              ;push text pointer from HL, get HL = table pointer
        ld (hl),a               ;store argcount value in id table
        inc hl          ;bump table pointer to string addr area
        push hl         ;save str addr area ptr
        lhld def2p      ;get string table free area pointer
        ld b,h          ;lde to BC
        ld c,l
        pop hl          ;get back str addr area ptr
        ld (hl),c               ;save string pointer in id table
        inc hl
        ld (hl),b
        inc hl          ;HL now points to next id slot
        pop de          ;get back text pointer
        ex (sp),hl              ;push text pointer, pop old id table free slot ptr
        shld stp        ;save id table free slot ptr

        push de         ;check for table overflow...we have one if
        ex de,hl                ;stp not less than coda
        lhld coda
        ex de,hl
        push af ;save argcount value
        call cmphd      ;return C if stp < coda
        jp nc,instt0    ;if stp >= coda, go complain and abort
        pop af          ;restore argcount value
        pop de
        pop hl
        ret

;
; Given HL -> formal arg list for parameterized define,
;  1. Put list of pointers to the args at deformt
;  2. put b7 high on last byte of each arg
;  3. return A = # of formal args (0 is legal), and HL -> after list
;
; If A == 0 on entry, allow only identifiers,
; If A <> 0,  allow any type of objects
;

deform: ld b,a          ;save strings_ok flag in B

        xor a           ;initialize extra line count
        sta lcnt

        ld c,0          ;init arg count
        ex de,hl                ;put text pointer in DE
        ld hl,deformt   ;init arg ptr list ptr
        inc de          ;pass '('
        call igwsp      ;ignore trash
        cp ')'          ;null list?
        jp nz,defrm2

defrm1a:
        inc de          ;yes. pass over ')'
        ex de,hl                ;put text ptr back in HL
        ld a,c          ;get arg count in A
        ret

defrm2: call igwsp      ;ignore leading trash
        cp cr           ;newline character?
        jp nz,defr2a    ;if not, assume it's legal starting char
        lda lcnt        ;bump extra line count
        inc a
        sta lcnt
        inc de          ;go on to next char
        jp defrm2       ;and go check for more extra newlines
        
defr2a: ld (hl),e               ;add adress of next arg to list
        inc hl
        ld (hl),d
        inc hl

        ld a,b
        or a            ;if allowing identifiers only,
        jp z,defrm4     ;then go do that

        xor a           ;clear paren nest level
        sta parenc

defr3a: ld a,(de)               ;else process generalized arg: get char of text
        inc de          ;bump text pointer
        cp '"'          ;quote?
        jp nz,defr3d    ;if not, go check for terminators
                        ;process string arg:
defr3b: ld a,(de)               ;look at next arg of string
        inc de
        cp '\'          ;backslash?
        jp nz,defr3c
        inc de          ;if so, pass over the next char
        jp defr3b
defr3c: cp '"'          ;closing quote?
        jp nz,defr3b    ;if not, keep looping till we find one
        jp defr3a       ;found closing quote. go for more of the arg

defr3d: dec de          ;temporrily place txt ptr on current char
        cp ','          ;comma?
        jp nz,dfr3d1    ;if not, check for close paren
        lda parenc      ;in parens?
        or a
        jp z,defr4a     ;if not, found end
        jp dfr3d2       ;else inside parens, so ignore  

dfr3d1: cp ')'          ;close paren?
        jp nz,dfr3d3    ;if not, go check for other special chars
        lda parenc
        or a
        jp z,defr4a     ;if already zilch, all done with this paren
        dec a           ;else debump paren count
        sta parenc
dfr3d2: inc de          ;else go on with term
        jp defr3a

dfr3d3: inc de          ;advance txt ptr back past current char
        cp '''' ;single quote?
        jp z,defr3e     ;if so, go handle
        cp '('          ;open paren?
        jp nz,defr3a    ;if not, go for next char
        lda parenc      ;bump paren count
        inc a   
        sta parenc
        jp defr3a       ;and go for more text

defr3e: ld a,(de)               ;process object in single quotes
        inc de
        cp '\'
        jp nz,defr3f
        inc de          ;ignore char after backslash
        jp defr3e       
defr3f: cp '''' ;closing single quote?
        jp nz,defr3e    ;if not, keep scanning
        jp defr3a       ;else done with single quote object; go for more arg

defrm4: ld a,(de)               ;get character at txt ptr
        call varch2     ;legal 1st char of identifier?
        ret c           ;if not, error.
defr40: inc de          ;find char after last char of identifier
        ld a,(de)
        call varch
        jp nc,defr40

defr4a: dec de          ;go back to last char of arg
        ld a,(de)               ;set b7
        or 80h
        ld (de),a
        inc c           ;bump arg count
        inc de          ;get next char
        call igwsp
        cp ','          ;comma?
        jp nz,defrm5    ;if not, go check for ')'
        inc de          ;else pass comma and look for identifier
        jp defrm2
        
defrm5: cp ')'          ;now must be either close or an error
        jp z,defrm1a
        scf             ;error. set Cy and return
        ret

;
; Test to see if identifier at DE has already been defined in a previous
; #define line. Return Cy clear if previously defined.
;

defined:
        ld l,c          ;look at the identifier.
        ld h,0
        add hl,de
        ex de,hl
        call igwsp
        call findd      ;is it already defined? set C if not.
        lhld deftmp
        ld a,0ffh       ;also A = 0ffh if no carry,
        ret nc
        cpl             ;A = 0 if carry
        ret


;
; Process all text substitutions on the line pointed to by DE:
;

prlin:  push de         ;save pointer to start of line for later retrieval
        lda dstgf       ;and save state of in-string flag
        push af

        or a            ;in a string from previous line?
        jp nz,prln0     ;if so, don't check for preprocessor directives

        call igwsp      ;ignore leading white space, checking for directives
        ld hl,ifst      ;line begin with #if?
        call stcmp
        jp z,prln1      
        ld a,(de)               ;line start with #?
        cp '#'
        jp z,prl0a      ;if so, don't preprocess.
        jp prln0

prln1:  inc de          ;line starts with #if. Pass "#if"
        inc de
        inc de
        call igwsp      ;process rest of #if line.


prln0:  dec de
prlin9: inc de
prlin0: ld a,(de)               ;end of file?
        or a
        jp z,prl0a      ;if so, end of line for sure.
        cp cr           ;end of line?
        jp nz,prlin1
prl0a:  pop af          ;yes. all done. clean up stack (pushed dstgf)
        pop de          ;and pop text pointer to start of line
        ret

prlin1: lda dstgf       ;in a string right now?
        or a
        ld a,(de)
        jp z,prlinc
        cp '"'          ;yes. close quote?
        jp z,prlinb     ;if so, go flip "in string" state
        cp '\'          ;no. escape?
        jp nz,prlin9    ;if not, just go to next char
        inc de          ;if so, skip next character
        jp prlin9

prlinb: lda dstgf
        cpl
        sta dstgf
        jp prlin9

prlinc: cp '"'          ;not in a string. start of string quote?
        jp z,prlinb     ;if so, go flip "in string" state
        cp '''' ;character constant?
        jp nz,prlind
        call chcnst1    ;yes. pass over it
        jp prlin0

        
prlind: call varch2     ;identifier?
        jp c,prlin9

prline: call subst      ;yes. do substitutions
        jp c,prlinf     ;any done?
        pop af          ;yes. restore dstgf
        sta dstgf
        pop de          ;and text pointer, then start processing line again.
        jp prlin

prlinf: inc de          ;pass over rest of identifier name
        ld a,(de)
        call varch
        jp nc,prlinf
        jp prlin0       ;and go for more stuff.


;
; Search for identifier pointed to by DE in the identifier
; table. Return Cy set if not found, else HL pointing to
; the arg count byte immediately following the name entry
; in the table:
;

findd:  ld hl,lblt+strsiz       ;start of identifier table

findd2: ld a,(hl)
        or a
        scf
        ret z
        shld deftmp
        call idcmp
        jp nz,findd3
        lhld deftmp
        push bc
        ld bc,8
        add hl,bc
        pop bc
        ret

findd3: ld bc,11
        add hl,bc
        jp findd2


;
; Ignore white space at DE:
;

igwsp:  ld a,(de)
        inc de
        call twsp
        jp z,igwsp
        dec de
        ret


;
; Do all potential substitutions for the text at DE:
;

subst:  call findd      ;is identifier at DE a defined symbol?
        ret c

        ld b,(hl)               ;put arg count in B
        inc hl
        ld a,(hl)
        inc hl
        ld h,(hl)
        ld l,a  

        ld a,b          ;parameterized?
        or a
        jp z,substs     ;if so, go handle simple substitution

        and 7fh         ;otherwise put arg count in B
        ld b,a
        push de         ;save  ->old text
        call pasvr      ;param list?
        call igwsp      ;ignore white space between var and possible param list
        cp '('
        jp z,subst2
        ld hl,stgbd1
        jp perrab

subst2: push hl         ;save ->new text
        ex de,hl                ;put text ptr in HL
        push bc
        call deform     ;build list of param ptrs
        ex de,hl                ;put text ptr back in DE
        jp nc,subst3
        ld hl,stgbds
        jp perrab               

subst3: pop bc
        cp b
        jp z,subst4     ;correct # of args?
        ld hl,stgbd2
        call perrab

subst4: pop hl          ;HL ->new text
        push de         ;save DE (->after old text)
        ld de,txbuf     ;now create new text image at txbuf

        ld a,(hl)               ;check for a null text image
        cp cr
        jp nz,subst5    ;if not null, handle normally
        ld a,0ffh       ;else place null FF byte in text area
        ld (de),a
        jp subst9a

subst5: ld a,(hl)
        inc hl
        cp cr
        jp z,subst9
        or a
        jp m,subst6     ;if arg code, go substitute
        ld (de),a               ;otherwise just a char
        inc de
        jp subst5

subst6: and 7fh         ;now substitute an arg for the code byte
        add a
        ld c,a
        ld b,0
        push hl
        ld hl,deformt
        add hl,bc
        ld a,(hl)
        inc hl
        ld h,(hl)
        ld l,a          ;HL -> arg text represented by code byte
subst7: ld a,(hl)
        and 7fh
        ld (de),a
        inc de
        ld a,(hl)
        inc hl
        or a 
        jp p,subst7     ;keep copying till b7 is high on last char
        pop hl
        jp subst5

subst9: dec de          ;turn on b7 of last char of text area
        ld a,(de)
        or 80h
subst9a:
        ld (de),a
        pop de          ;all done...now just replace old text with new text
        pop hl
        push hl
        call cmh
        add hl,de
        ld c,l
        pop de
        ld hl,txbuf
        call substs

        lda lcnt        ;get extra line count
        ld b,a          ;save in B
        cpl             ;negate for "mvtxt"
        inc a
        call mvtxt      

substa: ld a,b
        or a
        ret z   
        ld a,cr
        ld (de),a
        inc de
        dec b
        jp substa

;
; Substitute text at HL for identifier at DE, length of id at DE is in C:
;

substs: push hl         ;save ->new text
        push bc         ;save id length
        push hl         ;push ->new text
        call cmh        ;HL = -(new text addr)
        ex (sp),hl              ;push -(new addr), get HL = new addr
subs2:  ld a,(hl)               ;compute length of new text
        inc hl
        or a
        jp p,subs2
        pop bc          ;get -(new addr) in BC
        add hl,bc               ;HL = length
        ex (sp),hl              ;push lengh, HL = id length (in L)
        ld h,0          ;HL = id length
        call cmh        ;HL = -(id length)
        pop bc
        push bc         ;BC = new text length
        add hl,bc               ;HL = difference in lengths
        ld a,l          ;negate difference
        cpl
        inc a
        call mvtxt      ;shift text
        pop bc
        pop hl
        inc bc
subs3:  dec bc          ;insert new text
        ld a,b
        or c
        ret z
        ld a,(hl)
        cp 0FFh ;filler byte?
        jp z,subs4
        and 7fh
subs4:  ld (de),a
        inc de
        inc hl
        jp subs3
                

;
; Print out intermediate text if "-p" option given:
;

pitext:
        lda pflag       ;return if intermediate text
        or a            ;       printout not desired
        ret z

        lda werrs       ;output to console only
        push af
        xor a
        sta werrs

        lhld coda
        ex de,hl                ;DE points to text
        ld hl,0         ;HL holds line count
        call initps     ;initialize for pass through text
        sta nlflag      ;enable null line numbering

        call crlf       ; leading blank lines
        call crlf

ploop:  call gndch      ;get next significant character
        or a
        jp nz,ploop1

ploopd: call crlf       ;end of file.
        pop af          ;restore RED file output status
        sta werrs
        ret             ;all done.

ploop1: cp cr
        jp nz,ploop2
        call ckabrt     ;check for control-C on console
        lda nlflag      ;ok to number null lines?
        or a
        jp nz,ploop7    ;print empty line number on first null line in  
        ld a,1          ; a series of null lines, but not on rest of them.
        sta nlflag
        call number
        jp ploop7

ploop2: cp modbeg       ;start of module?
        jp nz,ploop3
        shld nlcnt      ;save line count for pushmn to use
        push de         ;save ptr to filename
        call pushmn     ;process start of include file.
        call crlf
        call indnt      ;indent for new module name
        call indnt      ;  extra indentation lines name up with text
        ex de,hl                ;save current DE in HL
        pop de          ;get filename
        call pfnam2     ;print out module name
        ex de,hl                ;put text ptr back in DE
        ld a,':'
        call outch
        ld hl,0         ;clear new line count
        jp ploop

ploop3: cp modend       ;and of module?
        jp nz,ploop4

        call popmn      ;process end-of-module by putting out
        call crlf       ;an extra cr-lf for readability.
        lhld nlcnt      ;restore line count from where popmn put it
        jp ploop


ploop4: call number     ;number the new line
ploop5: cp 255
        jp z,ploop6     ;don't print filler bytes
        call outch
ploop6: ld a,(de)               ;put out the line
        inc de
        or a
        jp z,ploopd
        cp cr
        jp nz,ploop5
        xor a
        sta nlflag      ;enable numbering of next null line

ploop7: inc hl
        jp ploop

;
; Get next char of text at DE, but if there's nothing but trash
; between it and the end of the line, just return the CR:
;

gndch:  ld a,(de)
        inc de
        cp 255
        jp z,gndch      ;ignore FF's
        call twsp       ;is next char white space?
        ret nz          ;if not, must use it.
        push af ;else if rest of the stuff on the line is trash
        push de
        call tnbcr      ;is it?
        jp z,gndch2
        pop de          ;no, there's more useful stuff. 
        pop af
        ret

gndch2: pop af          ;no more useful stuff. return a CR
        pop af
        inc de          ;and pass over the CR.
        ld a,cr
        ret     


;
; Return Z set if there's nothing but trash until the end of the line:
;

tnbcr:  ld a,(de)
        cp cr           ;return?
        ret z           ;if so, NOT a garbage character
        call twsp       ;white space?   
        ret nz          ;if not, not a garbage char
        inc de
        jp tnbcr        ;else keep scanning line for cr or non-space.

;
; Number the current pitext line:
;

number: push af
        call crlf
        call indnt      ;indent 2 spaces per module stacking
numb2:  push hl
        xor a           ;all line numbers take 4 characters
        call prhcs
        pop hl
        pop af
        ret

;
; Indent according to module stack count (2 spaces per module):
;

indnt:  lda modstc      ;get module nesting count
        dec a           ;print (A-1)*3 spaces
        ld b,a
        add a
        add b
        inc a
        ld b,a
indnt1: dec b
        ret z
        ld a,' '
        call outch
        jp indnt1

;
; Perform constant substitutions, keyword encodings,
; and string constant encodings:
;

pass1:  call initps     ;initialize for pass
        dec de
ps1a:   inc de
ps1b:   call nextch     ;process current char, return Cy on EOF
        ret c           ;done if EOF

ps1ba:  cp '"'          ;string to be processed?
        jp z,psstg

        push de         ;no. constant?
        push bc

        ld a,1          ;force error reporting on bad constant
        sta bcnstf
        call const
        ld a,0
        sta bcnstf      ;turn bad constant reporting back off

        ld a,c
        pop bc
        pop de

        jp c,ps1c               ;if not a constant, do potential keyword substitutions

        sub 3           ;it was a constant.  substitute a constant code 
        call mvtxt      ; for the text of the constant.
        ld a,concd      ;key byte
        ld (de),a
        inc de
        ld a,l          ;low order byte of value
        ld (de),a
        inc de
        ld a,h          ;high order byte of value
        ld (de),a
        jp ps1a

;
; Try to match the keyword at DE (whose first char
; is in A, already converted to upper case) with an
; entry in the keyword table. Hashing is used on the
; bits 0-3 of the first character. If no match is found
; and the first character was NOT a legal identifier
; character, then a syntax error occurs; else it is
; assumed the string is an identifier and it is left
; alone.
;

ps1c:   ld a,b
        cp 05fh ;underscore?
        jp z,ps1h               ;if so, assume identifier
        cp 'A'          ;legal identifier char?
        jp c,ps1c3
        cp 'Z'+1
        jp c,ps1c2
        scf             ;no. set carry for later.
        jp ps1c3

ps1c2:  xor a           ;yes, legal ident. char.
ps1c3:  push af ;now let's do some hashing...
        ld a,b          ;get 1st char of test string
        rlca
        and 1eh
        push bc
        ld c,a
        ld b,0          ;BC = disp into hash table
        ld hl,khasht    ;HL = start of table
        add hl,bc               ;HL = address of sublist
        ld a,(hl)       
        inc hl
        ld h,(hl)
        ld l,a          ;HL -> sublist
        pop bc
ps1d:   ld a,(hl)               ;done searching list?
        cp 255
        jp z,ps1g
        and 7fh         ;no. 1st char match?
        cp b            ;if not, don't bother comparing
        jp nz,ps1f      ;       rest of string
        push bc         ;OK, compare rest of string!
        call stcmp
        ld a,c          ;save length of strings
        pop bc
        jp nz,ps1f      ;if no match, keep searching
        ld c,a          ;match...restore length into C
        pop af          ;clean up stack
        ld a,(hl)               ;get 1 byte code into text
ps1e:   ld (de),a
        inc de  
        dec c
        jp z,ps1b
        ld a,0ffh       ;and fill out space with FF's
        jp ps1e

ps1f:   ld a,(hl)               ;go to next table entry
        inc hl
        or a
        jp p,ps1f
        inc hl
        jp ps1d

ps1g:   pop af          ;search failed. could it have
        jp nc,ps1h      ; been an identifier?
        ld hl,stg99     ;no: must be syntax error.
        call perr
        jp ps1a

ps1h:   ld a,(de)               ;possible identifier; let it be
        call varch
        jp c,ps1b
        inc de
        jp ps1h


;
; process a string constant:
;

psstg:  push de
psstg1: call glbl
        ld a,l
        cp 1ah
        jp z,psstg1
        ex de,hl
        lhld eofad
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        shld stgcct
        inc hl
        pop de
        push de
        xor a
        ld c,a
        sta scc
psstg2: inc de
        ld a,(de)

        or a
        jp z,pstger     ;if EOF, REALLY missing quote.

        cp '"'
        jp z,psstg3
        cp cr
        jp z,pstger     ;if CR in text, error.
        cp newlin       ;same for newlin
        jp z,pstger
        call stgelt
        ld (hl),a
        call ckov
        inc hl
        push hl
        ld hl,scc
        inc (hl)
        pop hl
        jp nz,psstg2

pstger: ld hl,stgmq
        jp fatal

psstg3: shld eofad
        ld (hl),1ah
        lhld stgcct
        lda scc
        ld (hl),a               ;set length byte for string
        pop hl          ;get start of string
        push hl
        call cmh
        add hl,de
        ld de,78
        call cmphd      ;is HL < 78?
        jp nc,pstg3a    ;if not, do big squish

        ld a,l          ;else do normal mvtxt
        sub 2
        pop de
        call mvtxt
        jp pstg3b

pstg3a: dec hl          ;do big squish
        dec hl          ;now HL is # of bytes to squish
        pop de
        call bsqsh      ;big squish routine

pstg3b: ld a,strcd
        ld (de),a
        inc de
        lhld lbln
        dec hl
        ld a,l
        ld (de),a
        inc de
        ld a,h
        ld (de),a
        inc de

        ld b,0
        lhld nlcnt
        add hl,bc
        shld nlcnt

        inc c
psstg4: dec c
        jp z,ps1b
        ld a,negone
        push bc
        call mvtxt
        pop bc
        ld a,nlcd
        ld (de),a
        inc de
        jp psstg4

bsqsh:  push de
        ld de,80
        call cmphd      ;is HL < 80?    
        jp c,bsqsh2
        ld de,-79
        add hl,de
        pop de
        call bsqsh      ;bsqsh(HL-79);
        ld hl,79
        call bsqsh
        ret

bsqsh2: pop de
        ld a,l
        call mvtxt
        ret

;
; Get next string element, set carry if EOF encountered:
;

stgelt: cp '\'
        ret nz
        inc de
        ld a,(de)
        cp '"'
        ret z
        cp 0ffh
        jp nz,stglt2
stglt0: inc de
        ld a,(de)
        cp 0ffh
        jp z,stglt0
        inc c
stglt1: inc de
        ld a,(de)
        cp 0ffh
        jp z,stglt1
        jp stgelt

stglt2: push hl
        dec de
        call chkesc
        pop hl
        dec de
        ret

;
; Check for escape sequence at text at DE:
;

chkesc: ld a,(de)
        cp '\'
        scf
        inc de
        ret nz          ;did we see a backslash?
        ld a,(de)               ;yes. save the next character for later retrieval
        inc de          ;and point to character after that
        sta esctmp
        call mapuc
        cp 'N'          ;check for special escape codes. \n?
        jp nz,esc2
        ld a,newlin
        ret
esc2:   cp 'T'          ;\t?
        jp nz,esc3
        ld a,ht ;if so, turn into tab
        ret
esc3:   cp 'B'          ;\b?
        jp nz,esc4
        ld a,bs ;if so, turn into backspace
        ret
esc4:   cp 'R'          ;\r?
        jp nz,esc5
        ld a,cr ;if so, turn into carriage return
        ret
esc5:   cp 'F'          ;\f?
        jp nz,esc6
        ld a,ff ;if so, turn into formfeed
        ret
esc6:   cp '\'          ;if \\, return \ character
        ret z
        cp 27h          ;if \', return ' character
        ret z
        call odig2      ;otherwise check for octal digit
        jp nc,esc7
        lda bcnstf      ;report constant errors?
        or a
        lda esctmp      ;if not octal digit, use the character and ignore the
        ret z           ; backslash, unless we need to report an error...
esc6a:  ld hl,stg8a     ;bad octal constant error.
        jp cnst2b


esc7:   ld l,a          ;OK, we have an octal digit. Put into L
        ld a,(de)               ;look at next character
        call odig2      ;octal digit?
        ld h,a          ;save in H
        ld a,l          ;get first digit
        jp c,esc8               ;if second character not octal digit, go finish up
        ld a,h          ;otherwise get second digit
        inc de          ;point to potential third digit
        call shfto      ;shift first digit to left
        ld a,(de)               ;look at potential third digit
        call odig2      ;is it octal?
        ld h,a          ;save in H in case it is
        ld a,l          ;get total of first two digits
        jp c,esc8               ;finish up  if no third digit
        ld a,h          ;get third digit
        inc de          ;point to character after third digit (closing qoute?)
                        ;and add third digit to the sum.

shfto:  ld h,a          ;this little routine adds the octal digit in H to
        ld a,l          ;the octal value in L, after multiplying the value
        rlca            ;in L by 8.
        rlca
        rlca
        add h
        ld l,a
        ret

esc8:   push af ;we've seen an illegal octal digit. if bcnstf is
        ld a,(de)               ;true and the current character isn't a quote, then
        cp '''' ;report an error. Else just return the value.
        jp z,esc9               ;Do we see a quote?
        lda bcnstf      ;no...
        or a
        jp z,esc9               ;is bcnstf true?
        pop af          ;yes, so report error
        jp esc6a

esc9:   pop af          ;don't need to report error; simply return value
        ret

odig2:  cp '0'
        ret c
        cp '8'
        ccf
        ret c
        sub '0'
        ret


;
; Look at current text at DE. If a constant is seen, return NC with
; the value of the constant in HL and C containing the length of the
; text of the constant. Else, return C set:
;

const:  ld a,(de)
        cp '''' ;character constant?
        jp z,chcnst     ;if so, go handle it elsewhere

        call digt       ;a decimal digit?
        ret c           ;if not, then it isn't the start of any constant
                        ;else it is.
        ld c,0          ;clear character count
        ld hl,0         ;and clear accumulated value
        or a            ;first digit a zero?
        jp nz,deccn     ;if not, go handle decimal constant
        inc de          ;yes. look at next character after the zero.
        ld a,(de)
        inc c           ;and bump length count
        call mapuc
        cp 'X'          ;hex constant?
        jp z,hexcn      ;if so, go handle it
        dec c           ;else must be an octal constant or 0. go back to
        dec de          ;the zero and let the octal handler take care of it.
        xor a
        jp octcn

cnst2a: ld hl,stg8      ;come here to diagnose constant errors.
cnst2b: call perr       ;print the error
        scf             ;set carry to indicate a bad happenning
        ret

hexcn:  inc de          ;process a hex constant
        ld a,(de)               ;look at next digit
        call tsthd      ;hex?
        jp c,cnst2a     ;if not, there weren't any legal digits, so complain
        dec de          ;otherwise begin accumulating
hexcn1: inc de          ;go to next character
        inc c           ;bump count
        ld a,(de)
        call tsthd      ;legal hex digit?
        jp c,octcn1     ;if not, all done
        add hl,hl               ;else shift previous sum left by 4
        add hl,hl
        add hl,hl
        add hl,hl
        add l
        ld l,a          ;add new digit
        jp hexcn1       ;and go for more

octcn:  add hl,hl               ;process an octal constant
        add hl,hl
        add hl,hl
        add l
        ld l,a  
        inc de
        inc c
        ld a,(de)
        call odigt
        jp nc,octcn
        ld a,(de)               ;see if this is a hex or decimal digit in an octal #...
        call tsthd
        jp c,octcn1     
        ld hl,stg8a
octcn0: call perr
octcn1: xor a
        ret

deccn:  push de         ;process a decimal constant..push text pointer
        inc c           ;bump char count
        ld d,h
        ld e,l          ;lde previous sum to DE
        add hl,hl               ;multiply previous sum by 10
        add hl,hl
        add hl,de
        add hl,hl
        ld e,a          ;add new digit
        ld d,0
        add hl,de
        pop de          ;get back text pointer
        inc de
        ld a,(de)               ;look at next digit
        call digt
        jp nc,deccn     ;decimal digit? if so, go process it
        ld a,(de)               ;else check for a common error, a hex digit
        call tsthd
        jp c,octcn1     ;if it isn't, no problem
        ld hl,stg8b     ;else complain about illegal decimal digit
        jp octcn0

;
; Evaluate character constant at DE, and print an error if no closing
; quote found:
;

chcnst: call chcnst1
        jp c,cnst2a
        ret

chcnst1:  push de
        ld b,0
        inc de
        call chkesc
        ld c,a
        ld a,(de)
        cp ''''
        jp z,chcns3
        call chkesc
        ld b,a
        ld a,(de)
        cp ''''
        jp z,chcns3
        pop hl
        scf
        ret

chcns3: inc de
        pop hl
        call cmh
        add hl,de
        ld h,b
        ld b,l
        ld l,c
        ld c,b
        xor a
        ret


digt:   call mapuc
        sub '0'
        cp 10
        ccf
        ret

tsthd:  call digt
        ret nc
        sub 7
        cp 10
        ret c
        cp 16
        ccf
        ret

odigt:  call digt
        ret c
        cp 8
        ccf
        ret



;
; This routine gets next character from text area, returning Cy set
; if EOF encountered, Z set if byte is to be ignored,  and properly
; handling MODBEG, MODEND and line count via NLCNT:
;

nextch: ld a,(de)
        cp 0ffh ;ignore FF (filler) bytes
        jp z,nextc5

        or a            ;zero byte indicates EOF
        scf             ;set Cy for EOF
        ret z

        cp modbeg       ;adjust line number processing for include files
        jp nz,nextc2
        inc de
        call pushmn
        jp nextch       ;and go for next char

nextc2: cp modend
        jp nz,nextc3
        call popmn
        jp nextc5       ;and go for 'nother char

nextc3: call mapuc
        ld b,a
        cp cr
        jp nz,nextc4    ;if not CR, all done...return the char

        call ckabrt     ;found CR: check for abortion at end of every line
        call bumpnl
nextc4: or a            ;clear Cy
        ret

nextc5: inc de          ;internal looping point for nextch
        jp nextch


;
; Process all labels in the source file.
;

lblpr:
        ld a,1
        sta mapucv      ;DON'T map to upper case in stcmp routine
        call initps
        dec de
lblp1:  inc de
        call pascd
        cp lbrcd        ; '{' for start of new function?
        jp nz,lblp2
        push de         ;yes. 
        lhld nlcnt
        shld savnlc     ;save line number of function start for error reports
        push hl
        call flblp      ;find labels
        pop hl
        shld nlcnt
        pop de
        call flblv      ;resolve labels.
        call ckabrt     ;check for using typing control-C
        jp lblp1

lblp2:  or a            ;EOF?
        jp nz,lblp1     ;if not, go for more text.
        xor a
        sta mapucv      ;restore stcmp to normal map-to-upper-case mode
        ret             ;yes. all done.

;
; Find labels in a function.
;

flblp:  ld hl,lblt
        shld lblp
        ld (hl),0
        xor a
        sta clev
        dec de
flp0:   inc de
flp1:   call pascd
        jp nz,flp1a     ;EOF before function ends?
                        ;if so...
lblerr: lhld savnlc     ;put start of function into line number register
        shld nlcnt
        lhld modstp     ;advance module stack ptr to cancel popping at EOF
        ld de,14
        add hl,de
        shld modstp
        ld hl,stgsuf    ;screwed-up function message
        jp fatal

flp1a:  cp lbrcd        ; '{'?
        jp nz,flp2
        ld hl,clev      ;yes. bump level count.
        inc (hl)
        jp flp4

flp2:   cp rbrcd        ; '}' ?
        jp nz,flp3
        ld hl,clev      ;yes. decrement level count.
        dec (hl)
        jp nz,flp4      ;done with funciton?
        ret             ;if so, return.

flp3:   cp elscd        ;look for keywords.
        jp z,flp4
        cp docd
        jp z,flp4
        cp semi
        jp nz,flp0      ;pass expressions.

flp4:   inc de          ;check for identifier.
        call igsht
        call varch      ;legal first char?
        jp c,flp1
        push de         ;yes. save text ptr.
        ld c,0          ;init char count
flp5:   inc de
        ld a,(de)
        inc c
        call varch      ;still an ident?
        jp nc,flp5
flpwsp: cp 255          ;no. ignore trailing spaces
        jp nz,flpcln    ;if no more spaces, check for colon     
        inc de          ;else pass over the space
        ld a,(de)               ;get next char
        inc c           ;bump count
        jp flpwsp       ;and keep looking for non-space

flpcln: cp colon        ;no. followed by a colon?
        pop hl          ;pop start of label into HL
        jp nz,flp1
        ex de,hl                ;put start of label ptr into DE
        push de         ;push it
        push bc         ;push count
        push bc         ; a few times
        push de         ;and push label ptr again
        xor a
        sta sf
        call flbl
        pop de          ;restore label ptr in DE
        pop bc          ;restore count into C
        jp c,flp5a
        ld hl,stgml     ;all labels must be unique
        call perr
        ld hl,sf
        inc (hl)
flp5a:  lhld lblp       ;store the label away
flp6:   ld a,(de)
        dec c
        jp z,flp7
        cp 255          ;don't save space as part of the name
        jp z,flp6a      
        ld (hl),a
        inc hl
flp6a:  inc de
        jp flp6

flp7:   cp 255          ;last char space?
        jp nz,flp7a     ;if not, treat normally
        dec hl
        ld a,(hl)               ;else get last legit char       
flp7a:  or 80h
        ld (hl),a
        inc hl
        ex de,hl
        lhld lbln
        ex de,hl
        ld (hl),e       
        inc hl
        ld (hl),d
        inc hl
        lda sf
        or a
        jp nz,flp8
        shld lblp
        ld (hl),0
flp8:   pop bc
        pop de
        ld a,c
        sub 2
        call mvtxt
        call glbl
        ld a,lblcd
        ld (de),a
        inc de
        ld a,l
        ld (de),a
        inc de
        ld a,h
        ld (de),a
        jp flp4

stgml:  db 'Duplicate label+'

;
; Resolve label references:
;

flblv:  dec de
        xor a
        sta clev
flv0:   inc de
        call pascd
        jp z,lblerr     ;if EOF, go complain

        cp lbrcd
        jp nz,flv1
        ld hl,clev
        inc (hl)
        jp flv0

flv1:   cp rbrcd
        jp nz,flv2
        ld hl,clev
        dec (hl)
        jp nz,flv0
        ret

flv2:   cp gotcd        ;"goto" keyword?
        jp nz,flv0
        inc de          ;yes.
        call flbl       ;label entered in table?
        jp nc,flv5      ;if so, go process
        ld hl,stg26
        call perr
        push de
        ld c,0
flv3:   ld a,(de)
        call varch
        jp c,flv4
        inc de
        inc c
        jp flv3

flv4:   pop de
flv5:   call lblsb      ;do substitution
        jp flv0

;
; Find label in label table:

flbl:   call igsht
        ld hl,lblt
flbl2:  ld a,(hl)
        or a
        scf
        ret z
        call stcmp
        ret z

flbl3:  ld a,(hl)               
        or a
        inc hl
        jp p,flbl3
        inc hl
        inc hl
        jp flbl2

lblsb:  ld a,(hl)
        inc hl
        ld h,(hl)
        ld l,a
        ld a,c
        sub 3
        push hl
        call mvtxt
        pop hl
        ld a,labrc
        ld (de),a
        inc de  
        ld a,l
        ld (de),a
        inc de
        ld a,h
        ld (de),a
        ret


stcmp:  push de
        push hl
        ld c,1
stcp1:  ld a,(hl)
        and 7fh
        call mapuc0
        ld b,a
        ld a,(de)
        call mapuc0
        cp b
        jp z,stcp2
stcp1a: pop hl
        pop de
        xor a
        inc a
        ret
stcp2:  ld a,(hl)
        or a
        inc hl
        jp m,stcp3
        inc de
        inc c
        jp stcp1
stcp3:  ld a,b
        call varch
        jp nc,stcp4
stcp3a: xor a
        pop de
        pop de
        ret
stcp4:  inc de
        ld a,(de)
        call varch
        ccf
        jp c,stcp1a
        jp stcp3a


;
; This section of code (PASS X) goes through the code and
; simplifies all constant expressions. Any code following
; an open bracket ("["), open parenthesis, "case" keyword,
; or assignment operator is checked to see if it is a 
; constant expression. If so, it is replaced by its simple
; constant equivalent. 
;

passx:  call initps
        dec de
psx1:   inc de
        call igsht
        call cdtst
        jp c,psx1z
        inc de
        inc de
        jp psx1
psx1z:  inc de
        or a
        ret z
        cp comma
        jp z,psx1a
        cp openb
        jp z,psx1a
        cp open
        jp z,psx1a
        cp cascd
        jp z,psx1a
        cp rencd
        jp z,psx1a
        call asgnop
        jp z,psx1a
        dec de  
        jp psx1

psx1a:  call ckabrt     ;check for using typing control-C
        push de
        ld hl,opstk
        shld opstp
        ld (hl),0
        ld hl,valstk
        shld valsp
        call ckce
        jp nc,psx2
        pop de
        call igsht
        call cdtst      
        jp c,psx1
        inc de
        inc de
        jp psx1

psx2:   ex (sp),hl
        ex de,hl
        dec hl
        dec de
        ld c,0

psx2a:  inc de
        ld a,(de)
        cp nlcd
        jp nz,psx2b
        inc c
psx2b:  ld a,0ffh
        ld (de),a
        ld a,l
        cp e
        jp nz,psx2a
        ld a,h
        cp d
        jp nz,psx2a
        pop hl
        ld a,concd
        dec de
        dec de
        ld (de),a
        inc de
        ld a,l
        ld (de),a
        inc de
        ld a,h
        ld (de),a
        ld a,c
        or a
        jp z,psx1
        inc de
        ld a,c
        cpl
        inc a
        push bc
        push hl
        call mvtxt
        pop hl
        pop bc
        ld a,nlcd

psx2c:  ld (de),a
        inc de
        dec c   
        jp nz,psx2c
        dec de
        jp psx1

;
; This routine looks at text at DE and returns C reset
; if there is a legal constant expression there, with
; the value in HL; else C is set. DE is left pointing to
; the end of the expression, or wherever it became illegal.
;

ckce:   call ckce2
        ret c
        call igsht
        cp 0c0h
        jp z,qexpr
        or a
        ret

ckce2:  push de
        call psce
        pop de
        ret c
        call binop
        jp z,bexpr
        call sce
        ret

;
; Pass over a simple constant expression:
;       unop sce
;       sce
;

psce:   call igsht
        cp mincd
        jp z,psce2
        cp circum
        jp z,psce2
        call pvsce
        ret

psce2:  inc de
        jp psce

;
; Pass very simple constant expression:
;       (ce)
;       constant
;

pvsce:  cp open
        jp nz,pvsce2
        call mtchp
        call igsht
        or a
        ret

pvsce2: cp concd
        scf
        ret nz
        inc de
        inc de
        inc de
        call igsht
        or a
        ret

;
; process ?: expression:
;

qexpr:  inc de
        ld a,h
        or l
        jp z,qexp2
        call ckce
        ret c
        cp colon
        scf
        ret nz
        inc de
        push hl
        call ckce
        pop hl
        ret

qexp2:  call psce
        cp colon
        scf
        ret nz
        inc de
        call ckce
        ret

;
; process simple constant expression:
;       unop sce
;       sce
;

sce:    call igsht
        cp mincd
        jp nz,sce2
        inc de
        call sce
        ret c
        call cmh
        or a
        ret

sce2:   cp circum
        jp nz,sce3
        inc de
        call sce
        ret c
        call cmh
        dec hl
        or a
        ret

sce3:   call vsce
        ret

;
; process very simple constant expression:
;       constant
;       (ce)
;

vsce:   cp open
        jp nz,vsce2
        inc de
        call ckce
        ret c
        call igsht
        cp close
        scf
        ret nz
        inc de
        ccf
        ret

vsce2:  cp concd
        scf
        ret nz
        inc de
        ld a,(de)
        ld l,a
        inc de
        ld a,(de)
        ld h,a
        inc de
        call igsht
        or a
        ret

;
; handle binary expression:
;  sce binop sce binop sce ...
;

bexpr:  xor a
        call oppsh
        call sce
        ret c
        call pshh
        call oppop
bxprab: call igsht
        call binop
        jp z,bxpr2

bxpr1:  call tstop
        jp z,bxpr5
        call popb
        call poph
        call oppop
        call alugen
        call pshh
        jp bxpr1

bxpr2:  call tstop
        jp z,bxpr3
        ld c,b
        call binop
        ld a,c
        cp b
        jp z,bxpr4
        jp c,bxpr4

bxpr3:  ld a,(de)
        call oppsh
        inc de
        jp bexpr

bxpr4:  call popb
        call poph
        call oppop
        call alugen
        call pshh
        jp bxprab

bxpr5:  call poph
        xor a
        ret

oppsh:  push hl
        lhld opstp
        inc hl
        shld opstp
        ld (hl),a
        pop hl
        ret

oppop:  push hl
        lhld opstp
        ld a,(hl)
        dec hl
        shld opstp
        pop hl
        ret

tstop:  push hl
        lhld opstp
        ld a,(hl)
        or a
        pop hl
        ret

popb:   push hl
        call poph
        ld b,h
        ld c,l
        pop hl
        ret

poph:   lhld valsp
        push de
        ld d,(hl)
        dec hl
        ld e,(hl)
        dec hl
        shld valsp
        ex de,hl
        pop de
        ret

pshh:   push de
        ex de,hl
        lhld valsp
        inc hl
        ld (hl),e
        inc hl
        ld (hl),d
        shld valsp
        ex de,hl
        pop de
        ret




binop:  ld b,9
        cp mulcd
        ret z
        cp divcd
        ret z
        cp modcd
        ret z
        dec b
        cp plus
        ret z
        cp mincd
        ret z
        dec b
        cp 0b0h
        ret z
        cp 0b1h
        ret z
        dec b
        cp 0b9h
        ret z
        cp 0bah
        ret z
        cp 0aeh
        ret z
        cp 0afh
        ret z
        dec b
        cp 0aah
        ret z
        cp 0abh
        ret z
        dec b
        cp ancd
        ret z
        dec b
        cp 0bch
        ret z
        dec b
        cp 0bdh
        ret

asgnop: cp letcd
        ret z
        cp 0a0h
        ret c
        cp 0aah
        jp c,asgn2
        xor a
        inc a
        ret

asgn2:  xor a
        ret


alugen: cp mulcd        ;*
        jp nz,alu2
alu1s:  call initsn     ;initialize sign memory
        push de
        ex de,hl
        ld hl,0
alu1a:  ld a,b
        or c
        jp nz,alu1b
        call aplysn     ;apply sign memory to result
        jp adone
alu1b:  add hl,de
        dec bc
        jp alu1a

initsn: xor a
        sta signm       ;clear sign memory
        push hl

        ld h,b
        ld l,c
        call tests      ;test BC for negativity
        ld b,h
        ld c,l

        pop hl
        call tests      ;test HL for negativity
        ret

aplysn: lda signm       ;if signm true, negate HL
        or a
        ret z
        call cmh
        ret

tests:  ld a,h          ;if HL is positive, do nothing
        or a
        ret p
        call cmh        ;else negate HL
        lda signm       ;and reverse sense of sign memory byte
        or a
        ld a,1
        jp z,tests2
        xor a
tests2: sta signm
        ret     

alu2:   cp divcd        ;/
        jp nz,alu3
alu2s:  call initsn
        push de
        ex de,hl
        ld hl,0
alu2a:  ld a,d
        cp b
        jp c,alu2c
        jp nz,alu2b
        ld a,e
        cp c
        jp c,alu2c
alu2b:  push hl
        ld h,b  
        ld l,c
        call cmh
        add hl,de
        ex de,hl
        pop hl
        inc hl
        jp alu2a
alu2c:  call aplysn
        jp adone

adone:  pop de
        ret

alu3:   cp modcd        ;%
        jp nz,alu4
        ld a,h
        or a            ;check sign of 1st operand
        push af ;save for final result sign computation

        call initsn     ;make sure mod is computed on positive numbers
        xor a           ;zero sign memory to force unsigned result
        sta signm
        push de
        push hl
        push bc
        call alu2s
        pop bc
        call alu1s
        call cmh
        pop de
        add hl,de
        pop de

        pop af          ;get sign of original 2nd operand
        ret p           ;if it was positive, leave result positive
        call cmh        ;otherwise negate result        
        ret

alu4:   cp plus ;+
        jp nz,alu5
        add hl,bc
        ret

alu5:   cp mincd        ;-
        jp nz,alu6
        push de
        ex de,hl
        ld h,b
        ld l,c
        call cmh
        add hl,de
        pop de
        ret

alu6:   cp 0b0h ;<<
        jp nz,alu7
alu6a:  ld a,b
        or c
        ret z
        add hl,hl
        dec bc
        jp alu6a

alu7:   cp 0b1h ;>>
        jp nz,alu8
alu7a:  ld a,b
        or c
        ret z
        ld a,h
        rra     
        ld h,a  
        ld a,l
        rra
        ld l,a
        dec bc  
        jp alu7a

alu8:   cp 0bah         ;<
        jp nz,alu9
alu8a:  ld a,h
        cp b
        ld a,l
        ld hl,1
        ret c
        dec hl
        ret nz
        cp c
        ret nc
        inc l
        ret

alu9:   cp 0b9h ;>
        jp nz,alu10
alu9a:  ld a,b
        cp h
        ld b,l
        ld hl,1
        ret c
        dec hl
        ret nz
        ld a,c
        cp b
        ret nc
        inc l
        ret

alu10:  cp 0aeh ;<=
        jp nz,alu11
        call alu9a
alu10a: ld a,h
        or l
        dec hl
        ret nz
        inc hl
        inc hl
        ret

alu11:  cp 0afh ;>=
        jp nz,alu12
        call alu8a
        jp alu10a

alu12:  cp ancd
        jp nz,alu13
        ld a,h
        and b
        ld h,a
        ld a,l
        and c
        ld l,a
        ret

alu13:  cp 0bch ;^
        jp nz,alu14
        ld a,h
        xor b
        ld h,a
        ld a,l
        xor c
        ld l,a
        ret

alu14:  cp 0bdh ;|
        jp nz,alu15
        ld a,h
        or b
        ld h,a
        ld a,l
        or c
        ld l,a  
        ret


alu15:  cp 0aah ;==
        jp nz,alu16
        ld a,h
        cp b
        jp nz,fals
        ld a,l
        cp c
        jp nz,fals
tru:    ld hl,1
        ret

alu16:  ld a,h          ;<not>=
        cp b
        jp nz,tru
        ld a,l
        cp c
        jp nz,tru
fals:   ld hl,0
        ret


;
; Table of hash addresses for each of the 16
; keyword sub-tables:
;

khasht: dw tbl0,tbl1,tbl2,tbl3
        dw tbl4,tbl5,tbl6,tbl7
        dw tbl8,tbl9,tbla,tblb
        dw tblc,tbld,tble,tblf

p:      equ 80h

tbl0:   db ' '+p,0ffh   ;spaces turn into FF's
        db  255
                

tbl1:   db '!','='+p,0abh
        db '!'+p,0bfh
        db 255

tbl2:   db 'RETUR','N'+p,8eh
        db 'BREA','K'+p,90h
        db 'REGISTE','R'+p,9eh
        db 'BEGI','N'+p,9bh
        db 255

tbl3:   db 'CHA','R'+p,80h
        db 'CONTINU','E'+p,91h
        db 'CAS','E'+p,98h
        db 'STRUC','T'+p,8bh
        db 'SWITC','H'+p,97h
        db 'SIZEO','F'+p,8fh
        db 'SHOR','T'+p,9fh
        db 255

tbl4:   db 'D','O'+p,95h
        db 'DEFAUL','T'+p,99h
        db 255

tbl5:   db 'ELS','E'+p,93h
        db '%','='+p,0a4h
        db '%'+p,0b8h
        db 'UNSIGNE','D'+p,82h
        db 'UNIO','N'+p,8ch
        db 'EN','D'+p,9ch
        db 255

tbl6:   db '&','&'+p,0ach
        db '&','='+p,0a7h
        db 'FO','R'+p,94h
        db '&'+p,0bbh
        db 'VOI','D'+p,81h              ;synonym for "int"
        db 255

tbl7:   db 'WHIL','E'+p,96h
        db 'GOT','O'+p,8dh      ;boo-hissssss
        db 255

tbl8:   db '('+p,0c2h
        db 255

tbl9:   db ht+p,0ffh
        db ')'+p,0c3h
        db 'I','F'+p,92h
        db 'IN','T'+p,81h
        db 255

tbla:   db ':'+p,0cah
        db '*','='+p,0a2h
        db '*'+p,0b6h
        db 255

tblb:   db ';'+p,0c6h
        db '{'+p,9bh
        db '['+p,0c8h
        db '+','+'+p,0b2h
        db '+','='+p,0a0h
        db '+'+p,0c4h
        db 255

tblc:   db ','+p,0c7h
        db '|','|'+p,0adh
        db '|','='+p,0a9h
        db '|'+p,0bdh
        db '<<','='+p,0a6h
        db '<','='+p,0aeh
        db '<','<'+p,0b0h
        db '<'+p,0bah
        db 255

tbld:   db cr+p,nlcd
        db ']'+p,0c9h
        db '}'+p,9ch
        db '=','='+p,0aah
        db '='+p,0beh
        db '-','>'+p,0b4h
        db '-','-'+p,0b3h
        db '-','='+p,0a1h
        db '-'+p,0b5h
        db 255

tble:   db '>>','='+p,0a5h
        db '>','='+p,0afh
        db '>','>'+p,0b1h
        db '>'+p,0b9h
        db '^','='+p,0a8h
        db '.'+p,0c5h
        db '^'+p,0bch
        db '~'+p,0cbh
        db 255

tblf:   db '?'+p,0c0h
        db '/','='+p,0a3h
        db '/'+p,0b7h
        db 255