Subversion Repositories NedoOS

;
; CC1: the first pass of the C compiler...
; MARC-generalized  version
;
; 7/17/82: added -w to write debugger info file and insert restarts
; 7/18/82: changed -w to -k<n>  (for Kirkland), taking n as the restart
;          vector to use (1-7), defaults to 6.
; 8/22/82: Fixed mvtxt to not overflow stack in recursion
; 9/9/82:  Added search path mechandsm to cc2.com auto-load, made FF def.
;          disk and user use "current" as default
; 10/6/82: added auto-".c" on main file feature
; 11/85:   Added -z option to use RST 1 - RST 5 for value-fetch optimization
; 12/85:   Added RED logic to write out PROGERRS.$$$ error file
; 
;

        IF NOT LASM AND NOT SLRMAC
        maclib cc
        ENDIF

        jp cc1          
 
        db cr,lf
        db 'Copyright (c) 1982, 83, 84 by Leor Zolman'
        db cr,lf,lf
        db 'Please don''t rip me off.'
        db cr,lf,lf,1ah
patch0: db 0,0,0,0,0,0,0,0              ;space to expand message

        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;       Configuration block area:
        ;

defdsk: db 0ffh         ;default library disk drive
defusr: db 0ffh         ;default library user area

defsub: db 00h          ;default disk to find submit file on
conpol: db 1            ;true to poll the console for interrupts
wboote: db 0            ;true to always do warm-boot on exit
;zenvf: ds 1            ;true if Z environment
;                       ;new for v1.51:
pstrip: db 1            ;true to strip parity when reading source file

        IF ALPHA
nouser: db 1            ;true to disable all user-area operations performed
        ENDIF           ; by CC, for special kinds of systems that like it

        IF NOT ALPHA
nouser: db 0            ;false to allow user area changes
        ENDIF

werrs:  db 0            ;write errors flag, for RED interface

optim:  db 80h          ;0: optimize for speed, use all long code sequences
                        ;b7 true: optimize for space, in general
                        ;b0-b6 true: use RST1-RST7 (respectively)
                        ; for -Z optimization through restart vectors

krst:   db 6            ;default CDB restart vector

zenvf:  ds 1            ;true if Z environment

        ;
        ; End Configuration Block
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

patch:  dw 0,0,0,0,0,0,0,0      ;patch space
patch2: dw 0,0,0,0,0,0,0,0
patch3: dw 0,0,0,0,0,0,0

        ;
        ;       Beginning of compiler code:
        ;

cc1:
        ;OS_HIDEFROMPARENT
        ;ld e,6 ;textmode
        ;OS_SETGFX
        call initstdio
        
        ;shld zenvad ;TODO remove       ;save Z environment pointer
        ;ld hl,0                ;save current SP for possible use in returning to CCP
        ;add hl,sp
        ;shld spsav
        ;ld sp,stack    ;set up private stack

        call ccinit     ;perform general initializations

        IF CPM AND NOT ALPHA
        call chkusr     ;check for user number on main filename
        ENDIF

        call comlin     ;process command line options
        call readf      ;read in file(s), strip comments
        call prep       ;process #define lines
        call pitext     ;print out intermediate text if specified
        call pass1      ;convert keywords,constants,strings
        call lblpr      ;process labels and references
        call passx      ;proccess constant expressions
        call bst        ;build symbol table
        call passc      ;process control structure
        call fixt       ;purge FF's and stuff from text
        call mkfnt      ;make function name table
        call wst4db     ;write symbol table for debugger
        call chopst     ;chop off 1st 8 bytes of st entries
        call mvfnt      ;lde func name table adj to text
        call errwrp     ;wrap up error handling
        call usage      ;print out memory usage diagnostic
        call writf      ;write out file

        jp exit ;all done


;
; Static data area:
;

        IF CPM
;spsav: ds 2    ;save stack pointer for non-booting return
ccpok:  ds 1    ;true if CCP still intact
erasub: ds 1    ;true if erasing submit files
curusr: ds 1            ;current disk (CP/M)
origusr: ds 1
curdsk: ds 1            ;current user area (CP/M)
origdsk: ds 1
cc2dsk: ds 1    ;default disk to search for cc2
cc2usr: ds 1    ;default user area to search for cc2
dodotc: ds 1    ;true to try ".C" if no ext given and file not found
        ENDIF

curtop: ds 2    ;end of availlable TPA memory
preflag:ds 1    ;true when still pre-processing
pflag:  ds 1    ;print intermediate text flag ("p" option)
sdisk:  ds 1    ;disk # where source came from
chainf: ds 1    ;true if we want to chain to CC2
loadad: ds 2    ;load address
eflag:  ds 1    ;true if -e option given
exaddr: ds 2    ;value given to -e option
cnflag: ds 1    ;true if comments nest
okflag: ds 1    ; "readm" routine success flag
mapucv: ds 1    ;no upper case mapping in "stcmp" routine flag

        IF CPM
cfcb:    db 0,'CC2     COM',0,0,0,0
subfile: db 1,'$$$     SUB',0,0,0,0

redfcb:  db 0,'PROGERRS$$$',0,0,0,0
         ds 17  ;rest of fcb for RED error file
redbuf: ds 128  ;text buffer for RED error file
redbp:  ds 2    ;pointer into text buffer
errsin: ds 1    ;true if RED output is active
nomore: ds 1    ;true if future red error output is disabled
        ENDIF

modstk: ds (fnlen + 2) * (nestmax + 1)
modstp: ds 2    ;pointer to currently active filename
modstc: ds 1    ;counter

