Subversion Repositories NedoOS

;
; CCB.ASM: Second main source file of CC.ASM
;
;       Miscellaneious utility routines,
;


;
; Delete a file:
;

        IF CPM
delfil:
        ld de,fcb
delf2:
        push hl
        push de
        ld hl,12
        add hl,de
        ld (hl),0
        ld c,delete
        call bdos
        pop de
        pop hl
        ret
        ENDIF

;
; Create a new file:
;
create:
        IF CPM
        ld de,fcb
create2:
        push hl
        push de
        ld hl,12        ;clear extent byte
        add hl,de
        ld (hl),0
        ld c,makfil
        call bdos
        pop de
        ld hl,32
        add hl,de
        ld (hl),0
        pop hl
        cp 255
        ret nz
        ENDIF

        jp openo3

;
; Open a file for output:
;
openo:  ld de,fcb
openo2: call openg
        ret nz

openo3: ld hl,stg3
        jp pstgab

        IF CPM
openg:  push hl
        push de
        push de         ;save fcb pointer
        ld c,openfil
        call bdos
        pop de          ;clear nr byte
        ld hl,32
        add hl,de
        ld (hl),0
        cp 0ffh ;return Z set on error
        pop de
        pop hl
        ret
        ENDIF


;
; Close a file:
;
closef: ld de,fcb
close2:
        IF CPM
        push hl
        ld c,closefil
        call bdos
        pop hl
        cp 255
        ret nz
        ld hl,stg2
        jp pstgab
        ENDIF


;
; Write a sector of a file out to disk:
;

        IF CPM
writs:  ld de,fcb
writs2: push hl
        ld c,wsequen
        call bdos
        pop hl
        or a
        ret z
        ld hl,stg3
        jp pstgab

;
; Copy 128 bytes from mem at (HL) to tbuff (80h), pad last sector
; with ^Z's if CPYEND reached and return Cy set if so:
;


copys:  ld de,tbuff
        ld b,80h

copy1:  ld a,(hl)
        ld (de),a
        push de
        ex de,hl
        lhld cpyend
        ld a,h
        cp d
        jp nz,copy2
        ld a,l
        cp e
        jp z,copy5

copy2:  ex de,hl
        pop de
        inc hl
        inc de
        dec b
        jp nz,copy1
        xor a
        ret

copy5:  pop de
copy6:  dec b
        jp z,copy7
        ld a,1ah
        ld (de),a
        inc de
        jp copy6

copy7:  scf
        ret
        ENDIF           ;end of CP/M-dependent file I/O


;
; Bump line count:
;

bumpnl: push hl
        lhld nlcnt
        inc hl
        shld nlcnt
        pop hl
        ret


;
; print out file name in default fcb:
;

pfnam:  push de
        ld de,fcb
        call pfnam2
        pop de
        ret

;
; Print out filename of fcb at DE:
;


pfnam2: push de
        push hl
        push bc
        ld a,(de)               ;get disk code
        or a
        jp z,pfnm3      ;if file on currently logged disk, don't print
                        ;disk designator.

;       ld c,gdisk      ;This section of code commented out to keep
;       push de         ;files on the currently logged drive from having
;       call bdos       ;a disk designator printed before their names.
;       pop de          ;uncomment the code to put this feature back
;       inc a           ;into action.

pfnm2:  add a,'@'               ;get A = 'A' for drive A, 'B' for B, etc.
        call outch
        ld a,':'
        call outch
pfnm3:  inc de
        ld b,8
        call pnseg
        ld a,(de)
        cp ' '
        ld a,'.'        ;print dot only if filename has extension
        call nz,outch
        ld b,3
        call pnseg
        pop bc
        pop hl
        pop de
        ret

pnseg:  ld a,(de)
        cp ' '
        call nz,outch
        inc de
        dec b
        jp nz,pnseg
        ret

;
; Print out the value in HL in hex, followed by a colon
; and a space.
; Upon entry, A non-0: print no leading spaces
;              A == 0: print leading spaces making total textual output 4 chars
;
;

prhcs:  push af
        push de
        call prh        ;convert HL to ascii at ascb
        pop de
        pop af
        or a
        ld hl,ascb
        jp z,prhcs3     ;if printing leading spaces, go do it
        dec hl
prhcs1: inc hl
        ld a,(hl)
        cp ' '
        jp z,prhcs1     ;if all four digits, no leading spaces needed

prhcs3: call pstg
        ret

;
; Print A in ASCII followed by a slash
;

prads:  and 1fh         ;max 31
        call pra
        ld a,'/'
        call outch
        ret

pra:    cp 10           ;single digit?
        jp nc,pra2      ;if not, go handle double digits
pra0:   add a,'0'                ;print single digit in A
pra1:   call outch
        ret
pra2:   ld b,0          ;calculate 10's digit
pra3:   inc b
        sub 10
        cp 10
        jp nc,pra3
        push af
        ld a,b
        call pra0       ;print tens digit
        pop af
        jp pra0

;
; Convert value in HL into ASCII at ascb, ascb+1, ascb+2, ascb+3:
;

prh:    push hl
        ld hl,'  '
        shld ascb
        ld hl,' 0'      ;mac doc. is wrong about this!
        shld ascb+2
        pop hl
        inc hl

prh0:   ld a,h
        or l
        ret z
        dec hl
        push hl
        ld hl,ascb+3

prh1:   ld a,(hl)
        cp ' '
        jp nz,prh2
        ld a,'0'

prh2:   inc a
        cp '9'+1
        jp z,prh4

prh3:   ld (hl),a
        pop hl
        jp prh0

prh4:   ld (hl),'0'
        dec hl
        jp prh1


