Subversion Repositories NedoOS

;
; ccc.asm:
;

;
; This is the declaration parser....
;

bst:    xor a
        sta stelf
        sta unflg
        sta forml
        sta clevb
        sta sf
        sta newid
        inc a
        sta clevt
        call initst
        ld hl,0
        shld stor
        shld stno
        ld hl,st
        shld stp
        call initps
        dec de

bst1:   inc de
bst2:   call pascd
        jp nz,bst2a
        lda clev
        or a
        ret nz
        lhld stor
        shld extsa
        ret

bst2a:  cp lbrcd        ;open curly-brace?
        jp nz,bst3

        call ckabrt     ;a convenient place to check for abortion...

        lda forml       ;yes. have we been processing a formal declaration
        or a            ;list?
        jp nz,bst2b     ;if so, switch state to being out of formal area.

        lda clevb       ;else if still at top level, then there
        or a            ; is an error here somewhere.
        jp nz,bst2c     ;at top level? if not, all OK.

        ld hl,stgilc    ;if at top level, bad curly-brace encountered.
fatal:  jp perrab

bst2b:  ld hl,0
        shld stor

bst2c:  xor a           ;turn off formal flag
        sta forml
        ld hl,clevb
        inc (hl)                ;bump curly count
        jp bst1 ;and go for more

bst3:   cp rbrcd        ;right curly bracket?
        jp nz,bst5
        lda clevb       ;yes.
        or a            ; were we already at top level?
        jp nz,bst4
        ld hl,stg12     ;if so, then error.
        jp fatal

bst4:   dec a           ;debump curly-count
        sta clevb
        jp nz,bst1      ;and go loop if not back to top level
        lda clev        ;now at top level. bump func count
        inc a
        sta clevt
        xor a           ;set clev to zero (external)
        sta clev
        lhld stor       ;set local stack frame size for func just completed
        ld b,h          ; processing.
        ld c,l
        lhld fndad      ;this is the address of where the sf size will go
        inc hl
        inc hl
        ld (hl),c               ;well, now it is. store it.
        inc hl
        ld (hl),b
        lhld extsa      ;and restore the external storge allocation value
        shld stor       ;to the storge allocator.
        jp bst1 ;and go for more external stuff.


bst5:   call tstty      ;no. a type specifier?
        jp nc,bst5a
        cp regcd        ;no. "register"?
        jp z,bst5b
        cp shrtcd
        jp nz,bst6
bst5b:  push de         ;yes.
        lhld nlcnt      ;ignore it.
        push hl
        inc de
        call igsht
        pop hl
        shld nlcnt
        pop de
        call tstty      ;if not followed by type, assume "int"
        jp nc,bst5z
        ld a,81h        ;"int" code
        ld (de),a
        jp bst5a

bst5z:  ld a,0ffh       ;delete "register" code
        ld (de),a
        jp bst1

bst5a:  call declp      ;process declarations of this type
        jp bst1 ;and loop for more text

bst6:   ld a,(de)               ;not a declaration. an identifier?
        call varch
        jp c,bst1               ;if not, then not interesting. look for something else
        call finds      ;yes. is it in the symbol table?
        jp c,bst8
        lda clev        ;yes. are we processing externals?
        or a
        jp nz,bst6a
        ld a,negone     ;if so, might be typeless function def; insert "int".
        call mvtxt
        ld a,81h        ;"int" code
        ld (de),a
        jp bst5a

bst6a:  call cknex      ;not external. make sure it isn't an external
        push hl         ; redeclaration.
        ld a,c          ;relde text of identifier and replace it with
        sub 3           ; the special 3-byte symbol table pointer.
        call mvtxt
        pop hl
        call bstz2
        lda flev
        or a
        jp nz,bst1      ;ignore if already local
        push de         ;else must create local instance of an identifier
        ld de,st+8      ;having an external namesake...
        add hl,hl
        add hl,hl       
        add hl,hl
        add hl,hl
        add hl,de
        ld a,(hl)
        and 1
        jp nz,bst6f     ;go do it if needed.
        pop de          ;else already declared locally. nothing else to do.
        jp bst1 ;go process some more text

;
; So, now we know we have a usage of a function defined
; externally... let's make an st entry for it locally:
;

bst6f:  ld de,-8
        add hl,de       ;HL--> ext def.
        ex de,hl
        lhld stp
        ld b,16
bst6f1: ld a,(de)
        ld (hl),a
        inc hl
        inc de
        dec b
        jp nz,bst6f1

        ld de,-8
        add hl,de
        ld a,(hl)
        or 3
        ld (hl),a
        inc hl
        ld a,(hl)
        and 0e0h
        ld b,a
        lda clev
        add b
        ld (hl),a
        inc hl
        pop de
        dec de
        dec de
        jp bstf3


cknex:  push af
        lda clev
        or a
        jp z,ck2
        pop af
        ret

ck2:    ld hl,stg15
        call perr
        call fsemi
        pop hl
        pop hl
        jp bst1

bst8:   push de
        lhld nlcnt
        push hl
        call pasvr
        pop hl
        shld nlcnt
        pop de
        cp open
        jp z,bstf
        call cknex
        cp openb
        jp z,bste
        cp arrow
        jp z,bste
;       cp period
;       jp nz,bst10

bste:   call bvarm      ;bad variable message
        call pasvr
        jp bst1

;bst10: call bvarm
;       call bstl
;       jp bst1

bstl:   call instt
        ld a,c
        sub 3
        sta tmpbs
        call mvtxt
        lda forml       ;if formal, set formal bit
        rlca
        rlca
        and 04h
        or 10h          ;always set to int type
        ld (hl),a
        inc hl
        lda clev
        or a
        jp nz,bstlb

bstla:  ld hl,stg15
        call perr
        jp bst1

bstlb:  ld (hl),a
        inc hl
        push hl
        lhld stor
        ld b,h
        ld c,l
        inc hl
        inc hl
        shld stor

bstlc:  pop hl
        call bstz
        ret


bstf:   lda clev
        or a
        jp nz,bstf2
        call fnnt
        jp bst1

bstf2:  call instt
        ld a,c
        sub 3
        call mvtxt
        ld (hl),13h
        inc hl
        lda clev
        or a
        jp z,bstla
        ld (hl),a
        inc hl