casoff: ds 1    ;case overflow flag
esctmp: ds 1
errad:  ds 2
eradf:  ds 1
scc:    ds 1    ;string character count for psstg
stgcct: ds 2    ;points to where length byte goes for psstg
nlflag: ds 2    ;used in the pitext routine  for something or other
nltmp2: ds 1
nltmp:  ds 2
modaf:  ds 1    ;whether to modify st ptrs after wrapup or not
inadsv: ds 2    ;some more kludgery to allow multiple struct
                ;elements to have same name in separate structs
stsiz:  ds 2
coda:   ds 2
fndtmp: ds 1
mvtmp:  ds 1
errf:   ds 1
cmntf:  ds 1
udiag:  ds 1
stgf:   ds 1 
csf:    ds 1
sf:     ds 1
flev:   ds 1
fixfl:  ds 1
pdfd:   ds 1  ;previously declared func. def. flag
pdfdno: ds 2    ;symbol # for above
stor:   ds 2
strsz:  ds 2
mxsiz:  ds 2
tmplf:  ds 2
tmpbs:  ds 1
tmpsu:  ds 1
fbufp:  ds 2
opena:  ds 2
stno:   ds 2
fntp:   ds 2
fnts:   ds 2
fnc:    ds 2
lbln:   ds 2
eofad:  ds 2
meofad: ds 2    ;max eofad for elbowroom announcement
nlcnt:  ds 2
nlcnts: ds 2    ;save nlcnt when in #include file
ptfnf:  ds 1
type:   ds 1
stelf:  ds 1
forml:  ds 1
what:   ds 1
lind:   ds 1
clev:   ds 1
clevb:  ds 1
clevt:  ds 1
unflg:  ds 1
newid:  ds 1    ;used for flagging undefined structure identifiers
adrs:   ds 2
size:   ds 2
dmsiz:  ds 2
tempd:  ds 2
tempdp: ds 2
tmpa:   ds 2
savsta: ds 2
tmpfr:  ds 2
fndad:  ds 2
extsa:  ds 2
stp:    ds 2
mtpln:  ds 2
symno:  ds 2
funcf:  ds 2
z80f:   ds 1
frmrf:  ds 1
esadr:  ds 2
lcnt:   ds 1    ;used by parameterized #define preprocessor 
operad: ds 2    ;where option error begins
odisk:  ds 1    ;output disk designation
semiok: ds 1
nlfnd:  ds 1    ;used by decf routine
kflg:   ds 1    ;true if "-k" option given to write CDB file
signm:  ds 1    ;used by "passx", put here just to be safe...
cpyend: ds 2    ;parameter to "copy" routine showing end address
bcnstf: ds 1    ; (readf, pass1) true when bad char constants must
                ;                be flagged as an error

ascb:   ds 4
        db ': ',0

        ds 10
;stkchk:        ds 2    ;if this ever gets clobbered, stack has overflowed

;       ds 320
;stack: equ $

stg2:   db 'Close error+'
stg3:   db 'File output error; dir or disk full?+'
stgoer: db '": option error+'
stg10:  db 'Encountered EOF unexpectedly',cr,lf
        db ' (check curly-brace balance)+'
stg12:  db 'Unmatched right brace+'
stg14:  db 'Undeclared identifier: ',0
stg15:  db 'Illegal external statement+'
stg16:  db 'Bad declaration syntax+'
stg17:  db 'Missing legal identifier+'
stg19:  db 'Function definition not external+'
stg20:  db 'Need explicit dimension size+'
stg21:  db 'Too many dimensions+'
stg22:  db 'Bad dimension value+'
stg23:  db 'Bad parameter list element+'
stg24:  db 'Redeclaration of: ',0
stg25:  db 'Missing semicolon+'
stg27:  db 'Expecting "{" in struct or union def+'
stg28:  db 'Illegal structure or union id+'
stgbft: db 'Bad function type+'
stg28a: db 'Undefined structure id+'
stgdu:  db '*Unnamed'
stg40:  db 'Expecting "("+'
stgbp:  db 'Unmatched left parenthesis+'

stgstk: db 'Stack Overflow: '                   ; keep these two together
stgov:  db 'Sorry; out of memory+'

stgtc:  db 'I''m totally confused. '
        db 'Check your control structure!+'
stgom:  db 'Out of symbol table space; specify more...+'
stgtmf: db 'Too many functions (63 max)',0
stgmq:  db 'String too long (or missing quote)+'
stgbsd: db 'Attribute mismatch from previous declaration+'
stgelb: db 'elbowroom',cr,lf,0;cr,0
stgunu: db 'unused',cr,lf,0;cr,0
oshit:  db 'Internal Error...Call BDS+'

stgcce: db cr,lf
        IF CPM
        db 'Can''t find CC2.COM; writing CCI file to disk'
        ENDIF
        db cr,lf,0

stgiep: db 'Include @',0
stgilc: db 'Illegal "{" encountered externally',0
stgtmi: db 'Declaration too complex+'
stgbfd: db 'Missing from formal parameter list: ',0
stgabo: db 'Compilation aborted by ^C+'
stgeri: db cr,lf,'RED error output initiated+',0

;
; passc error messages:
;

stgc1:  db 'Mismatched control structure',cr,lf,0
stgc2:  db 'Expecting "while"',cr,lf,0
stgc7:  db 'Illegal break or continue',cr,lf,0
stgc6:  db 'Bad "for" syntax',cr,lf,0
stgc8:  db 'Expecting "{" in switch statement',cr,lf,0
stgc9:  db 'Bad "case" constant',cr,lf,0
stgc10: db 'Illegal statement',cr,lf,0
stgcof: db 'Too many cases (200 max per switch)',cr,lf,0
stgddf: db 'Can''t have more than one `default:''',cr,lf,0