;
; 2's complement HL:
;

cmh:    push af
        ld a,h
        cpl
        ld h,a
        ld a,l
        cpl
        ld l,a
        inc hl
        pop af
        ret


;
; "Ignore stuff" routine; pass by newlines, white space,
; module start and end bookkeeping, and keep the lines count
; (stored in nlcnt) for error reporting:
;

igsht:  ld a,(de)
        cp modbeg       ;begin nested module?
        jp nz,igsh0

        inc de
        call pushmn     ;push on modstk, process line number stuff
        jp igsht

igsh0:  cp modend
        jp nz,igsh1     ;include file end?
        call popmn      ;restore line number and pop filename off modstk
        jp igsh1a

igsh1:  cp 0ffh
        jp nz,igsh2

igsh1a: inc de
        jp igsht

igsh2:  cp nlcd
        jp nz,igsh3
        call bumpnl
        inc de
        jp igsht

igsh3:  or a
        ret

;
; Push filename at DE onto modstk, save current line number after it,
; bump modstc, and reset nlcnt:
;

pushmn: push hl         ;save HL
        ld hl,modstc    ;bump modstc
        inc (hl)
        ld a,(hl)
        cp 6
        ld hl,stgine
        call nc,perrab          

        lhld modstp     ;get next mod stack entry slot address
        ld b,12
        call ldrc       ;push new module name onto modstk
        push de         ;save text ptr
        ex de,hl
        lhld nlcnt      ;get line count
        ex de,hl                ;line count in DE, modstk ptr in HL
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        shld modstp
        ld hl,0
        shld nlcnt      ;clear nlcnt for new module
        pop de          ;restore text pointer
        pop hl          ;restore HL
        ret     

;
; Pop modstk entry:
;

popmn:  push hl         ;save registers
        push de
        lhld modstp
        dec hl
        ld d,(hl)
        dec hl
        ld e,(hl)               ;DE holds old nlcnt
        ex de,hl
        shld nlcnt      ;restore line count
        ld hl,-12
        add hl,de               ;roll modstk pointer back to start of current level
        shld modstp     ;save modstk pointer
        ld hl,modstc    ;debump module count
        dec (hl)
        pop de
        pop hl
        ret

ldrc:   ld a,(de)
        ld (hl),a
        inc hl
        inc de
        dec b
        jp nz,ldrc
        ret

;
; General purpose ram lde routine. 
; B = byte count
; C controls direction of lde:
;       0: DE->HL, 1: HL->DE
;

ldram:  ld a,c
        or a
        jp z,ldr2
        ex de,hl
ldr2:   ld a,(de)
        ld (hl),a
        inc hl
        inc de
        dec b
        jp nz,ldr2
        ld a,c
        or a
        jp z,ldr3
        ex de,hl
ldr3:   push de         ;make sure we don't overflow stack area
        push hl
        lhld coda
        ex de,hl                ;put code area addr in DE
        pop hl          ;and current include stack pointer in HL
        call cmphd
        pop de          ;restore sp
        ret c           ;if OK, return
        ld hl,stgine    ;include error
        jp pstgab       ;print message and quit

;
; Map alphabetic character in A to upper case:
;

mapuc:  cp 61h
        ret c
        cp 7bh
        ret nc
        sub 20h
        ret

;
; Special version of mapuc,  which supresses mapping if "mapucv" is true
;

mapuc0: push bc         ;save B
        ld b,a          ;save char to map in B
        lda mapucv      ;get control var
        or a            ;do we do a mapping?
        ld a,b          ;get back char to map in A
        call z,mapuc    ;if we do a mapping, go do it
        pop bc          ;restore B
        ret             ;all done

        
;
; Print out line number, error message in HL, and set errf so
; we don't auto-load cc2:
;

perr:   push af
        call pwarn
        ld a,1
        sta errf
        pop af
        ret

;
; Print out line number, error message in HL, but don't touch
; errf:
;

pwarn:  push hl
        call pmodnc     ;print module name
perr2:  lhld nlcnt
        call prhcs      ;print line number of error
        pop hl
        call pstg
        ret

;
; Print module name, colon, space:
;

pmodnc: call pmodnm
        push af
        ld a,':'
        call outch
        ld a,' '
        call outch
        pop af
        ret


;
; Print out module name:
;

pmodnm: push hl
        push de
        lhld modstp
        ld de,-14
        add hl,de
        ex de,hl        
        call pfnam2
        pop de
        pop hl
        ret


;
; Print out string pointed to by HL, with + character shorthand
; for a CR-LF:
;

pstg:   ld a,(hl)
        or a
        ret z
        cp '+'
        jp z,crlf
        call outch
        inc hl
        jp pstg

;
; Print strig to console only:
;

pstgco: lda werrs
        push af
        xor a
        sta werrs
        call pstg
        pop af
        sta werrs
        ret

;
; Output a character of text to the console and/or PROGERRS.$$$ file:
;

outch:  push de
        push bc
        push hl
        push af

        if 1==1
        ;exx
        ;push bc
        ;push de
        ;push hl
        ;push ix
        ;push iy
        PRCHAR_
        ;pop iy
        ;pop ix
        ;pop hl
        ;pop de
        ;pop bc
        ;exx
        else
        ld e,a
        lda werrs
        or a            ;if not writing errs to PROGERRS file,
        jp z,outch3     ;       go write to console
        
        lda nomore      ;if done writing RED errors, just go to console
        or a
        jp nz,outch3

        lda errsin
        or a
        jp nz,outch1    ;if RED buffer initialized, go handle I/O
                        ;else initialize RED buffer:
        inc a
        sta errsin

        push de
        ld de,redfcb
        lda odisk
        ld (de),a
        call delf2      ;delete previous PROGERRS.$$$
        call create2    ;create new one