bstf3:  push hl
        lhld fnc
        ld b,h
        ld c,l
        inc hl
        shld fnc
        pop hl
        call bstz
        jp bst1


bstz:   ld (hl),c
        inc hl
        ld (hl),b
        inc hl
        inc hl
        inc hl
        inc hl
        inc hl
        shld stp
        lhld stno
        push hl
        inc hl
        shld stno
        pop hl

bstz2:  ld a,varcd
        ld (de),a
        inc de
        ld a,l
        ld (de),a
        inc de
        ld a,h
        ld (de),a
        ret

fnnt:   push de
        ld a,-1 and 255
        call mvtxt
        ld a,81h
        jp dclp1

declp:  xor a
        sta what        ;"what" defaults to variable
        inc a
        sta type        ;"type" defaults to int (bug fix 11/19/80)
        ld a,(de)
        push de
        cp uncd
        jp z,dclp0
        cp sttcd
        jp nz,dclp1
dclp0:  call decs
        jp dclp1c

dclp1:  sub 80h
        sta type
        inc de
        call igsht
        cp regcd        ;ignore "register" keyword
        jp nz,dclp1b
        inc de
dclp1b: xor a
        sta what
        call declst

dclp1c: ld a,(de)
        cp semi
        jp nz,decf
        pop hl
        dec hl
dclp2:  inc hl
        ld a,(hl)
        cp nlcd
        jp z,dclp3
        ld (hl),0ffh
dclp3:  call cmphd
        jp nz,dclp2
        ret

; Relde text between start of function def
; and start of formal param list:

decf:   lda lind        ;check for illegal func def of type struct or union
        or a
        jp nz,decf00
        lda type
        cp 6
        jp nz,decf00

        ld hl,stgbft    ;bad function type (function cannot return a struct)
        call perr
        
decf00: lhld opena
        ex de,hl                ;put start of formal param list ptr in DE
        pop hl          ;get --> start of declaration
decf01: call cmphd
        jp z,decf03
        ld a,(hl)               ;except for newlines, that is...
        cp nlcd
        jp z,decf02
        ld (hl),0ffh
decf02: inc hl
        jp decf01

decf03: ld a,-3 and 255 ;make room for function code
        call mvtxt

decf0:
        ld a,varcd
        ld (de),a
        inc de
        lhld stno
        dec hl
        lda pdfd        ;use original st# if declared previously
        or a
        jp z,decf1
        lhld pdfdno
decf1:  ld a,l
        ld (de),a
        inc de
        ld a,h
        ld (de),a
        inc de
        call igsht      ;now find param list
        inc de
        ld a,1
        sta forml       ;set formal flag
        lhld stor
        shld extsa      ;save external storge count
        ld hl,1         ;reset local function count number
        shld fnc
        dec hl          ;and clear local storge allocator
        shld stor
decf2:  call igsht      ;scan formal parm list
decf3:  cp close        ;end?
        ret z           ;if so, all done
        call varch      ;else legal identifier?
        jp nc,decf4
        ld hl,stg23     ;if not, complain
        call perr
        ld a,close      ;and skip rest of list
        call findc
        ret

decf4:  call finds      ;does identifier already exist?
        jp nc,decf5
decf4a: call bstl       ;no. install as simple formal int
        jp decf6        ;and go for more

decf5:  lda flev        ;exists already. External in its formal
        or a            ;incarnation?
        jp z,decf4a     ;if so, simply ignore external one.
        push hl 
        push bc
        ld hl,stg24     ;else redeclaration error (only possibility
        call bvarm2     ;is an identical id earlier in parm list)
        pop bc
        ld a,c
        sub 3
        call mvtxt
        pop hl
        call bstz2
decf6:  inc de          ;go on to next parm
        call igsht
        cp comma
        jp nz,decf3             
        inc de
        jp decf2


;
; Process structure declaration:
;

decs:   sta tmpsu
        ld a,1
        sta modaf
decs0:  inc de
        call igsht
        cp regcd        ;ignore "register" keyword
        jp z,decs0

        cp lbrcd        ;immediate structure listing?
        jp z,decsl
        call finds      ;if not, must be struct identifier
        jp nc,decse     ;if known identifier, go handle it
        call instt      ;otherwise install new struct identifier name
        ld a,1
        sta newid
        call pasvr
        jp decs1

decsl:  push de         ;if no identifier given, use a dummy name
        ld de,stgdu
        call instt
        pop de

decs1:  lda forml       ;save state of formal, since it is meandngless
        push af ;for a structure type definition
        lda what
        push af
        ld a,2
        sta what
        ld hl,0
        shld dmsiz
        dec hl
        shld size
        xor a
        sta forml
        sta lind
        sta ptfnf
        call wrapup
        pop af
        sta what
        pop af
        sta forml
        lhld stno
        dec hl
        shld size

decsf:  call igsht      ;see what follows the identifier
        cp lbrcd        ;left brace?
        jp z,decsd      ;if so, go handle definition
        jp decsd6       ;else go process declarator list

decse:  xor a
        sta newid
        shld size
        push hl
        push de
        call getsz
        ex de,hl
        shld strsz
        pop de
        pop hl
        push hl
        call cvtst
        and 3
        cp 2
        jp z,decse2
        pop hl
        ld hl,stg28

decse1: call perr
        call fsemi
        ret

decse2: push hl
        push de
        lhld nlcnt
        push hl
        call pasvr      
        pop hl
        shld nlcnt
        pop de
        pop hl
        cp lbrcd
        jp nz,decse3

        inc hl
        inc hl
        inc hl
        inc hl  
        inc hl
        ld a,(hl)
        cp 255
        jp z,decse3
        ld hl,stg24
        call bvarm2     ;"redeclaration of: name"

decse3: pop hl
        call pasvr
        jp decsf


decsd:  lda forml
        push af
        xor a
        sta forml
        push hl
        lhld stor
        push hl
        lhld mxsiz
        push hl
        lda stelf
        push af
        lda unflg
        push af
        ld hl,0
        shld stor
        shld mxsiz
        ld a,1
        sta stelf
        xor a
        sta unflg
        inc de
        lda tmpsu
        cp uncd
        jp nz,decsd2
        sta unflg