;
; Initialize compiler flags and variables:
;

ccinit: call zsetup

        lhld protm ;0 there!!! who must write there???
        shld curtop

        lhld errbyt
        ld (hl),0               ;no error by default

        ld hl,stg0      ;print sign-on message
        call pstgco     ;print to console only

        ;ld c,gdisk     ;get current disk and user area
        ;call bdos
         xor a ;TODO getpath
        sta curdsk      ;store current disk
        sta origdsk     ;and save as original disk upon invokation of CC

        IF NOT ALPHA
        ;ld c,sguser    ;set/get user area
        ;ld e,0ffh
        ;lda nouser
        ;or a
        ;call z, bdos
         xor a
        sta curusr      ;store current user area
        sta origusr     ;and save as original user area upon invoking CC
        ENDIF

        lda defdsk      ;set cc2 search path
        inc a           ;first set disk
        sta cc2dsk
        lda defusr
        cp 0ffh ;and user area. default to current?
        jp nz,cc2
        lda curusr      ;if so, set to current user area
cc2:    sta cc2usr
        lda defsub
        inc a           ;if FF, make current; else, make explicit disk code
        jp nz,cc3               ;if not set to find submit files on current disk, don't
        lda curdsk      ;else set current disk as explicit disk byte in SUB.$$$
        inc a           ;     fcb in case we abort in the middle of file read
cc3:    sta subfile     ;set disk to find $$$.SUB on

        lda pstrip      ;does user want parity stripped on input file?
        or a
        jp nz,cc3a              ;if so, do nothing (strips by default)

        IF IMPURE
        ld a,0          ;IMPURE CODE: *** NOP ***
        sta stripp
        ld a,0b7h       ;IMPURE CODE: *** or A  ***
        sta stripp+1    
        ENDIF

cc3a:
        IF CPM          ;initialize some CP/M-only parameters
        lda fcb         ;get source disk #
        sta sdisk       ;save it
        sta odisk
        ld de,tbuff     ;set tbuff explicitly, to facilitate debugging
        ld c,sdma       ;of the 4200h version on my 0-based system
        call bdos
        ENDIF

        xor a           ;initialize following flags to FALSE:
        sta kflg        ;no debugger features by default
        sta eflag       ;no -e option yet
        sta errf        ;error ocurred flag
        sta eradf
        sta mapucv      ;no-upper-case-mapping on string-compare flag
        sta pflag
        sta z80f        ;false for 8080, true for Z80
        sta semiok
        sta nomore      ;allow RED output for starters

        IF CPM
        sta cfcb
        sta erasub      ;don't bother erasing SUBMIT files unless -x given
        sta errsin      ;no RED error file active yet
        ENDIF

        inc a           ;initialize following flags to TRUE:

        sta preflag
        sta chainf

        IF CPM
        sta cnflag      ;assume comments nest for starters
        sta ccpok       ;CCP intact at first under CP/M
        ENDIF

        ld a,2          ;find out if we're on Z80 or 8080
        inc a
        jp pe,cc1z      ;if on Z80,
        sta z80f        ;will come here to set z80 flag.

cc1z:   ld hl,dfstsz    ;default symbol table size
        shld stsiz
        ld hl,tpa       ;default load address for generated code
        shld loadad
        ld hl,0a55ah    ;for stack overflow check
        shld stkchk
        ld hl,0         ;reset label counter
        shld lbln
        ret

        IF CPM AND NOT ALPHA
chkusr:
        ld de,fcb+1     ;check to see if user area given on filename
        call gdec       ;number?
        ret c           ;if not, no problem
        ld a,(de)
        cp '/'          ;user area prefix character?
        ret nz
        ld hl,stgnua    ;can't give user area
        jp pstgab
        ENDIF

zsetup: xor a
        sta zenvf       ;not z environment by default
        ld hl,errdum
        shld errbyt     ;dummy error byte by default
        ld a,1
        sta oktort      ;ok to return to ccp, despite ccpok for now
        lhld zenvad ;TODO remove
        push hl
        ld de,1bh
        add hl,de
        ld e,(hl)
        inc hl
        ld d,(hl)               ;get reflexive env addr from env
        pop hl          ;original Z env value
        call cmphd      ;save as reflexive address?
        jp nz,setp2a    ;if not z system, set top of memory

        ld a,1
        sta zenvf       ;Z system.
        push hl         ;save env pointer
        ld de,3fh       ;get potential ccp address
        add hl,de
        ld a,(hl) 
        inc hl
        ld h,(hl)
        ld l,a
        shld ccpad

        pop hl          ;get env pointer

        push hl
        ld de,22h
        add hl,de
        ld a,(hl)
        inc hl
        ld h,(hl)
        ld l,a          ;HL -> message buffer
        ld de,6         ;get address of error byte
        add hl,de
        shld errbyt     ;save the address
        pop hl

        ld de,8         ;get type
        add hl,de
        ld a,(hl)
        sta envtyp
        
        and 80h         ;b7 hi?
        lhld ccpad
        jp nz,setup3    ;if so, use ccpad as ccp address
setp2a: lhld ram+1      ;else calculate the old way
        ld de,-1603h
        add hl,de

setup3: xor a           ;clear 'ccp volatile' flag
        sta ccpok       ;and CCP INTACT flag
        ex de,hl                ;put ccp address in DE
        ld hl,NEDOOSMEMTOP;lhld bdosp
        ld l,0          ;zero out low-order byte
        call cmphd      ;set Cy if [BASE+6,7] < CCP
        jp c,setup4     ;if BASE+6 < CCP, use BASE+6 as end of prot mem
        ex de,hl                ;else use CCP as end of prot. mem.
        ld a,1          ;and set ccp volatile flag
        sta ccpok       ;and set ccpok
        xor a           ;NOT ok to return to ccp despite ccpok
        sta oktort