;       call openo2     ;open for output
        ld hl,redbuf
        shld redbp      ;initialize redbuf sector pointer

        ld hl,stgeri    ;"RED error output initiated"
        call pstgco     ;print text to console only
        pop de

outch1: call redout     ;write char to red output file

outch3: ld c,conout
        call bdos
        endif
        
        pop af
        pop hl
        pop bc
        pop de
        ret

; Write a character to RED output buffer, flushing if needed:

redout: lhld redbp      ;get redbuf pointer
        ld (hl),e               ;store char
        inc hl          ;bump pointer
        shld redbp      ;save pointer
        ld a,l          ;past end of buffer?
        cp (redbuf+128) and 0ffh
        ret nz          ;if not, return



redwrt: push de
        ld de,redbuf    ;set DMA address to redbuf for sector write
        ld c,sdma
        call bdos

        ld de,redfcb
        call writs2     ;write sector

        ld de,tbuff     ;set DMA address back for normal file i/o
        ld c,sdma
        call bdos

        ld hl,redbuf
        shld redbp      
        pop de
        ret


;
; print "undeclared variable: " and print out the
; variable name being pointed to by DE:
;

bvarm:  ld hl,stg14
bvarm2: call perr
        push de
        call pvarn      ;print out the name
        pop de
        call crlf
        ret

;
; print out the variable name pointed to by DE:
;

pvarn:  ld a,(de)
        call varch
        ret c
        call outch
        inc de
        jp pvarn

;
; Print error message in HL and abort:
;

pstgab:
pstgb2: call pstg
        jp errab

;
; Print error msg in HL with line number, and abort:
;

perrab: call perr

;
; Come here to abort, when fatal error has been diagnosed:
;

errab:  lhld errbyt     ;set error byte flag for ZCPR3
        ld (hl),0ffh

        call errwrp     ;wrap up any RED file activity

errab2: ld a,7          ;ring a bell for errors having occurred
        call outch
        lda erasub      ;bother to erase submit files?
        or a
        jp z,exit

        ;ld e,0         ;go to user 0 for submit file erasure
        ;ld c,sguser

        IF NOT ALPHA
        ;lda nouser
        ;or a
        ;jp nz,errab3   ;if no user areas, don't do it

        ;lda zenvf      ;if not ZSYSTEMS, don't do it
        ;or a
        ;call nz,bdos
;errab3:
        ENDIF

        ld de,subfile   ;erase pending submit files and abort
        call delf2

exit:   ;call resetu    ;reset to original user drive/ user area
        QUIT
        ;lda wboote     ;need to perform warm-boot?
        ;or a
        ;jp nz,ram              ;if so, go do it.
        ;lhld spsav     ;get (possibly valid) saved stack pointer
        ;ld sp,hl               ;put into SP
        ;lda ccpok      ;CCP intact?
        ;or a
        ;ret nz         ;if so, return to CCP
        ;jp ram         ;otherwise do a warm boot

;resetu:        ;lda origdsk    ;reset disk and user area to original
        ;ld e,a
        ;ld c,select
        ;call bdos
        ;lda origusr
        ;ld e,a
        ;ld c,sguser

        ;IF NOT ALPHA
        ;lda nouser
        ;or a
        ;call z,bdos    
        ;ENDIF

        ;ret



;
; Print a newline to the console:
;

crlf:   push af

        IF CPM
        ld a,cr
        call outch
        ENDIF

        ld a,lf
        call outch
        pop af
        ret

;
; Check for abortion:
;TODO

ckabrt:
        push hl
        push de
        push bc
        push af

        ;lda conpol     ;are we polling the console?
        ;or a
        ;jp z,nohit     ;if not, don't do anything

        ;ld c,intcon    ;interrogate console status
        ;call bdos
        ;or a
        ;jp z,nohit
        ;ld c,coninp
        ;call bdos      ;if something hit, see if a ^C
        ;cp 3
        ;jp z,intrpt    
nohit:  pop af          ;if not, don't interrupt
        pop bc
        pop de
        pop hl
        ret

intrpt: ld hl,stgabo    ; and abort.
        jp pstgab
        
;
; Check for stack overflow:
;

chkstk: push hl
        push de
        push bc
        push af
        lhld stkchk
        ld de,0a55ah
        call cmphd      ;make sure stack check word is still intact
        jp z,nohit      ;if so, no problem
        ld hl,stgstk    ;else spew stack overflow message
        jp perrab


;
; Squeeze the symbol table by chopping out the name portion of every entry
; (reducing the st size by half, since each entry up to now has been
; 8 chars of name and 8 bytes of attributes):
;

chopst: lhld stno
        ld b,h
        ld c,l          ;BC = symbol entry count
        ld hl,st
        ld de,st

sqst2:  ld a,b
        or c
        jp nz,sqst3
        shld stp
        ret

sqst3:  push hl
        ld hl,8
        add hl,de
        ex de,hl
        pop hl

sqst4:  ld a,(de)
        ld (hl),a
        inc de
        inc hl
        ld a,l
        and 7
        jp nz,sqst4
        dec bc
        jp sqst2

;
; Write out special CCI-symbol-table file for Kirkland's debugger if "-w"
; option given...write out stno entries from symbol table at st, each
; 16 bytes long. Call the file <name>.CDB ... this is gonna be a neat hack!
;