decsd2: call igsht
        cp rbrcd
        jp z,decsd4
        call tstty
        jp nc,decsd3
        ld hl,stg16
        call perr
        call fsemi
        inc de
        jp decsd2

decsd3: call declp
        jp decsd2

decsd4: inc de
        lda unflg
        or a
        jp z,decsd5
        lhld mxsiz
        shld stor
decsd5: pop af
        sta unflg
        pop af
        sta stelf
        lhld stor
        shld strsz
        ld b,h
        ld c,l
        pop hl
        shld mxsiz
        pop hl
        shld stor
        pop hl
        shld size
        push de
        call getsz
        ld (hl),c
        inc hl  
        ld (hl),b
        pop de
        pop af
        sta forml
        xor a
        sta newid       ;identifier no longer new after definition

decsd6: ld a,6
        sta type
        call declst
        xor a
        sta newid       ;clear newid flag
        ret

getsz:  add hl,hl
        add hl,hl
        add hl,hl
        add hl,hl
        ld de,st+12
        add hl,de
        ld e,(hl)
        inc hl
        ld d,(hl)       
        dec hl
        ret



declst: call igsht
        cp semi
        ret z

decls1: lda what
        push af
        call dec

;
; Check for forward references to undefined structures:
;

        lda type
        cp 6
        jp nz,decls0    ;structure?
        lda lind        ;yes. indirection?
        or a
        jp nz,decls0
        lda newid       ;no. brand new, undefined struct id?
        or a
        jp z,decls0
        ld hl,stg28a    ;using undefined structure id
        call perr

decls0: call igsht
        cp comma
        inc de
        jp nz,decls2
        pop af
        sta what
        jp decls1

decls2: dec de
        pop bc  ;clean up stack
        cp semi
        ret z
        lda what
        cp 1
        ret z
        ld hl,stg25
        call perr
        call fsemi
        ret

dec:    xor a
        sta ptfnf
        sta lind
        sta sf
        inc a
        sta modaf
        ld hl,0
        shld dmsiz
        shld tmpa
        lhld stor
        shld adrs
        xor a
        sta frmrf
        sta pdfd
        call decr
        lda pdfd
        or a
        call z,wrapup
        lda frmrf       ;was it a formal resolution?
        or a
        jp z,dec2
        lhld savsta     ;yes. restore storge allocation count
        shld stor
dec2:   lda funcf
        or a
        ret z
        lda clevt
        sta clev
        cp 64           ;max # of funcs specifiable in 6 bits
        ret c
        ld hl,stgtmf    
        jp pstgab

decr:   xor a
        sta funcf
        call igsht
        cp open
        jp nz,decr1
        inc de
        call decr
        cp close
        inc de
        jp z,deca
        ld hl,stg16

decr0:  call perr
        call fsemi
        ret

decr1:  cp mulcd
        jp nz,decr2
        inc de
        call decr
        ld hl,lind
        inc (hl)
        ld a,(hl)
        cp 4
        jp c,deca
        ld de,stgtmi    ;too much indirection
        call perr
        jp deca

decr2:  call varch
        jp nc,decr3
        ld hl,stg17
        jp decr0

decr3:  call finds      ;symbol exist already?
        jp nc,dec3a

        lda forml       ;no. are we processing formal declarations?
        or a
        jp z,decr3a     ;if not, no problem
                        ;OK, we're definitely doing formal declarations:
        lda stelf       ;processing structure definition?
        or a
        jp nz,decr3a    ;if so, allow it (wierd but OK, I guess...)

decr3e: ld hl,stgbfd    ;else error.
        call bvarm2     ; "idendtifier not in formal list: name"
        jp decr3a

dec3a:  shld pdfdno
        lda clev        ;are we at external level?
        or a
        jp z,decr3x     ;if so, go handle that case
        lda flev        ;we're local. Is identifier also an external
        or a            ;variable?
        jp nz,decr3z

        lda stelf       ;if in a structure def, don't look too hard...
        or a
        jp nz,decr3a

        lda forml       ;yes. If we're formal, bad news.
        or a
        jp nz,decr3e
        jp decr3a       ;else just make a local instance of the identifier.

decr3z: lda stelf       ;now we know: we're local & we have a previously
        or a            ; defined local identifier to process.
        jp nz,dr3za     ;are we processing a structure definition?

        lda forml       ;if not, it BETTER be a formal parameter decl...
        or a
        jp z,dec3ze     ;if not, it is a redeclaration error.

        ld a,0          ;else must set things up specially for wrapup
        sta modaf       ;make sure stp and stno aren't bumped in wrapup
        inc a
        sta frmrf       ;set formal resolution flag

        lhld stor       ;save current storge allocator
        shld savsta     ;to be restored AFTER the wrapup

        lhld inadsv     ;get pointer to ST entry of formal parameter
        dec hl
        shld tempd
        inc hl
        inc hl
        ld a,(hl)               ;get address from ST entry
        inc hl
        ld h,(hl)
        ld l,a
        shld adrs       ;make current for wrapup
        jp decr4        ;and handle rest of declaration normally

dr3za:  lhld inadsv
        dec hl
        shld tempd
        lda what
        or a
        jp nz,dec3ze
        ld a,(hl)
        and 8
        jp z,dec3ze
        ld a,(hl)
        rlca
        rlca
        rlca
        rlca
        and 7
        ld b,a
        lda type
        cp b
        jp nz,dec3z1
        inc hl
        inc hl
        ld c,(hl)
        inc hl
        ld b,(hl)
        lhld stor
        ld a,b
        cp h
        jp nz,dec3z1
        ld a,c
        cp l
        jp nz,dec3z1
        xor a
        sta modaf
        jp decr4

dec3ze: ld hl,stg24
        call bvarm2
        call fsemi
        ret

dec3z2: call perr
        call fsemi
        ret

dec3z1: ld hl,stgbsd
        jp dec3z2

decr3x: call cvtst
        shld tempdp
        and 3
        cp 3            ;is previously declared identifier a function ref?
        jp z,decr3y     ;if so, go handle as a "previously declared func def"f
        ld a,(hl)               ;else is it a structure element?
        and 8
        jp nz,decr3z    ;if so, handle as such and let errors happen there
        call dec3ze     ;else barf on it.
        jp errab