setup4: shld protm
        ret


envtyp: ds 1

;zenvf          ;is after wboote
zenvad: ds 2    ;address of Z3 environment block
ccpad:  ds 2    ;address of CCP for type 80h ZCPR3
protm:  ds 2    ;start of protected memory
oktort: ds 1    ;ok to return to ccp despite ccpok flag?i
errbyt: ds 2    ;message buffer error byte address
errdum: ds 1    ;in case we're NOT under ZCPR3...


;
; Process command line options:
;

comlin:
        ld hl,st        ;init symbol table free space pointer
        shld stp

        IF CPM
        ;lda tbuff
        ;add a,81h
        ;ld l,a
        ;ld h,tbuff/100h
        ;ld (hl),0              ;place 00 at end of command line
        ld de,tbuff;+1  ;DE will be text pointer as we process
        ;call igsp      ;find source file name ;skip spaces in (de) (z=end of line, nz=text found)
        call fspac ;skip word in (de) (z=end of line, nz=text found)
        ld hl,stg1      ;is it there?
        jp z,pstgab     ;if not, error.
         ld (filenameaddr),de
        call fspac      ;pass it, and any blanks after it.
        ENDIF

        IF CPM
cc11:   call igsp       ;done processing line?
        ex de,hl
        shld operad     ;save in case of error
        ex de,hl
        ENDIF

cc111:  ret z           ;if so, go compile
        cp '-'          ;dash?
        jp nz,operr     ;if not, operand error
        inc de          ;get option character
        ld a,(de)
        call mapuc      ;convert to upper case
        inc de          ;advance pointer past option character

cc12a:
        IF NOT ALPHA
        cp 'K'
        jp nz,cc12d
        call gdec       ;get optional restart param
        jp nc,cc12b     ;param given?
        lda krst        ;if not, use default value
        jp cc12c        ;if not, make it 6

cc12b:  cp 8
        jp nc,operr     ;if >=8, error...else OK

cc12c:  sta kflg        ;set debugging mode with restart value
        jp cc11

cc12d:  cp 'W'          ;flip error file activity?
        jp nz,cc12
        lda werrs       ;get write error flag
        xor 1           ;logically invert
        sta werrs       ;and save it back
        jp cc11
        ENDIF

cc12:   cp 'O'          ;optimize for speed flag?
        jp nz,cc13
        xor a           ;if so, no longer optimizing for space
        sta optim
        jp cc11

cc13:   cp 'Z'          ;RST optimization flag?
        jp nz,cc13z

        ld a,(de)
        call legdd      ;any parameters given?
        jp nc,cc13c     ;if not, assume full optimization

        ld a,0bfh       ;if not, assume we're using all RST locations
        sta optim
        jp cc11

cc13c:  ld b,a
        ld a,80h        ;paramters supplied. Activate only
        sta optim       ;those optimizations with supplied parameters
        ld a,b

cc13a:  or a            ;check for range between 1-7
        jp z,operr
        cp 8
        jp nc,operr             

        ld b,a          ;save rst code in B
        ld c,80h        ;start walking bit at left, to be rotated into low bit
cc13b:  ld a,c          ;shift bit left
        rlca
        ld c,a
        dec b   
        jp nz,cc13b     ;loop till done shifting
        lda optim
        or c
        or 80h          ;set space optimization bit, just in case
        sta optim
        inc de
        ld a,(de)               ;any more vector specifications?
        call legdd
        jp nc,cc13a
        jp cc11 ;else all done
        

cc13z:  cp 'P'          ;print flag?
        jp nz,cc14
        sta pflag
        jp cc11

cc14:   cp 'R'          ;symbol reservation option?
        jp nz,cc15
        call gdec       ;get A=decimal number, 0-19
        cp 7
        jp c,operr      ;if < 7 or >19 then error.
        cp 20
        jp nc,operr
        add a
        add a
        ld h,a
        ld l,0
        shld stsiz      ;set symbol table size to nK
        jp cc11

cc15:
        IF CPM          
        cp 'A'          ;auto-load option? (CP/M only)
        jp nz,cc16
        call gdskc      ;get disk code, 1-16, or 0 for 'Z'
        sta cfcb        ;set disk field of cc2 fcb
        sta chainf      ;if 0, this prevents auto-chaining
        sta cc2dsk      ;set default cc2 search disk
        call gdec       ;user number given?
        jp c,cc11
        sta cc2usr      ;if so, set default cc2 search search area
        jp cc11
        ENDIF

        IF CPM
cc16:   cp 'D'          ;output disk specification?
        jp nz,cc16a     ;if not, check for other options
        call gdskc      ;get disk letter
        or a
        jp z,operr      ;don't allow 'Z'
        sta odisk
        jp cc11
        ENDIF

        IF CPM
cc16a:  cp 'X'
        jp nz,cc17
        ld a,1
        sta erasub      ;erase submit files
        jp cc11
        ENDIF

cc17:   
        IF NOT ALPHA
        cp 'M'          ;load address specifier?
        jp nz,cc18
        call ghxarg     ;get hex arg in HL
        jp c,operr
        shld loadad
        jp cc11
        ENDIF

cc18:   cp 'E'          ;set external address?
        jp nz,cc19      ;if not, illegal option
        sta eflag       ;set external address specified flag
        call ghxarg     ;get value
        jp c,operr
        shld exaddr
        jp cc11