wst4db: lda kflg        ;was -w even given?
        or a            ;if not, return
        ret z

        ld hl,st        ;get size of symbol table in HL
        call cmh
        ex de,hl
        lhld stp        ;get symbol table next free slot pointer
        shld cpyend     ;this is where we'll stop writing to the output file.
        add hl,de
        shld st-2       ;put symbol table size in place

        IF CPM
        ld hl,fcb+9
        ld (hl),'C'
        inc hl
        ld (hl),'D'
        inc hl
        ld (hl),'B'
        lda odisk       ;set output disk designation
        sta fcb
        call delfil     ;delete old versions
        call create     ;create output file
;       call openo      ;and open it for output

        ld hl,st-2
wstdb2: call copys
        push af
        call writs
        pop af
        jp nc,wstdb2
        call closef     ;close the output file.
        ENDIF

        ret


;
; Little general purpose utility to compare HL and DE,
; and return C set if HL < DE
;

cmphd:  ld a,h
        cp d
        ret nz
        ld a,l
        cp e
        ret


;
; Routine to make sure we haven't overflowed available memory space. At
; first, we try to use memory below the command processor (under both
; CP/M and MARC). If we run out of room, we either punt the CCP under
; CP/M or do the maxmem call under MARC to get more memory.
;

ckov:   push hl
        push de
ckov0:  lda curtop+1    ;high order byte of top of mem addr
        dec a
        ld d,a
        ld a,h
        cp d
        jp c,ckovok     ;overflow?

        IF CPM
        lda ccpok       ;under CP/M, is the CCP still intact?
        or a
        jp nz,ckov1     ;if so, go try for more memory
        ENDIF

        ld hl,stgov     ;We've used all we can...it's all over now.
        jp pstgab

ckov1:
        IF CPM
        push hl
        ld hl,NEDOOSMEMTOP;lhld bdosp   ;change curtop to reflect BDOS address now
        ld l,0          ;zero out low order byte
        shld curtop
        pop hl
        xor a           ;and tell that the CCP is now defunct
        sta ccpok
        jp ckov0
        ENDIF   


ckovok: pop de
        pop hl
        ret



;
; The following function is hairy. It forms the core hack of the BDS C
; parsing algorithm: it ldes expands and compacts text at the current
; text pointer location (DE), where A upon entry is negative to EXPAND
; by -(A), positive to squeeze by A, or zero to do nothing.
;
; This is getting documented approximately 3 1/2 years after being written.
; It's been one HELL of a WIERD three and a half years!!!!!!!!!!
;

TESTM:  EQU 0


mvtxt:  or a            ;check for zero
        ret z           ;return if so
        jp p,sqish      ;if positive, go squish

        cpl             ;otherwise negate
        inc a

        push hl         ;save registers
        push bc
        push de
        push af

        ld a,(de)
        cp 0ffh
        jp nz,mvtxt1

        pop af
        cp 1
        jp nz,mvtxt0
        pop de
        pop bc
        pop hl
        ret

mvtxt0: pop de
        pop bc
        pop hl
        inc de
        dec a
        cpl
        inc a
        call mvtxt
        dec de
        ret

        IF TESTM

        call tstriv     ;see if expansion is all into filler bytes...
        jp nz,mvtxt1    ;if not, go do standard expansion

        pop af          ;if so, we don't need to do anything,
        pop de          ;so pop registers and return.
        pop bc
        pop hl
        ret

;
; Returns Z set if there are at least (A) FF bytes at (DE). 
; Preserves DE but not necessarily A:
;

tstriv: push de         ;save text pointer
tstrv2: ld a,(de)               ;text for FF
        cp 0FFh
        jp nz,tstrv3    ;if not, trivial test fails.
        inc de          ;else bump text pointer to next char
        dec a           ;and test for completion
        jp nz,tstrv2    ;if haven't found enough, go on looking
                        ;otherwise we found enough--success!
tstrv3: pop de
        ret
        ENDIF


mvtxt1: pop af
        sta mvtmp
        jp fndff

mvtxt2: lda mvtmp
        ld h,d
        ld l,e
        dec de

mvtxt3: push af
        ld a,(de)
        ld (hl),a
        pop af
        pop bc
        push af
        ld a,c
        cp e
        jp nz,mvtxt5
        ld a,b
        cp d
        jp nz,mvtxt5
        pop af
        dec a
        jp nz,mvtxt6
        pop bc
        pop hl
        ret

mvtxt5: pop af
        push bc
        dec hl

mvtxt6: dec de
        jp mvtxt3


fndff:  ld c,a
        sta fndtmp
        ld b,7
        ld a,(de)
        or a
        jp nz,fff0
        ld a,1
        call expnd
        inc de

fff0:   ld a,(de)
        or a
        jp z,fff2
        cp 0ffh
        jp nz,fff1
fff0b:  inc de
        ld a,(de)
        cp 0ffh
        dec de  
        ld a,(de)
        jp nz,fff1
        dec c
        jp z,mvtxt2

        ld b,7
        push de
fff0a:  inc de
        jp fff0

fff1:   cp nlcd
        jp z,fff1a
        cp cr
        jp nz,fff4
fff1a:  dec de
        cp '\'
        inc de
        jp z,fff4
        dec de
        dec de
        ld a,(de)
        inc de
        inc de
        cp '\'
        jp z,fff4
        dec b
        jp nz,fff0a
        ld b,7
        inc de
        ld a,(de)
        cp 0ffh
        jp z,fff0b

fff2:   ld a,c
        add a,40
        call expnd

fff3:   dec c
        jp z,mvtxt2
        push de
        inc de
        jp fff3

fff4:   ld a,(de)
        cp swtbc
        jp nz,fff5
        inc de
        ld a,(de)
        ld l,a
        ld h,0
        add hl,hl
        add hl,hl
        inc hl
        inc hl
        inc de
        add hl,de
        ex de,hl
        jp fff0