decr3y: ld a,1
        sta pdfd
        ld a,(hl)
        and 0fdh        ;change from func ref to func def
        ld (hl),a
        jp decr4

decr3a: call instt      ;install new identifier
decr4:  lhld nlcnt
        push hl
        call pasvr
        pop hl
        cp open
        jp z,decr4a
        lda pdfd
        or a
        jp nz,dec3ze
        jp deca

decr4a: ex de,hl
        shld opena
        ex de,hl
        push hl
        call mtchp
        pop hl
        cp semi
        jp z,decr5
        cp comma
        jp nz,decr7

decr5:  shld nlcnt
        lhld opena
        ex de,hl
        jp deca

decr7:  lda clev        ;found a function definition--process it
        or a
        jp z,decr8
        ld hl,stg19
        jp decr0

decr8:  ld a,1
        sta funcf
        sta what
        shld nlcnt      ;restore line count at start of func name ident
        ld hl,0 
        shld adrs
        lhld tempd
        lda pdfd
        or a
        jp z,decr9
        lhld tempdp
decr9:  shld fndad
        ret

deca:   call igsht
        cp open
        jp nz,deca3
        lda lind
        or a
        jp z,deca2
        dec a
        sta lind
        ld a,1
        sta ptfnf
        call mtchp
        ret

deca2:  ld a,3
        sta what
        lhld fnc
        shld adrs
        inc hl
        shld fnc
        call mtchp
        ret

deca3:  cp openb
        ret nz
        lda lind
        sta sf
        ld hl,1
        call gdim
        shld tmpa
        lda forml
        or a
        jp nz,deca4
        lda csf
        or a
        jp nz,deca4

dca3a:  ld hl,stg20
        call gdim1a

deca4:  call igsht
        cp openb
        jp z,deca5
        ld hl,0ff00h
        shld dmsiz
        ret

deca5:  call gdim
        call multa
        lda csf
        or a
        jp z,dca3a
        call igsht
        cp openb
        jp nz,deca6

deca5a: ld hl,stg21
        call gdim1a

deca6:  shld dmsiz
        ret

gdim:   inc de
        xor a
        sta csf
        call igsht
        inc de
        cp closb
        ret z
        dec de
        ld a,1
        sta csf
        ld a,(de)
        cp concd
        jp z,gdim2

gdim1:  ld hl,stg22
gdim1a: call perr
        call fsemi
        pop hl
        pop hl
        ret

gdim2:  inc de
        ld a,(de)
        ld l,a
        inc de
        ld a,(de)
        ld h,a
        inc de
        call igsht
        cp closb
        inc de
        ret z
        jp gdim1


mult:   push de
        ld d,h
        ld e,l
        ld hl,0

mult2:  add hl,de
        dec bc
        ld a,b
        or c
        jp nz,mult2
        pop de
        ret

multa:  push hl
        ld b,h
        ld c,l
        lhld tmpa
        call mult
        shld tmpa
        pop hl
        ret


wrapup: push de
        lda what
        ld b,a
        lda forml
        add a
        add a
        add b
        ld b,a
        lda stelf
        add a
        add a
        add a
        add b
        ld b,a
        lda type
        add a
        add a
        add a
        add a
        add b
        ld b,a
        lda ptfnf
        rrca
        add b
        lhld tempd
        ld (hl),a
        inc hl
        lda lind
        rrca
        rrca
        and 0c0h
        ld b,a
        lda clev
        add b
        ld (hl),a
        inc hl
        ex de,hl
        lhld adrs
        ex de,hl
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        ex de,hl
        lhld size
        ex de,hl
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        ex de,hl
        lhld dmsiz
        ex de,hl
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        lda modaf
        or a
        jp z,wrap2
        shld stp
        lhld stno
        inc hl
        shld stno
wrap2:  pop de
        lda what
        or a
        ret nz

        ld bc,1
        lhld tmpa
        ld a,h
        or l
        jp z,wrapf
        lda sf
        or a
        jp nz,wrapf
        lda forml
        or a
        jp nz,wrapf
        ld b,h
        ld c,l

wrapf:  ld h,b
        ld l,c

        lda lind
        or a
        ld bc,2         ;if any levels of indirection, make object size
        jp nz,wrpf3     ;equal to two

        lda ptfnf       ;pointer to function is a special case of indirection
        or a
        jp nz,wrpf3
        
        lda forml
        or a
        jp nz,wrpf3
        lda type
        cp 6
        jp nz,wrpf2
        push hl
        lhld strsz
        ld b,h
        ld c,l
        pop hl
        ld a,b
        cp 0ffh
        jp nz,wrpf3
        push hl
        ld hl,stg28
        call perr
        ld bc,1
        pop hl
        jp wrpf3

wrpf2:  dec bc
        or a
        jp z,wrpf3
        inc bc
        cp 3
        jp c,wrpf3
        inc bc
        inc bc
        cp 5
        jp c,wrpf3
        inc bc
        inc bc
        inc bc
        inc bc

wrpf3:  call mult
        ld b,h
        ld c,l
        lhld stor
        lda unflg
        or a
        jp z,wrpf4
        lhld mxsiz
        call max
        shld mxsiz
        ld hl,0
        jp wrpf5
wrpf4:  add hl,bc
wrpf5:  shld stor
        xor a
        sta sf
        ret

max:    ld a,b
        cp h
        ret c
        jp z,max2

max1:   ld h,b
        ld l,c
        ret

max2:   ld a,c
        cp l
        ret c
        ld h,b
        ld l,c
        ret


;
; Definitions of some scratch variables and buffers
; used by passc: Since passc happens after bst is all
; done, we put all passc's temp space on top of the bst
; code:
;

cntt:   equ bst         ;(ds 220)
cntp:   equ bst+220     ;(ds 2)
swtc:   equ bst+222     ;(ds 1)
swtt:   equ bst+223     ;(ds 800)
swtp:   equ bst+1023    ;(ds 2)
defp:   equ bst+1025    ;(ds 2)
defflg: equ bst+1027    ;(ds 1)
tmpnl:  equ bst+1028    ;(ds 2)
fbuf:   equ bst+1030    ;(ds 350)
;
; "Expendable" routines: the following code gets
; overwritten by the symbol table after it is used...
;

        ds 4
st:     equ ($+15) and 0fff0h