cc19:   cp 'C'
        jp nz,operr

        IF CPM
        xor a
        ENDIF

        sta cnflag      ;now comments don't nest under CPM, and DO
        jp cc11 ;               nest under MARC


ghxarg: call igsp       ;yes. check for hex arg
        scf
        ret z           ;return error (c set) if no arg
        call leghd
        ret c           ;if not legal hex digit, error

        ld hl,0         ;else prepare to accumulate value in HL
cc17a:  ld a,(de)
        call leghd
        jp nc,cc17b     ;end of value text?
        xor a
        ret             ;yes. clear carry and return value in HL        
cc17b:  add hl,hl               ;no. multiply accumulator by 16
        add hl,hl
        add hl,hl
        add hl,hl
        ld c,a          ;and add new digit
        ld b,0
        add hl,bc       
        inc de          ;and go to next character
        jp cc17a

operr:  ld a,'"'
        call outch
        lhld operad
operr1: ld a,(hl)
        or a
        jp z,operr2
        call outch
        inc hl
        ld a,l
        dec a
        cp e
        jp nz,operr1
operr2: ld hl,stgoer    ;op error string
        jp pstgab       


        IF CPM
gdskc:  call igsp
        jp z,operr
        sub 'A'-1
        cp 27
        jp nc,operr
        inc de          ;bump past the char
        cp 26           ;change 'Z' to zero
        ret nz
        xor a
        ret
        ENDIF

;skip spaces in (de) (z=end of line, nz=text found)
igsp:   ld a,(de)
        or a
        ret z
        call mapuc
        cp ' '
        ret nz
        inc de
        jp igsp

        IF CPM
;skip word in (de) (z=end of line, nz=text found)
fspac:  ld a,(de)
        or a
        ret z
        inc de
        cp ' '
        jp nz,fspac
        jp igsp
        ENDIF

gdec:   ld b,0
        call igsp
        call legdd
        ld a,0
        ret c   
gdec1:  ld a,(de)
        call legdd
        ld a,b
        ccf
        ret nc
        add a           ;get A = 10 * B
        add a           ;(*4)
        add a           ;(*8)
        add b           ;(*9)
        add b           ;(*10)
        add c           ;now add new digit value in C
        ld b,a          ;put into B
        inc de
        jp gdec1        ;and go for more

;
; Check for legal decimal digit, return Cy set if illegal,
; else the binary value of the digit in A:
;

legdd:  call mapuc
        sub '0'
        ld c,a
        ret c
        cp 10
        ccf     
        ret

;
; Check for legal hex digit:
;

leghd:  call legdd
        ret nc
        cp 11h
        ret c
        cp 17h
        ccf
        ret c
        sub 7
        ret                     


usage:  ld hl,ascb+4
        ld (hl),'K'

        IF CPM
        ld hl,NEDOOSMEMTOP;lhld bdosp   ;get pointer to top of memory
        ld l,0
        ENDIF

        ex de,hl                ;into DE
        lhld meofad     ;get highest addr used
        call cmh        ;negate
        add hl,de               ;and add to top of mem to give free ram
        ld a,h          ;divide by 1K
        rra
        rra
        and 3fh
        ld l,a
        ld h,0
        dec hl

        xor a
        call prhcs      ;print out
        ld hl,stgelb    ;"elbowroom"
        lda lbln
        and 0fh         ;little hack here!
        jp nz,cc1b
        ld hl,stgunu    ;"unused"
cc1b:   call pstg
        ret

; Wrap up error handling, exit if there were errors:

errwrp: lda errsin      ;error output initialized?
        or a
        jp z,errwr3     ;if not, don't try to close RED output file

        ld e,1ah        ;ascii end-of-file
        call redout
        lhld redbp
        ld a,l
        cp redbuf and 0ffh      ;has buffer just been flushed?
        call nz,redwrt  ;if not, write buffer one last time
        ld de,redfcb
        call close2     ;close RED output buffer

errwr3: lda errf        ;if there were real errors (not just warnings)
        or a            ;then exit
        jp nz,errab2
        inc a
        sta nomore      ;no more RED output
        ret             ;else return


                
;
; Set up environment for a pass through the text (DE becomes
; text pointer)
;

initps: ld hl,0
        shld nlcnt