fff5:   call cdtst
        jp c,fff6
        inc de
        inc de
        jp fff0a

fff6:   cp modbeg
        jp nz,fff0a
        ld hl,14
        add hl,de
        ex de,hl
        jp fff0

sqish:  push bc
        ld b,a
        ld a,0ffh
sqish2: ld (de),a
        inc de
        dec b
        jp nz,sqish2
        pop bc
        ret


expnd:  push hl
        push bc
        push af
        push de
        lhld eofad
        ld b,h
        ld c,l
        ld e,a
        ld d,0
        add hl,de
        push hl
        push bc
        shld eofad
        ld b,h
        ld c,l
        lhld meofad
        call max
        shld meofad
        pop bc
        pop hl
        call ckov
        pop de

expnd1: call mvbhd
        pop af
        ld b,a
        push de
expnd4: ld a,0ffh
        ld (de),a
        inc de
        dec b
        jp nz,expnd4
        pop de
        pop bc
        pop hl
        ret


;
; Routine to lde stuff from (BC) to (HL), decrementing both
; as we go, until BC passes DE -- doing it by block lde if possible
; (if runnign a Z80), or by brute force if on an 8080 or 8085.
; Clobbers BC and HL.
;

mvbhd:  lda z80f        ;z80?
        or a
        jp z,mvbhdl     ;if not, do it the long way

        push de
        push hl 
        ex de,hl
        call cmh
        add hl,bc
        inc hl
        push hl
        ld h,b
        ld l,c
        pop bc
        pop de
        db 0edh,0b8h    ;ldir instuction
        pop de
        ret


mvbhdl: ld a,(bc)               ;do it the long way
        ld (hl),a
        ld a,c
        cp e
        jp nz,mvbhd2
        ld a,b
        cp d
        ret z
mvbhd2: dec hl
        dec bc
        jp mvbhd


;
; Return Cy true if byte in A is a code byte:
;

cdtst:  cp concd
        ret c
        cp strcd+1
        ccf
        ret

;
; Purge FF's and related garbage/filler bytes from text:
;

fixt:   lhld coda       ;HL is source pointer
        ld d,h          ;DE is dest pointer
        ld e,l

fix0:   ld a,(hl)               ;end of code?
        or a
        jp nz,fix2

        ld (de),a               ;yes. handle strings.
        inc de
        inc hl
fix1:   ld a,(hl)
        cp 1ah          ;end of strings?
        jp nz,fix1a     ;if not, still doing strings.
        ld (de),a               ;yes.
        ex de,hl
        shld eofad
        ret

fix1a:  ld b,3          ;handle string storge.
        call ldb
        ld b,a
        call ldb
        jp fix1

fix2:   call cdtst      ;three byte code?
        jp c,fix4
        ld b,3
        call ldb
        jp fix0

fix4:   cp 0ffh ;garbage byte?
        jp nz,fix5
        inc hl          ;yes. skip it.
        jp fix0

fix5:   cp swtbc        ;switch statement?
        jp nz,fix8

        ld (de),a               ;yes.
        inc de
        inc hl
fix6:   ld a,(hl)
        cp 0ffh
        jp nz,fix7
        inc hl
        jp fix6
fix7:   push hl
        ld l,a
        ld h,0
        add hl,hl
        add hl,hl
        inc hl
        inc hl
        inc hl
        ld b,h
        ld c,l
        pop hl
        call mvmd
        jp fix0

fix8:   cp modbeg       ;start of module?
        jp nz,fix10
        ld b,12 ;yes. copy module name
        call ldb
        jp fix0

fix10:  ld (de),a
        inc hl
        inc de
        jp fix0


fix11:  ld hl,oshit
        call pstgab

ldb:    inc b
ldb2:   dec b
        ret z
        ld a,(hl)
        ld (de),a
        inc hl
        inc de
        jp ldb2



mvmd:   lda z80f
        or a
        jp z,mvmdl      ;if on 8080, can't use block lde
        db 0edh,0b0h    ;else can
        ret

mvmdl:  ld a,(hl)               ;do it the hard way for 8080
        ld (de),a
        inc hl
        inc de
        dec bc
        ld a,b
        or c
        jp nz,mvmd
        ret


pascd:  call igsht
        ret z
        call cdtst
        jp nc,pscd2
        xor a
        inc a
        ld a,(de)
        ret

pscd2:  inc de
        inc de
        inc de
        jp pascd


fsemi:  ld a,semi


;
; Find next occurence of the character passed in A:
;

findc:  ld b,a
findc1: ld a,(de)
        cp b
        ret z
        or a
        jp nz,finc2
        ld hl,stg10
        jp fatal

finc2:  cp nlcd
        jp nz,finc3
        call bumpnl

finc3:  inc de
        call cdtst
        jp c,finc4
        inc de
        inc de
        jp findc1

finc4:  push af
        lda eradf
        or a
        jp nz,finc5
        pop af
        jp findc1

finc5:  pop af
        cp 80h
        jp c,findc1     ;if no control keyword found, no problem
        cp 9dh
        jp nc,findc1

        cp 8fh          ;special case of a keyword allowed in
        jp z,findc1     ;an expression: sizeof

        lhld nlcnt      ;else error...probably missing semicolon
        push hl
        lhld errad
        shld nlcnt
        ld hl,stg25
        call perr
        pop hl
        shld nlcnt
        dec de
        dec de
        ld a,semi
        ld (de),a
        ret

;
; New routine that expects to see a semicolon as
; the first non-trivial item in text; else error given.
;

esemi:  call igsht
        cp semi ;next thing a semi?
        ret z           ;if so, OK-- else insert one.