stg11:  db 'Illegal colon+'
stg26:  db 'Undefined label used+'
stg99:  db 'Syntax error+'
stg8:   db 'Bad constant+'
stg8a:  db 'Bad octal digit+'
stg8b:  db 'Bad decimal digit+'
stgsuf: db 'Curly-braces mismatched somewhere in this definition+'

;
; The following strings used only by "readf", so their storge
; areas may be used by other routines afterwards...
;

stg4:   db 'Disk read error+'
stgie:  db 'Cannot open ',0
stgine: db '#include files nested too deep+'
stgnua: db 'No user area prefix allowed+'
stgucc: db 'Unterminated comment begins here+'

        IF NOT ALPHA
stg0:   db 'BD Software C Compiler '
        ENDIF

        IF ZSYSTEM
        db '(for ZCPR3) '
        ENDIF

        IF ALPHA
stg0:   db 'BDS Alpha-C Compiler '
        ENDIF

        if not ZSYSTEM
        db 'v1.'
        db version
        db updatn+'0'
        endif

        if ZSYSTEM
        db 'vZ'
        db version
        db '.'
        db updatn+'0'
        ENDIF

        IF UPDATY                       ;if there is a secondary update number,
             db updaty                  ;then specify it,
             db ' '
        ENDIF

        IF NOT UPDATY
             db '  '
        ENDIF

        db '(part I)'
        
        IF PREREL
           db '  pre-release'
        ENDIF

        db cr,lf

        IF      DEMO
        db      '       ==== DEMO COPY ====    **** NOT FOR DISTRIBUTION ****'
        db cr,lf
        db      '       This compiler package is available through this store,'
        db cr,lf
        db      '       or directly from:',             cr,lf
        db      '               BD Software, Inc.',     cr,lf
        db      '               P.O. Box 2368',         cr,lf
        db      '               Cambridge, Ma. 02238',  cr,lf
        db      '               Phone: (617) 576-3828', cr,lf
        db      '               Price:    $150 (8" SSSD format)',cr,lf
        ENDIF

        db 0

        IF CPM
stg1:   db 'Usage: ',cr,lf
        db 'call c,<source_file> [-p] [-o] [-a <x>] [-d <x>]'
        ENDIF

        IF CPM AND NOT ALPHA
        db ' [-m <addr>]'
        ENDIF

        IF CPM
        db ' [-e <addr>] [-r <n>]'
        ENDIF

        db '+'

savadr: equ $           ;this is where readf will go....


;
; The following storage is for routines in the expendable portion of 
; the program. The sections for each (independent) pass are org-ed to
; start at "stg4", to conserve memory
;

        org stg4        ; "prep" data area:

deformt: ds 50          ; (prep) for scratch space later on
txbuf:  ds 200          ; (prep) scratch space
nlcsav: ds 2            ; (prep) nlcnt gets saved here while text is hacked
def2p:  ds 2            ; (prep) string table pointer for preprocessor
deftmp: ds 2            ; (prep)
dstgf:  ds 1            ; (prep)
nestl:  ds 1            ; (prep) nesting level for preprocessor
active: ds 1            ; (prep) active conditional compilation flag
didelse: ds 1           ; (prep) true if "#else" already done
parenc: ds 1            ; (prep) paren nesting count, used by "deform"

        org stg4        ; "passx" and "lblpr" data area:

opstp:  ds 2            ; (passx) op stack pointer for constant expr evaluator
opstk:  ds 30           ; (passx) operator stack for const. expr evaluator
valsp:  ds 2            ; (passx) val stack ptr for const. expr eval.
valstk: ds 50           ; (passx) val stack for const. expr. eval.
savnlc: ds 2            ; (lblpr) for saving function starting line #s


;
; Read in the source file from disk, process
; #includes on the fly, recursively
;

        org savadr

readf:  ld hl,st        ;initialize code address to follow
        ex de,hl                ;       variable-sized symbol table
        lhld stsiz
        add hl,de
        shld coda

        ld hl,inclstk   ;set up #include processing stack after code ends
        shld fsp
        lhld coda
        shld textp

        IF CPM
        xor a           ;don't put out user number on main filename
        sta udiag
        inc a           ;allow automatic ".c" tacking for main file
        sta dodotc
        ENDIF

        call initps

;gen fcb from filename
filenameaddr=$+1
        ld de,0
        push de
readf_fspac:
        ld a,(de)
        or a
        jr z,readf_fspac_skip
        inc de
        cp ' '
        jr nz,readf_fspac
        dec de
        xor a
        ld (de),a
readf_fspac_skip
        pop de
        ld hl,fcb+1;fcb_filename ;Pointer to 11 byte buffer
        OS_PARSEFNAME

        ;ld hl,fcbwas
        ;ld de,fcb
        ;ld bc,FCB_sz
        ;ldir

        call readm
        or a            ;successful?
        jp z,errab      ;go abort if not
        ld (hl),0
        inc hl
        ld (hl),1ah
        shld eofad
        shld meofad
        ret

;fcbwas
;        db 0
;fcbwas_filename
;        db "ex      c  "
;        ds fcbwas+FCB_sz-$

;
; Read in a source module from disk. Filename and user number have
; been preset by calling routine (file info at default fcb):
;

readm:  push de
        ld de,fcb
        call openg
        pop de
        jp nz,rm2               ;if no error, goto rm2

        IF CPM          ;try ".c" if no extension given.
        lda dodotc      ;allowing automatic ".C" tacking?
        or a
        jp z,reade      ;if not, then open simply failed.

        ld de,fcb+9     ;else try tacking ".C" if no extension given.
        ld a,(de)
        cp ' '
        jp nz,reade     ;if extension given, simple error.
        ld a,'C'        ;else tack on the .C extension
        ld (de),a
        jp readm        ;and go try opening it THAT way
        ENDIF

reade:  lda modstc      ;at top level?
        or a
        ld hl,stgie     ;"Cannot open: "
        push af
        call z,pstg
        pop af
        call nz,perr
        call prfnm      ;<filename>
        call crlf
        xor a           ;return zero to indicate failure
        lhld textp      ;return HL still valid so we don't botch up memory
        ret