;       shld lbln               ;arghh. WHY did this WORK for so LONG?
                                ;(after lblpr, mustn't reset lbln anymore)

        ld hl,modstk
        shld modstp
        xor a
        sta clev
        sta modstc      ;at very top level
        lhld coda
        ex de,hl
        ret


;
;
; Passc: control structure processor:
; This pass preprocesses control statements (like while, do, 
; if...else, etc.) and twists them into a form much easier to digest
; by cc2. E.g., All the `case' statments are relded from a `switch'
; construct and a table of constants and `symbolic labels' is formed.
; If...else statments are turned into simple `if' statments (using some
; added braces and goto's...One may be able to get away from goto's
; in a C program, but it's a bit harder to avoid them at the compiler-
; design level!
;
; Note that at this point, all declarations have been purged from
; the text, leaving only the function definitions. If we ever finish
; up with a function and find something other than another function
; or EOF after it, somethings really screwed up...
;

passc:  call initps     ;initialize general pass procecure variables
        ld hl,cntt      ;init control table pointer (this is where
        shld cntp       ; the "break" and "continue" labels are stored)
        ld hl,fbuf
        shld fbufp
        xor a
        sta clev
        dec de

pasc1:  inc de
pasc2:  call igsht      ;done with text?
        jp nz,pasc3
        lda clev        ;yes. at top level?
        or a
        ret z           ;if so, OK

pasc2a: ld hl,stg10     ;==ERROR==
        jp fatal        ;probably mismatched {}s

pasc3:  cp varcd        ;a variable? (i.e., function definition?)
        jp z,pasc4

pasc3a: call fsemi
        jp pasc1        

;       ld hl,stgtc     ;if not, somethings screwy
;       jp fatal

pasc4:  inc de          ;ok, we found a function
        inc de
        inc de
        call mtchp      ;pass over the arg list
        call state      ;process the body as a statment
        jp pasc2        ;and go back for another function

;
; Here it is, the routine to process a statment...
;

state:  call ckabrt     ;check for user typing control-C
        call chkstk     ;and check for stack overflow

        call igsht
        jp z,pasc2a     ;if expecting a statement and get EOF, error

        call cdtst      ;if it starts with a code, ignore the code
        jp c,state0
        inc de          ;ignore it, since its probably a label
        inc de          ;code or something trivial.
        inc de
        jp state

state0: inc de          ;now, does it start with a `{'?
        cp lbrcd
        jp nz,state2

state1: call igsht      ;yes. do each statment inside the compound.
        cp rbrcd        ;hit the `}' yet?
        inc de
        ret z           ;if so, all done
        dec de          ;else just another statment
        call state      
        jp state1       ;and keep a 'goin

state2: cp ifcd ;now we hit the real statements. IF?
        jp z,sif

        cp whlcd        ;WHILE?
        jp z,swhl

        cp docd ;DO?
        jp z,sdo

        cp forcd        ;FOR? 
        jp z,sfor

        cp swtcd        ;SWITCH?
        jp z,sswt

        cp brkcd        ;BREAK?
        jp z,sbrk

        cp cntcd        ;CONTINUE?
        jp z,scnt

        cp rencd        ;RETURN?
        jp z,state3

        cp gotcd        ;GOTO?
        jp z,state3

        cp cascd        ;CASE? if so, bad news!
        jp z,sterr      ; Only the SWITCH processor should see these!

        cp elscd        ;while only the IF processor should see ELSEs
        jp z,sterr

        cp defcd        ;and only the SWITCH processor, again, should
        jp z,sterr      ;see DEFAULTs

        dec de          ;at this point we assume we have an expression
state3: ld a,1          ;statment (or a really screwy error.)
        sta eradf
        lhld nlcnt
        shld errad
        call fsemi      ;this phase can ignore expression statements.
        xor a
        sta eradf
        inc de
        call igsht
        ret

sterr:  ld hl,stgc10    ;seeing a CASE outside of a SWITCH, and other stuff
        jp fatal        ;like that, are good enough reasons to abort.

;
; routine to pass over a statement, I guess because I need to
; look ahead sometimes to figure out what's going on. Geez,
; I can't remember what the hell I used this for...
;
; (In case you're wondering, these comments are being written about
; 11 months after the code. I just now got WORDMASTER going on my
; bee-YOU-tea-full H19 terminal, and need no longer get uptight over
; the chilling prospect of documenting 150K of source using ED...)
;

passt:  call igsht
        jp z,pasc2a
        call cdtst      ;ignore labels and such
        jp c,past0
        inc de
        inc de
        inc de
        jp passt

past0:  cp lbrcd        ;left brace?
        jp nz,past2
        inc de

past1:  call igsht
        cp rbrcd
        jp nz,past1a
        inc de
        call igsht
        ret

past1a: call passt      ;yes; pass statement
        jp past1

past2:  cp ifcd
        jp nz,past3     ;if statement?
        inc de          ;yes.
        call mtchp      ;pass expr
        call passt      ;pass statement
        cp elscd        ;else?
        ret nz
        inc de          ;yes. pass statement
        call passt
        ret

past3:  cp whlcd        ;while?
        jp z,pst5b
        cp cascd        ;case?
        jp z,past3a
        cp defcd        ;default?
        jp nz,past4
past3a: ld a,colon      ;yes; find a colon
        call findc
        inc de          ;pass it
        call passt      ;pass next statement
        call igsht
        ret

past4:  cp docd
        jp nz,past5     ;do statement?
        inc de          ;yes.
        call passt      ;pass statement
        cp whlcd        ;while?
        jp z,pst4a
        ld hl,stgc2     ;if not, error
        call perr


pst4a:  inc de          ;pass expr
        call mtchp
        cp semi
        call nz,insrts  ;if no semi, insert one automagically.
        inc de
        call igsht
        ret

past5:  cp forcd        ;for statement?
        jp nz,past6
        sta semiok      ;yes. allow semis in text for now.

pst5b:  inc de
        call mtchp      ;pass expr(s)
        xor a
        sta semiok
        call passt      ;pass statment
        ret

past6:  cp swtcd        ;switch?
        jp z,pst5b
        or a            ;no. EOF?
        jp z,pasc2a

        call fsemi      ;no. go search for a semicolon
        inc de
        call igsht
        ret

;
; push continue-break data stack, adding two new labels:
;

cnpsh:  push de
        ex de,hl
        lhld cntp
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        inc de
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        shld cntp
        lda clev
        inc a
        sta clev
        ex de,hl
        dec hl
        pop de
        ret

;
; Pop continue-break data stack:
;

cnpop:  lhld cntp
        dec hl
        dec hl
        dec hl
        dec hl
        shld cntp
        lda clev
        dec a
        sta clev
        ret

cklev:  lda clev
        or a
        ret nz
        ld hl,stgc7
        call perr
        pop hl
        jp sbrk3

;
; Define a symbolic label given in HL at current location in text:
;