insrts: lhld nlcnt      ;save real line count
        push hl
        lhld esadr      ;get fake count
        shld nlcnt
        ld hl,stg25
        call perr       ;print error
        pop hl
        shld nlcnt
        ld a,negone     ;make room for automatic semi
        call mvtxt
        ld a,semi       ;just to aid diagnosing later errors
        ld (de),a
        ret


tstty:  cp chrcd
        ret c
        cp gotcd
        ccf
        ret


;
; Return Cy false if character in A is legal anywhere in an identifier name:
;

varch:  call varch2
        ret nc
        cp '0'
        ret c
        cp '9'+1
        ccf
        ret

;
; Return Cy false if char in A is legal as FIRST char in an identifier name:
;

varch2: cp 'A'
        ret c
        cp 'Z'+1
        ccf
        ret nc
        cp 5fh
        ret z
        cp 61h
        ret c
        cp 7bh
        ccf
        ret


;
; Advance text pointer past identifier at DE:
;

pasvr:  call igsht
psvr2:  call varch
        jp nc,psvr3
        call igsht
        ret

psvr3:  inc de
        ld a,(de)
        jp psvr2


;
; Advance text pointer past parentheses at DE:

mtchp:  push hl
        call mtchp1
        pop hl
        ret

mtchp1: call igsht
        cp open
        jp z,mtchq
        ld hl,stg40
        call perr
        call fsemi
        ret

mtchq:  lhld nlcnt
        shld mtpln

mtchpa: inc de
mtchpb: call pascd
        jp nz,mtchpc
mtchpe: lhld mtpln
        shld nlcnt
        ld hl,stgbp
        jp fatal

mtchpc: cp close
        jp nz,mtp2
        push hl         ;save line count for error diagnostics
        lhld nlcnt
        shld esadr
        pop hl
        inc de
        call igsht
        ret

mtp2:   cp semi ;allow semicolons in parentheses only
        jp nz,mtp3      ;if semiok is non-zero.
        lda semiok
        or a
        jp z,mtchpe
        jp mtchpa

mtp3:   cp open
        jp nz,mtchpa
        call mtchpa
        jp mtchpb

;
; Install identifier at DE in symbol table position given in HL:
;

instt:  push de
        push de
        lhld stp
        push hl
        ld de,16
        add hl,de
        lda coda+1
        ld b,a
        ld a,h
        cp b
        jp c,instta
instt0: ld hl,stgom
        lda preflag
        or a
        jp z,fatal
        jp pstgab

instta: pop hl
        pop de
        ld c,0
inst2:  ld a,(de)
        ld (hl),a
        inc c
        inc hl
        inc de
        ld a,(de)
        call varch
        jp c,inst4
        ld a,c
        cp 8
        jp c,inst2

inst3:  inc de
        inc c
        ld a,(de)
        call varch
        jp nc,inst3

inst4:  dec hl
        ld a,(hl)
        or 80h
        ld (hl),a
        inc hl
        ld a,8
        sub c
        ld e,a
        ld d,0
        jp c,inst5
        add hl,de
inst5:  shld tempd
        pop de
        ret



cvtst:  push de
        add hl,hl
        add hl,hl
        add hl,hl
        add hl,hl
        ex de,hl
        ld hl,st
        add hl,de
        ld de,8
        add hl,de
        pop de
        ld a,(hl)
        ret

finds:  lda clev
        sta flev
        call fs
        ret nc
        xor a
        sta flev


fs:     lhld stno
        ld b,h
        ld c,l
        ld hl,st

fs2:    ld a,b
        or c
        jp nz,fs3
        scf
        ret

fs3:    push de
        push bc
        call idcmp
        jp z,fs4
        ld de,16
fs3a:   add hl,de
        pop bc
        pop de
        dec bc
        jp fs2

fs4:    dec hl
        ld a,l
        and 0f8h
        ld l,a
        ld de,9
        add hl,de
        shld inadsv
        ld a,(hl)
        and 3fh
        ld d,a
        lda flev
        cp d
        jp z,fs5
        ld de,7
        jp fs3a

fs5:    pop hl
        call cmh
        ex de,hl
        lhld stno
        add hl,de
        pop de
        xor a
        ret

initst: lhld stsiz
        ld b,h
        ld c,l
        ld hl,st
inits1: ld (hl),0
        inc hl
        dec bc
        ld a,b
        or c    
        jp nz,inits1
        ret

;
; compare the symbol table entry at HL with the text identifier 
; at DE:
;

idcmp:  push de
        push hl
        ld c,1          ;initialize char count
idcmp2: ld a,(hl)
        and 7fh         ;strip end-of-text bit from char of st entry
        ld b,a          ;put it in B.
        ld a,(de)               ;get a character from text.
        cp b            ;same?
        jp z,idcmp3     ;if so, go check rest of identifier
idcp2a: pop hl          ;else no match.
        pop de
        xor a           ;clear zero flag
        inc a           ;by incrementing from zero,
        scf             ;and also set the carry flag.
        ret

idcmp3: ld a,(hl)               ;ok, so far it matches.
        or a            ;was it the last char of the st entry?
        inc hl
        jp m,idcmp4     ;jump if it was
        inc de          ;it wasn't. bump text pointer, char count,
        inc c
        jp idcmp2       ;and go look at next charcter

idcmp4: ld a,c          ;end of symbol. if we've already seen 8 characters,
        cp 8            ;ignore rest of symbol at DE (insignificant chars)
        jp z,idcmp5     
        inc de          ;haven't seen 8 chars yet...is next char of text
        ld a,(de)               ;a legal identifier character?
        call varch
        jp nc,idcp2a    ;if so, no match.