prfnm:
        IF CPM
        lda udiag       ;printing user number as part of filename?
        or a
        jp z,prfnm2
        lda defusr
        cp 0ffh ;if default user area is always the current one,
        lda curusr      ;   don't mention it in error report
        call nz,prads   ;print decimal number and slash
prfnm2:
        ENDIF
        call pfnam
        ret

;
; Module opened OK. Set up for reading:
;

rm2:    xor a           ;initialize comment nesting level count
        sta cmntf
        sta quotf       ;not in a quoted string

        IF CPM
        sta dodotc      ;don't append ".C" on first try
        ENDIF

        IF NOT ALPHA
        inc a
        ENDIF

        sta udiag       ;print user number in filename diagnostics from now on
        ld hl,tbuff+secsiz-1    ;set up sector buffer so the next call to

        IF NOT CPM
        ld hl,secbuf+secsiz-1
        ENDIF

        shld sptr       ;init sector pointer

        ld hl,0         ;clear line number for unmatched comment diagnostics
        shld nlcnt
        shld atcnt      ;clear active text line counter, also for above

        lhld textp
        ld (hl),modbeg  ;install module-begin code and filename in text...
        inc hl
        push hl
        call insrtm     ;install module name into text
        pop de
        call pushmn     ;push module name onto modstk
        ex de,hl        

rm2a:   ld a,cr
        sta lastc

rm3:    call getc       ;get a character
        jp c,rm3ab0     ;on EOF, go check for last-line CR and close the file

rm3aa:  call kludge     ;reverse cr's and lf's for some strange reason...
        ld a,c          ;always save CR's
        cp cr
        jp nz,rm3ab

        call bumpnl     ;bump line count
        call ckabrt     ;check once in a while for abortions
        jp storc

rm3ab:
        cp 1ah          ;if control-Z, check for proper final line termination
        jp nz,rm3ac

;
; Perform end-of-file consistency check, to make sure final line of the
; file was properly terminated with a newline:
;

rm3ab0: push hl         ;save text pointer
rm3ab1: dec hl
        ld a,(hl)
        cp cr
        jp z,rm3ab2     ;if found CR, last line was properly terminated...
        cp 0ffh
        jp z,rm3ab1     ;ignore FF's
        pop hl          ;else last line was NOT properly terminated. insert CR
        ld (hl),cr
        inc hl
        jp rm3ab3       ;and go close file

rm3ab2: pop hl
rm3ab3: call closef
        ld (hl),modend  ;module-end marker
        inc hl
        call popmn      ;pop module name off module stack

        lda cmntf
        or a            ;file ends in the middle of a comment?
        ld a,1          ;return success code if not
        ret z
        push hl

        call pfnam      ;print file name
        ld a,':'
        call outch
        ld a,' '
        call outch

        lhld atcnt      ;get last active line number
        call prhcs
        ld hl,stgucc    ;"UNCLOSED COMMENT" diagnostic
        call pstg
        pop hl
        xor a           ;return 0 -- error condition
        ret

rm3ac:  cp 0ch          ;formfeeds turn into nulls
        jp z,storff

        cp lf           ;so do linefeeds
        jp z,storff

        or a            ;nulls are totally ignored
        jp z,rm3

        lda cmntf
        or a            ;are we in a comment?
        jp nz,rm3ac2    ;if so, go test for in-comment conditions

        push hl         ;save line number as last active line number
        lhld nlcnt
        shld atcnt
        pop hl
        jp storc        ;and go save character in memory

rm3ac2: ld a,c          ;we're in a comment.
        cp '/'          ;have we encountered a close comment?
        jp nz,rm3a
        lda lastc
        cp '*'
        ld a,'/'
        jp nz,rm3a
        lda cmntf       ;yes. decrement comment count.
        dec a
        cp 255
        jp z,rm2a               ;don't store back if too many closes!
        sta cmntf
        jp rm2a

rm3a:   cp '*'          ;have we encountered another open comment?
        jp nz,rm3b
        lda lastc
        cp '/'
        ld a,'*'
        jp nz,rm3b      
        lda cnflag      ;do comments nest?
        or a
        jp z,rm2a               ;if not, ignore this new open comment.
        lda cmntf       ;yes. bump comment count.
        inc a
        sta cmntf
        jp rm2a

rm3b:   sta lastc       ;still in comment. keep scanning.
        jp rm3

storc:  ld (hl),c               ;not in a comment. store the character
        
        ld a,c
        call mapuc
        cp '#'          ;preprocessor directive?
        jp nz,rm4
        lda lastc       ;get char before "#" for later check
        sta lastc2      ;to make sure it is a CR.
        shld pndsav
        ld a,'#'
rm3r:   inc hl
rm3s:   sta lastc
        jp rm3

storff: ld a,0ffh
        ld (hl),a
        jp rm3r