insll:  ld a,-3 and 255
        call mvtxt
insls:  ld a,lblcd
        jp insr2

;
; Install a symbolic label REFERENCE to label in HL at
; current location in text:
;

inslr:  ld a,-3 and 255
        call mvtxt
insrs:  ld a,labrc

insr2:  ld (de),a
        inc de
        ld a,l
        ld (de),a
        inc de
        ld a,h
        ld (de),a
        inc de
        ret

;
; Install a new label definition at current location in text:
;

lblni:  call glbl
        jp insll

;
; Install a new label reference at current place in text:
;

lblri:  call glbl
        jp inslr

;
; Get a new label value in HL:
;

glbl:   lhld lbln
        inc hl
        shld lbln
        dec hl
        ret

;
; Process a "for" statement:
;

sfor:   dec de
        ld a,lbrcd      ;left curly-brace to delimit entire for statement
        ld (de),a
        inc de
        call igsht
        cp open
        jp z,sfor2
        ld hl,stgc6
        call perr

sfor2:  ld a,0ffh
        ld (de),a
        call chsbp
        call passt
        ld a,-5 and 255
        call mvtxt
        ld a,whlcd
        ld (de),a
        inc de
        call glbl       ;get lbl z (object of the goto later)
        push hl
        call insls
        call glbl       ;get lbl x
        call cnpsh
        push hl         ;push lbl x
        ld a,open
        ld (de),a
        inc de
        call igsht
        cp semi
        jp nz,sfor3
        ld a,-3 and 255
        call mvtxt
        ld a,concd
        ld (de),a
        inc de
        ld a,1
        ld (de),a
        inc de
        ld a,0
        ld (de),a
        inc de
        jp sfor4

sfor3:  call chsbp
        call fsemi
sfor4:  ld a,close
        ld (de),a
        inc de
        call glbl       ;get lbl y
        ex (sp),hl              ;HL = lbl x, stack = lbly
        push hl         ;push lbl x
        push de
        ld a,negone
        call mvtxt
        ld a,open
        ld (de),a
        push de
        inc de
        lhld nlcnt
        shld nltmp
        call igsht
        cp close
        jp z,sfor4a
        pop de
        jp sfor4b
sfor4a: ld a,-3 and 255
        call mvtxt
        ld a,concd
        ld (de),a
        inc de
        ld a,1
        ld (de),a
        inc de
        xor a
        ld (de),a
        pop de

sfor4b: call mtchp
        lhld nlcnt
        push de
        ex de,hl
        lhld nltmp
        call cmh
        add hl,de
        pop de
        ld a,l
        sta nltmp2
sfor5:  pop hl
        push hl
        push hl
        call cmh
        add hl,de
        pop de
        shld tmplf
        lhld fbufp
        ld b,h
        ld c,l
        ex (sp),hl
        push hl
        lhld tmplf
        ld h,l

sfor6:  ld a,(de)
        ld (bc),a
        inc de
        inc bc
        dec l
        jp nz,sfor6
        push hl
        ld h,b
        ld l,c
        shld fbufp
        pop hl
        pop de
        ld a,lbrcd
        ld (de),a
        inc de
        ld a,h
        push af
        push af
        dec a
        call mvtxt
        lda nltmp2
        push af
        cpl
        inc a
        call mvtxt
        pop af
sf6a:   or a
        jp z,sf6b
        push af
        ld a,nlcd
        ld (de),a
        inc de
        pop af
        dec a
        jp sf6a

sf6b:   call state
        call cnpop
        pop af
        cpl
        sub 14
        call mvtxt
        ld a,semi
        ld (de),a
        inc de
        pop af
        pop hl
        ld b,h
        ld c,l
        shld fbufp
        pop hl          ;get lbl x
        push af
        push bc
        call insls      ;define lbl x here
        pop bc
        pop af
        ld h,a
sfor7:  ld a,(bc)               ;now copy the saved increment portion
        cp nlcd ;back into the text
        jp nz,sfor7a    ;but watch out for newlines
        dec de          ;and especially FAKE newlines (a la Somos)
        ld a,(de)
        inc de          ;if a newline found, make sure it isn't
        call cdtst      ;just the operand of a 3-byte code
        ld a,(bc)
        jp nc,sfor7a    ;if it is, leave it as it is
        ld a,0ffh       ;it isn't, so turn it into a garbage space
sfor7a: ld (de),a
        inc de
        inc bc
        dec h
        jp nz,sfor7
        ld a,semi
        ld (de),a
        inc de
        ld a,rbrcd
        ld (de),a
        inc de
        pop hl          ;get lbl y
        ex (sp),hl
        ld a,gotcd      ;put in the kludge "goto" to go with the "while"
        ld (de),a
        inc de
        call insrs
        ld a,semi
        ld (de),a
        inc de
        pop hl
        call insls
        ld a,rbrcd
        ld (de),a
        inc de
        ret

chsbp:  push de
        lhld nlcnt
        push hl
chsbp1: call pascd
        cp semi
        jp z,chsok
        cp open
        jp z,chsbpp
        cp close
        jp nz,chsbp2
        pop hl
        shld nlcnt
        ld hl,stgc6
        jp perrab

chsok:  pop hl
        shld nlcnt
        pop de
        ret
chsbp2: inc de
        jp chsbp1
chsbpp: call mtchp
        jp chsbp1

;
; Process a "switch" statement:
;