idcp4a: xor a           ;we have a match. set Z.
        pop de
        pop de
        ret

idcmp5: inc de          ;come here to pass over superfluous chars of text
        ld a,(de)
        call varch
        jp c,idcp4a
        inc c           ;making sure to bump the char count in C as we go.
        jp idcmp5


;
; Make function name table:
;

mkfnt:  lhld stp
        shld fnts
        shld fntp
        lhld stno
        ld b,h
        ld c,l
        ld hl,st+8

mkft1:  ld a,b
        or c
        jp nz,mkft2     ;done?
        lhld fntp       ;yes. make sure we haven't overflowed   
        ex de,hl                ;the symbol table
        lhld coda
        call cmphd      ;return C if code area < end of func name table
        ret nc
        ld hl,stgom     ;list too long. complain and abort
        jp pstgab

mkft2:  ld a,(hl)
        rra
        push hl
        push bc
        call c,mkft3
        pop bc
        pop hl
        ld de,16
        add hl,de
        dec bc
        jp mkft1

mkft3:  ld de,-8
        add hl,de
        push hl
        ld h,b
        ld l,c
        call cmh
        ex de,hl
        lhld stno
        add hl,de
        ex de,hl
        lhld fntp
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        pop de

mkft4:  ld a,(de)
        ld (hl),a
        inc de
        inc hl
        or a
        jp p,mkft4
        shld fntp
        ret

mvfnt:  lhld fnts
        call cmh
        ex de,hl
        lhld fntp
        add hl,de
        shld st-2
        ld b,h
        ld c,l
        lhld fnts
        ex de,hl
        lhld stp

mvft1:  ld a,b
        or c
        jp z,mvft2
        ld a,(de)
        ld (hl),a
        inc hl
        inc de
        dec bc
        jp mvft1

mvft2:  shld fntp
        ret

;
; Perform "big expansion" of text:
; 

bexp:   ex de,hl
        call cmh
        ld b,h
        ld c,l
        lhld eofad
        push hl
        push hl
        add hl,bc
        ld b,h
        ld c,l
        pop hl
        inc bc
        add hl,de
        shld eofad
        call ckov
        pop de

bexp1:  ld a,b
        or c
        jp z,bexp2
        ld a,(de)
        ld (hl),a
        dec hl
        dec bc
        dec de
        jp bexp1

bexp2:  inc de
        ret

;
; Either write CCI file to disk (if -az given, CP/M only) or auto-load
; into CC2:
;

writf:  lhld extsa      ;put externals size word in place
        shld st-6

        ld hl,st        ;get size of symbol table in HL
        call cmh
        ex de,hl
        lhld stp
        add hl,de
        shld st-4       ;put symbol table size in place

        lhld eofad      ;now copy tokenized code down to just past the
        ld b,h          ;end of the symbol table
        ld c,l
        lhld coda
        ex de,hl
        lhld fntp
                
writ1:  ld a,(de)
        ld (hl),a
        inc hl
        inc de
        ld a,e
        cp c
        jp nz,writ1
        ld a,d
        cp b
        jp nz,writ1
        shld eofad

        IF CPM
        lda chainf
        or a
        jp nz,chain
        ENDIF

        IF NOT CPM
        jp chain
        ENDIF

        IF CPM
writ1a: ld hl,fcb+9
        ld (hl),'C'
        inc hl
        ld (hl),'C'
        inc hl
        ld (hl),'I'
        lda odisk       ;set output disk designation
        sta fcb
        call delfil
        call create     ;create output file
        lhld eofad      ;copy till end of all data
        shld cpyend

        ld hl,st-6
writ2:  call copys
        push af
        call writs
        pop af
        jp nc,writ2
        call closef     ;close the output file.
        ret
        ENDIF


chain:
        lda cc2dsk      ;get default cc2 disk
        sta cfcb        ;set as first byte of fcb

        IF NOT ALPHA
        ;lda nouser     ;don't futz with user areas?
        ;or a
        ;jp nz,chain0   ;if not, skip chandng user area

        ;lda cc2usr     ;get cc2 default user area
        ;ld e,a

        ;ld c,sguser
        ;call bdos      ;change to that user area
        ENDIF

chain0: call occ2       ;try to open in default user area and disk

        ;push af        ;save condition
        ;lda curdsk     ;switch back to current disk and user area
        ;inc a
        ;sta cfcb

        ;IF NOT ALPHA
        ;lda nouser
        ;or a
        ;jp nz,chain1

        ;lda curusr     ;change back to current user area
        ;ld e,a

        ;ld c,sguser
        ;call bdos
        ;ENDIF

;chain1:        pop af          ;get back condition of first cc2 open attempt
        jp nz,ch3               ;go read in if prior open succeeded

        call occ2       ;else try to read in current disk and user area...
        jp nz,ch3               ;if ok, go read

        jp cc2bad       ;else give up

occ2:   lhld curtop
        push hl         ;try to open cc2
        ld de,-33
        add hl,de
        push hl
        ld de,cfcb
        ld b,16
ch2:    ld a,(de)
        ld (hl),a
        inc hl  
        inc de
        dec b
        jp nz,ch2
        pop de
        ld c,openfil
        call bdos       ;try to open cc2.com
        pop hl
        dec hl
        ld (hl),0               ;clear nr field of CC2 fcb
        cp 255          ;cc2 on disk?
        ret

cc2bad: ld hl,stgcce    ;nope. complain and write out cci file

        call pstg
        jp writ1a

ch3:    
        call ldef       ;lde schlameel to high ram
        ld hl,tbuff     ;lde bootstrap to tbuff (== just 80h under MARC)
        ld de,bootcode
        ld b,bootlen