rm4:    cp '"'          ;check for quote
        jp nz,rm4b
        lda quotf       ;is this a closing or opening quote?
        or a
        jp nz,rm40      ;if closing, don't check for '"' case
        lda lastc       ;was last char a single quote?
        cp ''''
        jp z,rm6
rm40:   lda quotf       ;found one. Already in a string?
        or a
        ld a,1  
        jp z,rm4a               ;if not, set the string flag
        xor a           ;else clear the string flag
rm4a:   sta quotf       ;set "in a string" flag
        ld a,'"'
        jp rm6  

rm4b:   cp '\'          ;check for backslash in quoted string
        jp nz,rm4c

        lda quotf       ;in a quoted string?
        or a
        ld a,'\'
        jp z,rm6                ;if not, ignore backslash
        inc hl
        call getcef
        cp '"'
        jp z,rm4ba
        cp '\'
        jp z,rm4ba
        jp rm3aa

rm4ba:  ld (hl),a
        jp rm6

rm4c:   cp '*'          ;have we encountered an open comment?
        jp nz,rm5
        lda lastc       ;maybe...we have a '*'
        cp '/'          ;was last character a '/'?
        ld a,'*'        ;if not, just store the '*'
        jp nz,rm6
                        ;OK, we found a '/*' sequence...
        lda quotf       ;in a quoted string?
        or a
        ld a,'*'        ;if so, don't regard the '/*' as a comment delimiter
        jp nz,rm6

        dec hl          ;definitely a comment delimiter. kill the '/'
        ld a,1          ;and set comment count.
        sta cmntf
        jp rm2a

rm5:    cp 'I'          ;possibly part of "include" keyword?
        jp nz,rm6
        lda lastc2      ;if a possible #include, make sure
        cp cr           ;the char before the "#" was a CR..
        jp nz,rm6
        xor a
        sta lastc2
        lda lastc
        cp '#'
        jp z,doincl

rm6:    sta lastc
        inc hl
        jp rm3


;
; Handle "#include":
;
; At this point, we've seen "#i"...let's make sure
; we see at least another "n", then skip the rest, and
; then process the file...
;

angleu: ds 1            ;true if angle bracket surrounds filename

doincl: xor a
        sta angleu
        shld textp
        inc hl
doin0:  call getcef
        ld c,a
        call mapuc
        cp 'N'
        jp nz,storc
        
        call getcef
        call mapuc
        cp 'C'
        jp nz,rm6               ;just makin' sure we got "#inc"...

doinz:  call getcef     ;pass by rest of "#include" keyword
        call twsp
        jp nz,doinz

doinz2: call getcef     ;find filename argument
        call twsp
        jp z,doinz2

        IF CPM
        push af
        lda curdsk      ;by default, new disk and user area
        sta newdsk      ;are the same as current disk and user
        lda curusr      ;area.
        sta newusr
        pop af
        ENDIF

        ld de,fnbuf     ;copy name to buffer
        push de

        cp '"'          ;ignore 1st char if quote
        jp z,doin1
        cp '<'
        jp nz,doin1a    ;if angle bracket, assume a special directory is
                        ;to be searched (under CP/M, a disk and user area)
                        ;       << Handle Angle Brackets now: >>
        IF CPM
        sta angleu      ;note that angle bracket was found
        lda defdsk      ;get default disk drive for file yanking
        cp 0ffh ;default to current?
        jp nz,doiny1    ;if not, use as is

        lda origdsk     ;get current disk drive when compiler invoked
;       lda curdsk      ;if so, make it the new disk

doiny1: sta newdsk

        lda defusr      ;set new user area
        cp 0ffh ;default to current?
        jp nz,doiny2

        lda origusr     ;get current user number when compiler invoked
;       lda curusr      ;if so, make new user area the current one

doiny2: sta newusr
        ENDIF   

doin1:  push de
        call getc       
        pop de
        jp c,closef

doin1a: cp lf           ;CR,LF,space,tab,", and > all terminate name.
        jp nz,doin1b
        push hl
        lhld sptr
        dec hl
        shld sptr
        pop hl
        jp doin2

doin1b: cp cr
        jp z,doin2
        call twsp
        jp z,doin2
        cp '>'
        jp z,doin2
        cp '"'
        jp z,doin2
        ld (de),a
        inc de
        jp doin1


                        ;simplified 12/27/85
        IF 0
doin2:
        cp lf
        call z,bumpnl   ;bump line count
        jp z,doin3
                        ;ignore rest of line, but treat a comment
                        ;as a special case because of lousy design...
doin20: call getcsd
        cp '/'          ;possible start of comment?
        jp nz,doin2     ;if not, keep on throwing away the line
        call getcsd     ;yes. next character
        cp '*'          ;a star?
        jp nz,doin2     ;if not, keep throwing line away...

doin2a: call getcsd     ;else look for closing comment characters, and preserve
        cp lf           ;linefeeds.
        jp nz,doin2b    ;a linefeed?
        call bumpnl
        lhld pndsav     ;if so, store it and bump pointer...
        ld (hl),cr
        inc hl
        shld pndsav
        jp doin2a       ;and go on processing comment
        
doin2b: cp '*'          ;possible end of comment?
        jp nz,doin2a    ;if not, keep on scanning comment
        call getcsd     ;yes...followed by a slash?
        cp '/'
        jp nz,doin2b    ;if not, might have been a star...
        jp doin2        ;else done with comment. go process rest of this line.


getcsd: push de
        call getc
        pop de
        ret nc
        pop bc
        jp closef
        ENDIF

twsp:   cp ' '
        ret z
        cp 0ffh
        ret z
        cp 9
        ret

doin2:  
doin3:  xor a
        ld (de),a
        call pushf

        pop de          ;check for explicit user area prefix on filename
        push de         ;save ptr in case of no legal user number prefix
        call gdec       ;test for decimal number (gdec sets Cy if none)
        jp c,doin3a     ;if no prefix, don't futz with user number
        ld a,(de)               ;check for trailing slash
        cp '/'
        jp nz,doin3a    ;if none, not a legal user number
        ld a,b          ;else it is. Make it the new user number
        sta newusr
        inc de          ;bump text pointer past user number prefix
        pop hl          ;discard pushed text pointer from stack
        jp doin3b       ;and go process remainder of filename           

doin3a: pop de          ;under CP/M, set up default fcb with filename
doin3b: ld hl,fcb
        call setfcb     ;set up fcb, return Cy if explicit drive name given
        jp c,doin3d     ;if explicit drive given, don't be intelligent...
                        ;at this point: no explicit drive name given. Only
                        ;allow the source file disk to determine new-disk for
                        ;the included file IFF no angle bracket was used...
        lda angleu      ;was angle bracket used?
        or a            
        jp nz,doin3e    ;if so, IGNORE default source disk (sdisk)
                        ;inserted by setfcb.
                        ;If no <...> used, allow sdisk to determine source disk
doin3d: lda fcb         ;see if explicit disk given in #include op
        or a            ;if non-zero, an explicit disk was given,
        jp nz,doin3c    ;       so go log that in as new current disk
        
doin3e: lda newdsk      ;if no disk designator given, set disk byte
        inc a           ;with appropriately offset new disk value
        sta fcb ;TODO remove?

doin3c: dec a           ;change fcb-based disk code to BDOS call disk code
        sta newdsk
doin4:  ;ld e,a
        ;ld c,select
        ;call bdos      ;select disk

        lda curdsk      ;save current disk and user area on stack
        push af
        lda curusr
        push af

        lda newdsk      ;and set up new disk and user area for this file
        sta curdsk
        lda newusr
        sta curusr
        
        ld e,a          ;select new user area

        IF NOT ALPHA
        ;lda nouser
        ;or a
        ;jp nz,doin40   ;skip setting user area if 'nouser' true
        ;ld c,sguser 
        ;call bdos
        ENDIF

        IF NOT CPM
        pop hl          ;else put filename in HL
        shld fnam       ;and save for pfnam printout (on error only)
        ENDIF


doin40: lhld nlcnt      ;save line count
        push hl

        lhld pndsav
        shld textp

        call readm      ;read in the included file

        sta okflag      ;save return condition from readm in okflag

        ex de,hl                ;save HL in DE
        pop hl          ;restore line count
        shld nlcnt
        shld atcnt      ;match active text to current line number
        ex de,hl                ;restore text ptr into HL

        pop af          ;they were before the include file was being processed.
        sta curusr      ;first the user number:
        push hl         ;save HL during BDOS calls
        ld e,a

        IF NOT ALPHA
        ;lda nouser
        ;or a
        ;jp nz,doin5a   ;skip setting user area if 'nouser' true
        ;ld c,sguser
        ;call bdos
        ENDIF

doin5a: pop hl          ;pop HL so we can get at pushed psw...
        pop af          ;and then set the current disk:
        sta curdsk
        ;push hl                ;save HL for BDOS call
        ;ld e,a
        ;ld c,select
        ;call bdos      ;select disk
        ;pop hl         ;restore HL after BDOS futzing

        call popf       
        lda okflag      ;was the readm successful?
        or a
        jp nz,rm3               ;if so, go on
        jp errab        ;and  all done

;
; Get next char from current file, and go close file and return to
; caller one level higher if EOF encountered:
;

getcef: call getc
        jp c,getcf2
        cp 1ah          ;end of file character?
        ret nz
getcf2: pop bc
        jp closef

;
; Get next character from current text input file:
;

getc:
        ex de,hl                ;save text pointer in DE
        lhld sptr       ;get sector pointer in HL
        inc hl          ;bump it
        ld a,l          ;exhausted current sector? look at low byte of ptr

        IF CPM  
        or a            ;check for 00 (end of tbuff) under CP/M
        ENDIF

        jp nz,getc1
        call reads      ;yes. read in next sector

        IF CPM
        ld hl,tbuff     ;and reset sector pointer
        ENDIF

        IF NOT CPM
        ld hl,secbuf
        ENDIF

        ex de,hl                ;put text pointer back in HL in case of return...
        ret c           ;if EOF, restore textp into HL and return

        call ckov       ;check HL for memory overflow
        ex de,hl                ;put text ptr in DE, get sector pointer in HL

getc1:  ld a,(hl)               ;get next char from sector buffer

stripp: and 7fh         ;strip parity -- substitute "nop-or a" for "and 7fh"
                        ;               to allow bit 7 to be high on input text
        shld sptr       ;save sector pointer
        ex de,hl                ;get back text pointer in HL
        ret


;
; Install current filespec (from default fcb) into text buffer at HL,
; and bump HL past the filename:
;

insrtm: push bc
        push hl
        push de
        ld b,12
        ld de,fcb
        call ldrc
        pop de
        pop hl
        pop bc
        ret


pushf:  push hl
        push de
        ld c,0
        lhld fsp
        call ldstf
        shld fsp
        pop de
        pop hl
        ret

popf:   push hl
        push de
        ld c,1
        lhld fsp

        IF CPM
        ld de,-164      ; 33 (fcb) + 128 (buffer) + 2 (ptr) + 1 (rederf) = 164
        ENDIF

        add hl,de
        shld fsp
        call ldstf      
        pop de
        pop hl
        ret

ldstf:
        IF CPM
        ld de,fcb
        ld b,33
        call ldram
        ld de,tbuff
        ld b,128
        call ldram
        ld de,sptr
        ld b,3
        call ldram
        ret
        ENDIF

        IF CPM          ;set default FCB, return Cy set if explicit drive used:
setfcb: ld b,8
        push hl
        inc de
        ld a,(de)
        dec de
        cp ':'
        lda sdisk       ;default disk is disk source file came from
        scf
        ccf
        push af ;push Cy reset in case explicit disk not given
        jp nz,setf1
        pop af
        scf
        push af ;push Cy set, since explicit disk IS given
        ld a,(de)
        call mapuc
        sub '@'
        inc de
        inc de
setf1:  ld (hl),a
        inc hl
        call setnm
        ld a,(de)
        cp '.'
        jp nz,setfcb2
        inc de
setfcb2:ld b,3
        call setnm
        ld (hl),0
        ld de,20
        add hl,de
        ld (hl),0
        pop af          ;restore return flag (Cy set if d: given)
        pop de          ;restore fcb address in DE for BDOS call forthcoming
        ret

setnm:  push bc
setnm2: ld a,(de)
        call legfc
        jp c,pad
        ld (hl),a
        inc hl
        inc de
        dec b   
        jp nz,setnm2
        pop bc
setnm3: ld a,(de)
        call legfc
        ret c
        inc de
        jp setnm3

pad:    ld a,' '
        ld (hl),a
        inc hl
        dec b   
        jp nz,pad
        pop bc
        ret

legfc:  call mapuc
        cp '.'
        scf
        ret z
        or a
        scf
        ret z
        ccf
        ret

        ENDIF

reads:
        IF CPM          ;read a sector of 128 bytes under CP/M
        push hl
        push de
         ld de,0x0080
         ld c,sdma
         call bdos
        ld de,fcb
        ld c,rsequen
        call bdos
        or a
        pop de
        pop hl
        ret z ;ok, full sector
         cp 128 ;EOF in NedoOS
         jr z,reads_eof
;CP/M has eofs in the end of last sector?
;do this by hand:
;a=128+bytes loaded
        neg
;a=128-bytes loaded
        push de
        ld b,a
        ld de,0x0080+127        ; Point to buffer end
        ld a,0x1a
        ld (de),a
        dec de
        djnz $-2
        pop de
        or a
        ret ;ok, not full sector
reads_eof
        ;cp 1
        ;jp nz,rds2 ;???
        scf ;error
        ret
        ENDIF

rds2:
        ld hl,stg4
        jp pstgab


kludge: cp cr
        ld c,lf
        ret z
        cp lf
        ld c,cr
        ret z
        ld c,a
        ret

        ;IF LASM
        ;link ccd
        ;ENDIF