sswt:   call mtchp
        push de
        lhld cntp
        push hl
        dec hl
        dec hl
        dec hl
        ld b,(hl)
        dec hl
        ld c,(hl)
        pop hl
        ld (hl),c
        inc hl
        ld (hl),b
        inc hl
        ex de,hl

        call glbl
        shld defp       ;set "default" default label

        push af
        xor a
        sta defflg      ;haven't encountered default: yet
        pop af

        ex de,hl
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        shld cntp
        pop de
        lhld defp
        push hl
        push de
        cp lbrcd
        jp z,ssw0
        ld hl,stgc8
        call perr
        call fsemi
        pop hl
        pop hl
        ret

ssw0:   lhld nlcnt
        shld tmpnl
        xor a
        sta swtc
        sta casoff
        ld hl,swtt
        shld swtp
        ld hl,clev
        inc (hl)
        inc de

ssw0a:  call igsht
ssw1:   ld a,(de)
        cp lblcd
        jp nz,ssw1a
        inc de
        inc de
        inc de
        jp ssw0a

ssw1a:  cp cascd
        jp z,sscas
        cp defcd
        jp z,ssdef
        cp rbrcd
        jp z,ssdon
ssw2:   call passt
        jp ssw1

sscas:  inc de
        push de
        call pasff
        cp concd
        jp z,ccas2
        pop de
        ld hl,stgc9
ccas1:  call perr
        jp ssw2

ccas2:  inc de
        lhld swtp
        ld a,(de)
        ld (hl),a
        inc de
        inc hl
        ld a,(de)
        ld (hl),a
        inc hl
        inc de
pasloop:
        ld b,c
        call pasff
        push af
        ld a,b
        add c
        ld c,a
        pop af
        cp nlcd
        jp nz,ccas2a
        ld a,c
        or 80h
        ld c,a
        inc de
        jp pasloop
ccas2a:
        cp colon
        jp z,ccas3

ccas4:  ld hl,stgc9
        jp ccas1

ccas3:  ex de,hl
        call glbl
        ex de,hl
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        lda casoff
        or a
        jp nz,ccas3a
        shld swtp
ccas3a: ex de,hl
        pop de
        dec de
        ld a,c
        add a,2
        jp p,ccas3c
        and 7fh
        ld c,a
        ld a,nlcd
        ld (de),a
        inc de
        ld a,c
ccas3c: call mvtxt
        call insls
        lda casoff
        or a
        jp nz,ccas3b
        ld hl,swtc
        inc (hl)
        ld a,(hl)
        cp 201
        jp c,ccas3b
        sta casoff
        dec (hl)
        ld hl,stgcof
        call perr
ccas3b: jp ssw0a

pasff:  ld c,0
pasff1: ld a,(de)
        cp 0ffh
        ret nz
        inc c
        inc de
        jp pasff1

ssdef:  push de
        inc de
        call pasff
        cp colon
        pop de
        jp nz,ccas4
        ld a,2
        add c
        call mvtxt
        call lblni
        shld defp
        lda defflg      ;default previously defined?
        or a            ;set NZ if so
        ld a,1
        sta defflg      ;it is now, anyway

        ld hl,stgddf    ;duplicate default message
        call nz,perr    ;if default previously defined, bitch
        jp ssw0a


ssdon:  pop de
        lda swtc
        ld l,a
        ld h,0
        add hl,hl
        add hl,hl
        push hl
        inc hl
        inc hl
        inc hl
        inc hl
        call bexp
        ld a,swtbc
        ld (de),a
        inc de
        lda swtc
        ld (de),a
        inc de
        ld hl,swtt
        pop bc
ssdn1:  ld a,b
        or c
        jp z,ssdn2
        ld a,(hl)
        ld (de),a
        inc de
        inc hl
        dec bc
        jp ssdn1

ssdn2:  lhld defp
        ld a,l
        ld (de),a
        inc de
        ld a,h
        ld (de),a
        inc de
        lhld tmpnl
        shld nlcnt
        call state
        pop hl
        call insll
        call cnpop
        ret

;
; Process IF statement:
;

sif:    call mtchp
        call state
        call igsht
        cp elscd
        ret nz
        inc de
        call state
        ret

;
; Process a "while" statement:
;

swhl:   call lblni
        push hl
        call cnpsh
        call mtchp
        call glbl
        push hl
        call state
        pop hl
        ex (sp),hl
        ld a,-5 and 255
        call mvtxt      ;insert a forced "goto" to before the condition
        ld a,gotcd      ;test, so that things don't get messed up when
        ld (de),a               ;single-statement control structure is nested in
        inc de          ;a very peculiar way.
        call insrs
        ld a,semi
        ld (de),a
        inc de
        pop hl
        call insll
        call cnpop
        ret

;
; Process "do" statement:
;

sdo:    call lblni
        inc hl
        call cnpsh
        push hl
        inc hl
        inc hl
        shld lbln
        call state
        call igsht
        cp whlcd
        jp z,sdo2
        ld hl,stgc2
        call perr
sdo2:   inc de
        pop hl
        call insll
        call mtchp
        push hl
        call esemi
        inc de
        pop hl
        inc hl
        call insll
        call cnpop
        ret

;
; Process "break" statement:
;

sbrk:   call cklev
        dec de
        ld a,gotcd
        ld (de),a
        inc de
        lhld cntp

sbrk2:  dec hl
        ld a,(hl)
        dec hl
        ld l,(hl)
        ld h,a
        call inslr

sbrk3:  lhld nlcnt
        shld esadr
        call esemi
        inc de
        call igsht
        ret

;
; Process "continue" statement:
;

scnt:   call cklev
        dec de
        ld a,gotcd
        ld (de),a
        inc de
        lhld cntp
        dec hl
        dec hl
        jp sbrk2


        IF LASM
        link ccb
        ENDIF