ch4:    ld a,(de)
        ld (hl),a
        inc hl
        inc de
        dec b
        jp nz,ch4

;
; Now set up stack at ram area, and push all data that will have to
; be popped back into cc2. The order of pushing, and resulting address
; in cc2, are as follows:
;
;       no.     item    address in cc2
;       ---     ----    --------------
;       0        kflg    110h
;       1       odisk   5fh             (CP/M only)
;       2       optimf  104h
;       3       loadad  105h-106h
;       4       eflag   109h
;       5       exaddr  107h-108h
;       6       curtop  10ch-10dh
;       7       ccpok   10eh            (ccpok: b0, oktort: b1, wboote b2,
;                                               zenvf: b3)
;               maxmd   10eh            (MARC only)
;       8       spsav   10ah-10bh       (CP/M only)
;               fnam    10ah-10bh       (MARC only)
;       9       erasub  10fh            (CP/M only)
;       10      defsub/ 111h-112h       (CP/M only)
;               conpol
;       11      errbyt  113h-114h       (CP/M only)
;       
; The bootstrap pops these in the reverse order, or course, and sets
; them up in the newly-loaded in cc2.com file.
;

        ld sp,tpa
        lda kflg        ;save CDB flag
        push af
        lda odisk       ;save output disk flag
        push af
        lda optim       ;save optimization flag
        push af
        lhld loadad     ;save load address
        push hl
        lda eflag       ;save external addr given flag
        push af
        lhld exaddr     ;save external address if given
        push hl
        lhld curtop     ;save current top of memory
        push hl

        IF CPM
        lda ccpok       ;save CCP intact flag
        or a
        jp z,bt000
        ld a,1          ;set b0 to ccpok
bt000:  ld b,a          ;save in B

        lda oktort      ;get oktoret flag
        add a           ;put bit in b1 position
        add b           ;accumulate
        ld b,a          ;save it

        lda wboote      ;set b2 to wboote
        or a
        jp z,bt001
        ld a,4          ;if true, make b2 hi
bt001:  add b

        lda zenvf
        or a
        jp z,bt002
        ld a,8          ;set b3
bt002:  add b

        push af ;save combination of (b0 b1 b2 b3)

        ;lhld spsav     ;save CCP's stack pointer
        ;push hl

        lda werrs       ;if werrs false, just push erasub
        or a
        lda erasub
        jp z,setbt1
        or 2            ;if werrs true, but b1 high on erasub
        
setbt1: push af
        lhld defsub     ;save defsub/conpol bytes
        push hl
        lhld errbyt     ;get ZCPR3 error byte address
        push hl

        lhld curtop     ;put fcb address of cc2 fcb in BC
        ld de,-33
        add hl,de
        ld b,h
        ld c,l
        ENDIF

        jp tbuff        ;go do it

;
; This is the bootstrap that will run down at tbuff:
;

bootcode:
        IF CPM          ;first the CP/M version...
        ld de,tpa       ;(cp/m only code is: 35 bytes)
        push de         ;save memory load address pointer
        push bc         ;save cc2's fcb address
        ld c,sdma       ;set DMA address to current memory load address (DE)
        call bdos
        pop de          ;pop cc2's fcb address into DE
        push de         ;and push back on stack for later
        ld c,rsequen    ;read a sector
        call bdos
        or a
        pop bc          ;pop cc2's fcb address into BC
        pop de          ;pop memory load address
        jp nz,postld    ;if done, go finish up
        ld hl,80h       ;otherwise add 80h to memory load address
        add hl,de
        ex de,hl                ;and put it back in DE
        jp tbuff+3
        ENDIF

;
; pop stuff off stack for CC2:
;

postld:  equ tbuff + $ - bootcode
        IF CPM
        pop hl          ;get back wboote flag + extra byte
        shld ram+113h
        pop hl          ;get back defsub and conpol bytes
        shld ram+111h
        pop af          ;get back erasing submit files flag
        sta ram+10fh
        ENDIF

        ;pop hl         ;pop filename under MARC or saved SP under CP/M
        ;shld ram+010ah 

        pop af          ;pop ccpok/maxmd flag
        sta ram+010eh

        pop hl          ;pop current top of memory address
        shld ram+010ch

        pop hl          ;pop external variables address
        shld ram+0107h
        pop af          ;pop external address flag
        sta ram+0109h

        pop hl          ;pop load address
        shld ram+0105h
        pop af          ;pop optimization flag
        sta ram+0104h
        pop af          ;pop output disk designation flag

        IF CPM
        sta fcb         ;set output disk designation
        ENDIF

        pop af          ;pop CDB flag
        sta ram+110h

        ld a,1
        sta ram+103h    ;set chained-to flag
        jp tpa          ;and go execute

bootlen: equ $-bootcode ;length of bootstrap

;
; (end of bootstrap)
;




ldef:   ld de,-(st-6)
        lhld eofad
        add hl,de               
        inc hl
        ex de,hl                ;DE = length of text
        lhld curtop
        ld bc,-36
        add hl,bc
        ld b,h
        ld c,l          ;BC = destination
        push bc         ;save for later
        lhld eofad      ;HL = source
ldef1:  ld a,(hl)
        ld (bc),a
        dec bc
        dec hl
        dec de
        ld a,d
        or e
        jp nz,ldef1
        pop hl          ;get addr of where start addr goes
        inc hl          ;now HL = BDOS - 35
        ld (hl),c
        inc hl          ;and BDOS - 34
        ld (hl),b
        ret             ;and all done!


        IF LASM
        link ccc
        ENDIF