?login_element?

Subversion Repositories NedoOS

Rev

Rev 632 | Blame | Compare with Previous | Last modification | View Log | Download

  1. ;
  2. ; CCB.ASM: Second main source file of CC.ASM
  3. ;
  4. ;       Miscellaneious utility routines,
  5. ;
  6.  
  7.  
  8. ;
  9. ; Delete a file:
  10. ;
  11.  
  12.         IF CPM
  13. delfil:
  14.         ld de,fcb
  15. delf2:
  16.         push hl
  17.         push de
  18.         ld hl,12
  19.         add hl,de
  20.         ld (hl),0
  21.         ld c,delete
  22.         call bdos
  23.         pop de
  24.         pop hl
  25.         ret
  26.         ENDIF
  27.  
  28. ;
  29. ; Create a new file:
  30. ;
  31. create:
  32.         IF CPM
  33.         ld de,fcb
  34. create2:
  35.         push hl
  36.         push de
  37.         ld hl,12        ;clear extent byte
  38.         add hl,de
  39.         ld (hl),0
  40.         ld c,makfil
  41.         call bdos
  42.         pop de
  43.         ld hl,32
  44.         add hl,de
  45.         ld (hl),0
  46.         pop hl
  47.         cp 255
  48.         ret nz
  49.         ENDIF
  50.  
  51.         jp openo3
  52.  
  53. ;
  54. ; Open a file for output:
  55. ;
  56. openo:  ld de,fcb
  57. openo2: call openg
  58.         ret nz
  59.  
  60. openo3: ld hl,stg3
  61.         jp pstgab
  62.  
  63.         IF CPM
  64. openg:  push hl
  65.         push de
  66.         push de         ;save fcb pointer
  67.         ld c,openfil
  68.         call bdos
  69.         pop de          ;clear nr byte
  70.         ld hl,32
  71.         add hl,de
  72.         ld (hl),0
  73.         cp 0ffh ;return Z set on error
  74.         pop de
  75.         pop hl
  76.         ret
  77.         ENDIF
  78.  
  79.  
  80. ;
  81. ; Close a file:
  82. ;
  83. closef: ld de,fcb
  84. close2:
  85.         IF CPM
  86.         push hl
  87.         ld c,closefil
  88.         call bdos
  89.         pop hl
  90.         cp 255
  91.         ret nz
  92.         ld hl,stg2
  93.         jp pstgab
  94.         ENDIF
  95.  
  96.  
  97. ;
  98. ; Write a sector of a file out to disk:
  99. ;
  100.  
  101.         IF CPM
  102. writs:  ld de,fcb
  103. writs2: push hl
  104.         ld c,wsequen
  105.         call bdos
  106.         pop hl
  107.         or a
  108.         ret z
  109.         ld hl,stg3
  110.         jp pstgab
  111.  
  112. ;
  113. ; Copy 128 bytes from mem at (HL) to tbuff (80h), pad last sector
  114. ; with ^Z's if CPYEND reached and return Cy set if so:
  115. ;
  116.  
  117.  
  118. copys:  ld de,tbuff
  119.         ld b,80h
  120.  
  121. copy1:  ld a,(hl)
  122.         ld (de),a
  123.         push de
  124.         ex de,hl
  125.         lhld cpyend
  126.         ld a,h
  127.         cp d
  128.         jp nz,copy2
  129.         ld a,l
  130.         cp e
  131.         jp z,copy5
  132.  
  133. copy2:  ex de,hl
  134.         pop de
  135.         inc hl
  136.         inc de
  137.         dec b
  138.         jp nz,copy1
  139.         xor a
  140.         ret
  141.  
  142. copy5:  pop de
  143. copy6:  dec b
  144.         jp z,copy7
  145.         ld a,1ah
  146.         ld (de),a
  147.         inc de
  148.         jp copy6
  149.  
  150. copy7:  scf
  151.         ret
  152.         ENDIF           ;end of CP/M-dependent file I/O
  153.  
  154.  
  155. ;
  156. ; Bump line count:
  157. ;
  158.  
  159. bumpnl: push hl
  160.         lhld nlcnt
  161.         inc hl
  162.         shld nlcnt
  163.         pop hl
  164.         ret
  165.  
  166.  
  167. ;
  168. ; print out file name in default fcb:
  169. ;
  170.  
  171. pfnam:  push de
  172.         ld de,fcb
  173.         call pfnam2
  174.         pop de
  175.         ret
  176.  
  177. ;
  178. ; Print out filename of fcb at DE:
  179. ;
  180.  
  181.  
  182. pfnam2: push de
  183.         push hl
  184.         push bc
  185.         ld a,(de)               ;get disk code
  186.         or a
  187.         jp z,pfnm3      ;if file on currently logged disk, don't print
  188.                         ;disk designator.
  189.  
  190. ;       ld c,gdisk      ;This section of code commented out to keep
  191. ;       push de         ;files on the currently logged drive from having
  192. ;       call bdos       ;a disk designator printed before their names.
  193. ;       pop de          ;uncomment the code to put this feature back
  194. ;       inc a           ;into action.
  195.  
  196. pfnm2:  add a,'@'               ;get A = 'A' for drive A, 'B' for B, etc.
  197.         call outch
  198.         ld a,':'
  199.         call outch
  200. pfnm3:  inc de
  201.         ld b,8
  202.         call pnseg
  203.         ld a,(de)
  204.         cp ' '
  205.         ld a,'.'        ;print dot only if filename has extension
  206.         call nz,outch
  207.         ld b,3
  208.         call pnseg
  209.         pop bc
  210.         pop hl
  211.         pop de
  212.         ret
  213.  
  214. pnseg:  ld a,(de)
  215.         cp ' '
  216.         call nz,outch
  217.         inc de
  218.         dec b
  219.         jp nz,pnseg
  220.         ret
  221.  
  222. ;
  223. ; Print out the value in HL in hex, followed by a colon
  224. ; and a space.
  225. ; Upon entry, A non-0: print no leading spaces
  226. ;              A == 0: print leading spaces making total textual output 4 chars
  227. ;
  228. ;
  229.  
  230. prhcs:  push af
  231.         push de
  232.         call prh        ;convert HL to ascii at ascb
  233.         pop de
  234.         pop af
  235.         or a
  236.         ld hl,ascb
  237.         jp z,prhcs3     ;if printing leading spaces, go do it
  238.         dec hl
  239. prhcs1: inc hl
  240.         ld a,(hl)
  241.         cp ' '
  242.         jp z,prhcs1     ;if all four digits, no leading spaces needed
  243.  
  244. prhcs3: call pstg
  245.         ret
  246.  
  247. ;
  248. ; Print A in ASCII followed by a slash
  249. ;
  250.  
  251. prads:  and 1fh         ;max 31
  252.         call pra
  253.         ld a,'/'
  254.         call outch
  255.         ret
  256.  
  257. pra:    cp 10           ;single digit?
  258.         jp nc,pra2      ;if not, go handle double digits
  259. pra0:   add a,'0'               ;print single digit in A
  260. pra1:   call outch
  261.         ret
  262. pra2:   ld b,0          ;calculate 10's digit
  263. pra3:   inc b
  264.         sub 10
  265.         cp 10
  266.         jp nc,pra3
  267.         push af
  268.         ld a,b
  269.         call pra0       ;print tens digit
  270.         pop af
  271.         jp pra0
  272.  
  273. ;
  274. ; Convert value in HL into ASCII at ascb, ascb+1, ascb+2, ascb+3:
  275. ;
  276.  
  277. prh:    push hl
  278.         ld hl,'  '
  279.         shld ascb
  280.         ld hl,' 0'      ;mac doc. is wrong about this!
  281.         shld ascb+2
  282.         pop hl
  283.         inc hl
  284.  
  285. prh0:   ld a,h
  286.         or l
  287.         ret z
  288.         dec hl
  289.         push hl
  290.         ld hl,ascb+3
  291.  
  292. prh1:   ld a,(hl)
  293.         cp ' '
  294.         jp nz,prh2
  295.         ld a,'0'
  296.  
  297. prh2:   inc a
  298.         cp '9'+1
  299.         jp z,prh4
  300.  
  301. prh3:   ld (hl),a
  302.         pop hl
  303.         jp prh0
  304.  
  305. prh4:   ld (hl),'0'
  306.         dec hl
  307.         jp prh1
  308.  
  309.  
  310. ;
  311. ; 2's complement HL:
  312. ;
  313.  
  314. cmh:    push af
  315.         ld a,h
  316.         cpl
  317.         ld h,a
  318.         ld a,l
  319.         cpl
  320.         ld l,a
  321.         inc hl
  322.         pop af
  323.         ret
  324.  
  325.  
  326. ;
  327. ; "Ignore stuff" routine; pass by newlines, white space,
  328. ; module start and end bookkeeping, and keep the lines count
  329. ; (stored in nlcnt) for error reporting:
  330. ;
  331.  
  332. igsht:  ld a,(de)
  333.         cp modbeg       ;begin nested module?
  334.         jp nz,igsh0
  335.  
  336.         inc de
  337.         call pushmn     ;push on modstk, process line number stuff
  338.         jp igsht
  339.  
  340. igsh0:  cp modend
  341.         jp nz,igsh1     ;include file end?
  342.         call popmn      ;restore line number and pop filename off modstk
  343.         jp igsh1a
  344.  
  345. igsh1:  cp 0ffh
  346.         jp nz,igsh2
  347.  
  348. igsh1a: inc de
  349.         jp igsht
  350.  
  351. igsh2:  cp nlcd
  352.         jp nz,igsh3
  353.         call bumpnl
  354.         inc de
  355.         jp igsht
  356.  
  357. igsh3:  or a
  358.         ret
  359.  
  360. ;
  361. ; Push filename at DE onto modstk, save current line number after it,
  362. ; bump modstc, and reset nlcnt:
  363. ;
  364.  
  365. pushmn: push hl         ;save HL
  366.         ld hl,modstc    ;bump modstc
  367.         inc (hl)
  368.         ld a,(hl)
  369.         cp 6
  370.         ld hl,stgine
  371.         call nc,perrab         
  372.  
  373.         lhld modstp     ;get next mod stack entry slot address
  374.         ld b,12
  375.         call ldrc       ;push new module name onto modstk
  376.         push de         ;save text ptr
  377.         ex de,hl
  378.         lhld nlcnt      ;get line count
  379.         ex de,hl                ;line count in DE, modstk ptr in HL
  380.         ld (hl),e
  381.         inc hl
  382.         ld (hl),d
  383.         inc hl
  384.         shld modstp
  385.         ld hl,0
  386.         shld nlcnt      ;clear nlcnt for new module
  387.         pop de          ;restore text pointer
  388.         pop hl          ;restore HL
  389.         ret    
  390.  
  391. ;
  392. ; Pop modstk entry:
  393. ;
  394.  
  395. popmn:  push hl         ;save registers
  396.         push de
  397.         lhld modstp
  398.         dec hl
  399.         ld d,(hl)
  400.         dec hl
  401.         ld e,(hl)               ;DE holds old nlcnt
  402.         ex de,hl
  403.         shld nlcnt      ;restore line count
  404.         ld hl,-12
  405.         add hl,de               ;roll modstk pointer back to start of current level
  406.         shld modstp     ;save modstk pointer
  407.         ld hl,modstc    ;debump module count
  408.         dec (hl)
  409.         pop de
  410.         pop hl
  411.         ret
  412.  
  413. ldrc:   ld a,(de)
  414.         ld (hl),a
  415.         inc hl
  416.         inc de
  417.         dec b
  418.         jp nz,ldrc
  419.         ret
  420.  
  421. ;
  422. ; General purpose ram lde routine.
  423. ; B = byte count
  424. ; C controls direction of lde:
  425. ;       0: DE->HL, 1: HL->DE
  426. ;
  427.  
  428. ldram:  ld a,c
  429.         or a
  430.         jp z,ldr2
  431.         ex de,hl
  432. ldr2:   ld a,(de)
  433.         ld (hl),a
  434.         inc hl
  435.         inc de
  436.         dec b
  437.         jp nz,ldr2
  438.         ld a,c
  439.         or a
  440.         jp z,ldr3
  441.         ex de,hl
  442. ldr3:   push de         ;make sure we don't overflow stack area
  443.         push hl
  444.         lhld coda
  445.         ex de,hl                ;put code area addr in DE
  446.         pop hl          ;and current include stack pointer in HL
  447.         call cmphd
  448.         pop de          ;restore sp
  449.         ret c           ;if OK, return
  450.         ld hl,stgine    ;include error
  451.         jp pstgab       ;print message and quit
  452.  
  453. ;
  454. ; Map alphabetic character in A to upper case:
  455. ;
  456.  
  457. mapuc:  cp 61h
  458.         ret c
  459.         cp 7bh
  460.         ret nc
  461.         sub 20h
  462.         ret
  463.  
  464. ;
  465. ; Special version of mapuc,  which supresses mapping if "mapucv" is true
  466. ;
  467.  
  468. mapuc0: push bc         ;save B
  469.         ld b,a          ;save char to map in B
  470.         lda mapucv      ;get control var
  471.         or a            ;do we do a mapping?
  472.         ld a,b          ;get back char to map in A
  473.         call z,mapuc    ;if we do a mapping, go do it
  474.         pop bc          ;restore B
  475.         ret             ;all done
  476.  
  477.        
  478. ;
  479. ; Print out line number, error message in HL, and set errf so
  480. ; we don't auto-load cc2:
  481. ;
  482.  
  483. perr:   push af
  484.         call pwarn
  485.         ld a,1
  486.         sta errf
  487.         pop af
  488.         ret
  489.  
  490. ;
  491. ; Print out line number, error message in HL, but don't touch
  492. ; errf:
  493. ;
  494.  
  495. pwarn:  push hl
  496.         call pmodnc     ;print module name
  497. perr2:  lhld nlcnt
  498.         call prhcs      ;print line number of error
  499.         pop hl
  500.         call pstg
  501.         ret
  502.  
  503. ;
  504. ; Print module name, colon, space:
  505. ;
  506.  
  507. pmodnc: call pmodnm
  508.         push af
  509.         ld a,':'
  510.         call outch
  511.         ld a,' '
  512.         call outch
  513.         pop af
  514.         ret
  515.  
  516.  
  517. ;
  518. ; Print out module name:
  519. ;
  520.  
  521. pmodnm: push hl
  522.         push de
  523.         lhld modstp
  524.         ld de,-14
  525.         add hl,de
  526.         ex de,hl       
  527.         call pfnam2
  528.         pop de
  529.         pop hl
  530.         ret
  531.  
  532.  
  533. ;
  534. ; Print out string pointed to by HL, with + character shorthand
  535. ; for a CR-LF:
  536. ;
  537.  
  538. pstg:   ld a,(hl)
  539.         or a
  540.         ret z
  541.         cp '+'
  542.         jp z,crlf
  543.         call outch
  544.         inc hl
  545.         jp pstg
  546.  
  547. ;
  548. ; Print strig to console only:
  549. ;
  550.  
  551. pstgco: lda werrs
  552.         push af
  553.         xor a
  554.         sta werrs
  555.         call pstg
  556.         pop af
  557.         sta werrs
  558.         ret
  559.  
  560. ;
  561. ; Output a character of text to the console and/or PROGERRS.$$$ file:
  562. ;
  563.  
  564. outch:  push de
  565.         push bc
  566.         push hl
  567.         push af
  568.  
  569.         if 1==1
  570.         ;exx
  571.         ;push bc
  572.         ;push de
  573.         ;push hl
  574.         ;push ix
  575.         ;push iy
  576.         PRCHAR_
  577.         ;pop iy
  578.         ;pop ix
  579.         ;pop hl
  580.         ;pop de
  581.         ;pop bc
  582.         ;exx
  583.         else
  584.         ld e,a
  585.         lda werrs
  586.         or a            ;if not writing errs to PROGERRS file,
  587.         jp z,outch3     ;       go write to console
  588.        
  589.         lda nomore      ;if done writing RED errors, just go to console
  590.         or a
  591.         jp nz,outch3
  592.  
  593.         lda errsin
  594.         or a
  595.         jp nz,outch1    ;if RED buffer initialized, go handle I/O
  596.                         ;else initialize RED buffer:
  597.         inc a
  598.         sta errsin
  599.  
  600.         push de
  601.         ld de,redfcb
  602.         lda odisk
  603.         ld (de),a
  604.         call delf2      ;delete previous PROGERRS.$$$
  605.         call create2    ;create new one
  606. ;       call openo2     ;open for output
  607.         ld hl,redbuf
  608.         shld redbp      ;initialize redbuf sector pointer
  609.  
  610.         ld hl,stgeri    ;"RED error output initiated"
  611.         call pstgco     ;print text to console only
  612.         pop de
  613.  
  614. outch1: call redout     ;write char to red output file
  615.  
  616. outch3: ld c,conout
  617.         call bdos
  618.         endif
  619.        
  620.         pop af
  621.         pop hl
  622.         pop bc
  623.         pop de
  624.         ret
  625.  
  626. ; Write a character to RED output buffer, flushing if needed:
  627.  
  628. redout: lhld redbp      ;get redbuf pointer
  629.         ld (hl),e               ;store char
  630.         inc hl          ;bump pointer
  631.         shld redbp      ;save pointer
  632.         ld a,l          ;past end of buffer?
  633.         cp (redbuf+128) and 0ffh
  634.         ret nz          ;if not, return
  635.  
  636.  
  637.  
  638. redwrt: push de
  639.         ld de,redbuf    ;set DMA address to redbuf for sector write
  640.         ld c,sdma
  641.         call bdos
  642.  
  643.         ld de,redfcb
  644.         call writs2     ;write sector
  645.  
  646.         ld de,tbuff     ;set DMA address back for normal file i/o
  647.         ld c,sdma
  648.         call bdos
  649.  
  650.         ld hl,redbuf
  651.         shld redbp     
  652.         pop de
  653.         ret
  654.  
  655.  
  656. ;
  657. ; print "undeclared variable: " and print out the
  658. ; variable name being pointed to by DE:
  659. ;
  660.  
  661. bvarm:  ld hl,stg14
  662. bvarm2: call perr
  663.         push de
  664.         call pvarn      ;print out the name
  665.         pop de
  666.         call crlf
  667.         ret
  668.  
  669. ;
  670. ; print out the variable name pointed to by DE:
  671. ;
  672.  
  673. pvarn:  ld a,(de)
  674.         call varch
  675.         ret c
  676.         call outch
  677.         inc de
  678.         jp pvarn
  679.  
  680. ;
  681. ; Print error message in HL and abort:
  682. ;
  683.  
  684. pstgab:
  685. pstgb2: call pstg
  686.         jp errab
  687.  
  688. ;
  689. ; Print error msg in HL with line number, and abort:
  690. ;
  691.  
  692. perrab: call perr
  693.  
  694. ;
  695. ; Come here to abort, when fatal error has been diagnosed:
  696. ;
  697.  
  698. errab:  lhld errbyt     ;set error byte flag for ZCPR3
  699.         ld (hl),0ffh
  700.  
  701.         call errwrp     ;wrap up any RED file activity
  702.  
  703. errab2: ld a,7          ;ring a bell for errors having occurred
  704.         call outch
  705.         lda erasub      ;bother to erase submit files?
  706.         or a
  707.         jp z,exit
  708.  
  709.         ;ld e,0         ;go to user 0 for submit file erasure
  710.         ;ld c,sguser
  711.  
  712.         IF NOT ALPHA
  713.         ;lda nouser
  714.         ;or a
  715.         ;jp nz,errab3   ;if no user areas, don't do it
  716.  
  717.         ;lda zenvf      ;if not ZSYSTEMS, don't do it
  718.         ;or a
  719.         ;call nz,bdos
  720. ;errab3:
  721.         ENDIF
  722.  
  723.         ld de,subfile   ;erase pending submit files and abort
  724.         call delf2
  725.  
  726. exit:   ;call resetu    ;reset to original user drive/ user area
  727.         QUIT
  728.         ;lda wboote     ;need to perform warm-boot?
  729.         ;or a
  730.         ;jp nz,ram              ;if so, go do it.
  731.         ;lhld spsav     ;get (possibly valid) saved stack pointer
  732.         ;ld sp,hl               ;put into SP
  733.         ;lda ccpok      ;CCP intact?
  734.         ;or a
  735.         ;ret nz         ;if so, return to CCP
  736.         ;jp ram         ;otherwise do a warm boot
  737.  
  738. ;resetu:        ;lda origdsk    ;reset disk and user area to original
  739.         ;ld e,a
  740.         ;ld c,select
  741.         ;call bdos
  742.         ;lda origusr
  743.         ;ld e,a
  744.         ;ld c,sguser
  745.  
  746.         ;IF NOT ALPHA
  747.         ;lda nouser
  748.         ;or a
  749.         ;call z,bdos   
  750.         ;ENDIF
  751.  
  752.         ;ret
  753.  
  754.  
  755.  
  756. ;
  757. ; Print a newline to the console:
  758. ;
  759.  
  760. crlf:   push af
  761.  
  762.         IF CPM
  763.         ld a,cr
  764.         call outch
  765.         ENDIF
  766.  
  767.         ld a,lf
  768.         call outch
  769.         pop af
  770.         ret
  771.  
  772. ;
  773. ; Check for abortion:
  774. ;TODO
  775.  
  776. ckabrt:
  777.         push hl
  778.         push de
  779.         push bc
  780.         push af
  781.  
  782.         ;lda conpol     ;are we polling the console?
  783.         ;or a
  784.         ;jp z,nohit     ;if not, don't do anything
  785.  
  786.         ;ld c,intcon    ;interrogate console status
  787.         ;call bdos
  788.         ;or a
  789.         ;jp z,nohit
  790.         ;ld c,coninp
  791.         ;call bdos      ;if something hit, see if a ^C
  792.         ;cp 3
  793.         ;jp z,intrpt   
  794. nohit:  pop af          ;if not, don't interrupt
  795.         pop bc
  796.         pop de
  797.         pop hl
  798.         ret
  799.  
  800. intrpt: ld hl,stgabo    ; and abort.
  801.         jp pstgab
  802.        
  803. ;
  804. ; Check for stack overflow:
  805. ;
  806.  
  807. chkstk: push hl
  808.         push de
  809.         push bc
  810.         push af
  811.         lhld stkchk
  812.         ld de,0a55ah
  813.         call cmphd      ;make sure stack check word is still intact
  814.         jp z,nohit      ;if so, no problem
  815.         ld hl,stgstk    ;else spew stack overflow message
  816.         jp perrab
  817.  
  818.  
  819. ;
  820. ; Squeeze the symbol table by chopping out the name portion of every entry
  821. ; (reducing the st size by half, since each entry up to now has been
  822. ; 8 chars of name and 8 bytes of attributes):
  823. ;
  824.  
  825. chopst: lhld stno
  826.         ld b,h
  827.         ld c,l          ;BC = symbol entry count
  828.         ld hl,st
  829.         ld de,st
  830.  
  831. sqst2:  ld a,b
  832.         or c
  833.         jp nz,sqst3
  834.         shld stp
  835.         ret
  836.  
  837. sqst3:  push hl
  838.         ld hl,8
  839.         add hl,de
  840.         ex de,hl
  841.         pop hl
  842.  
  843. sqst4:  ld a,(de)
  844.         ld (hl),a
  845.         inc de
  846.         inc hl
  847.         ld a,l
  848.         and 7
  849.         jp nz,sqst4
  850.         dec bc
  851.         jp sqst2
  852.  
  853. ;
  854. ; Write out special CCI-symbol-table file for Kirkland's debugger if "-w"
  855. ; option given...write out stno entries from symbol table at st, each
  856. ; 16 bytes long. Call the file <name>.CDB ... this is gonna be a neat hack!
  857. ;
  858.  
  859. wst4db: lda kflg        ;was -w even given?
  860.         or a            ;if not, return
  861.         ret z
  862.  
  863.         ld hl,st        ;get size of symbol table in HL
  864.         call cmh
  865.         ex de,hl
  866.         lhld stp        ;get symbol table next free slot pointer
  867.         shld cpyend     ;this is where we'll stop writing to the output file.
  868.         add hl,de
  869.         shld st-2       ;put symbol table size in place
  870.  
  871.         IF CPM
  872.         ld hl,fcb+9
  873.         ld (hl),'C'
  874.         inc hl
  875.         ld (hl),'D'
  876.         inc hl
  877.         ld (hl),'B'
  878.         lda odisk       ;set output disk designation
  879.         sta fcb
  880.         call delfil     ;delete old versions
  881.         call create     ;create output file
  882. ;       call openo      ;and open it for output
  883.  
  884.         ld hl,st-2
  885. wstdb2: call copys
  886.         push af
  887.         call writs
  888.         pop af
  889.         jp nc,wstdb2
  890.         call closef     ;close the output file.
  891.         ENDIF
  892.  
  893.         ret
  894.  
  895.  
  896. ;
  897. ; Little general purpose utility to compare HL and DE,
  898. ; and return C set if HL < DE
  899. ;
  900.  
  901. cmphd:  ld a,h
  902.         cp d
  903.         ret nz
  904.         ld a,l
  905.         cp e
  906.         ret
  907.  
  908.  
  909. ;
  910. ; Routine to make sure we haven't overflowed available memory space. At
  911. ; first, we try to use memory below the command processor (under both
  912. ; CP/M and MARC). If we run out of room, we either punt the CCP under
  913. ; CP/M or do the maxmem call under MARC to get more memory.
  914. ;
  915.  
  916. ckov:   push hl
  917.         push de
  918. ckov0:  lda curtop+1    ;high order byte of top of mem addr
  919.         dec a
  920.         ld d,a
  921.         ld a,h
  922.         cp d
  923.         jp c,ckovok     ;overflow?
  924.  
  925.         IF CPM
  926.         lda ccpok       ;under CP/M, is the CCP still intact?
  927.         or a
  928.         jp nz,ckov1     ;if so, go try for more memory
  929.         ENDIF
  930.  
  931.         ld hl,stgov     ;We've used all we can...it's all over now.
  932.         jp pstgab
  933.  
  934. ckov1:
  935.         IF CPM
  936.         push hl
  937.         ld hl,NEDOOSMEMTOP;lhld bdosp   ;change curtop to reflect BDOS address now
  938.         ld l,0          ;zero out low order byte
  939.         shld curtop
  940.         pop hl
  941.         xor a           ;and tell that the CCP is now defunct
  942.         sta ccpok
  943.         jp ckov0
  944.         ENDIF  
  945.  
  946.  
  947. ckovok: pop de
  948.         pop hl
  949.         ret
  950.  
  951.  
  952.  
  953. ;
  954. ; The following function is hairy. It forms the core hack of the BDS C
  955. ; parsing algorithm: it ldes expands and compacts text at the current
  956. ; text pointer location (DE), where A upon entry is negative to EXPAND
  957. ; by -(A), positive to squeeze by A, or zero to do nothing.
  958. ;
  959. ; This is getting documented approximately 3 1/2 years after being written.
  960. ; It's been one HELL of a WIERD three and a half years!!!!!!!!!!
  961. ;
  962.  
  963. TESTM:  EQU 0
  964.  
  965.  
  966. mvtxt:  or a            ;check for zero
  967.         ret z           ;return if so
  968.         jp p,sqish      ;if positive, go squish
  969.  
  970.         cpl             ;otherwise negate
  971.         inc a
  972.  
  973.         push hl         ;save registers
  974.         push bc
  975.         push de
  976.         push af
  977.  
  978.         ld a,(de)
  979.         cp 0ffh
  980.         jp nz,mvtxt1
  981.  
  982.         pop af
  983.         cp 1
  984.         jp nz,mvtxt0
  985.         pop de
  986.         pop bc
  987.         pop hl
  988.         ret
  989.  
  990. mvtxt0: pop de
  991.         pop bc
  992.         pop hl
  993.         inc de
  994.         dec a
  995.         cpl
  996.         inc a
  997.         call mvtxt
  998.         dec de
  999.         ret
  1000.  
  1001.         IF TESTM
  1002.  
  1003.         call tstriv     ;see if expansion is all into filler bytes...
  1004.         jp nz,mvtxt1    ;if not, go do standard expansion
  1005.  
  1006.         pop af          ;if so, we don't need to do anything,
  1007.         pop de          ;so pop registers and return.
  1008.         pop bc
  1009.         pop hl
  1010.         ret
  1011.  
  1012. ;
  1013. ; Returns Z set if there are at least (A) FF bytes at (DE).
  1014. ; Preserves DE but not necessarily A:
  1015. ;
  1016.  
  1017. tstriv: push de         ;save text pointer
  1018. tstrv2: ld a,(de)               ;text for FF
  1019.         cp 0FFh
  1020.         jp nz,tstrv3    ;if not, trivial test fails.
  1021.         inc de          ;else bump text pointer to next char
  1022.         dec a           ;and test for completion
  1023.         jp nz,tstrv2    ;if haven't found enough, go on looking
  1024.                         ;otherwise we found enough--success!
  1025. tstrv3: pop de
  1026.         ret
  1027.         ENDIF
  1028.  
  1029.  
  1030. mvtxt1: pop af
  1031.         sta mvtmp
  1032.         jp fndff
  1033.  
  1034. mvtxt2: lda mvtmp
  1035.         ld h,d
  1036.         ld l,e
  1037.         dec de
  1038.  
  1039. mvtxt3: push af
  1040.         ld a,(de)
  1041.         ld (hl),a
  1042.         pop af
  1043.         pop bc
  1044.         push af
  1045.         ld a,c
  1046.         cp e
  1047.         jp nz,mvtxt5
  1048.         ld a,b
  1049.         cp d
  1050.         jp nz,mvtxt5
  1051.         pop af
  1052.         dec a
  1053.         jp nz,mvtxt6
  1054.         pop bc
  1055.         pop hl
  1056.         ret
  1057.  
  1058. mvtxt5: pop af
  1059.         push bc
  1060.         dec hl
  1061.  
  1062. mvtxt6: dec de
  1063.         jp mvtxt3
  1064.  
  1065.  
  1066. fndff:  ld c,a
  1067.         sta fndtmp
  1068.         ld b,7
  1069.         ld a,(de)
  1070.         or a
  1071.         jp nz,fff0
  1072.         ld a,1
  1073.         call expnd
  1074.         inc de
  1075.  
  1076. fff0:   ld a,(de)
  1077.         or a
  1078.         jp z,fff2
  1079.         cp 0ffh
  1080.         jp nz,fff1
  1081. fff0b:  inc de
  1082.         ld a,(de)
  1083.         cp 0ffh
  1084.         dec de 
  1085.         ld a,(de)
  1086.         jp nz,fff1
  1087.         dec c
  1088.         jp z,mvtxt2
  1089.  
  1090.         ld b,7
  1091.         push de
  1092. fff0a:  inc de
  1093.         jp fff0
  1094.  
  1095. fff1:   cp nlcd
  1096.         jp z,fff1a
  1097.         cp cr
  1098.         jp nz,fff4
  1099. fff1a:  dec de
  1100.         cp '\'
  1101.         inc de
  1102.         jp z,fff4
  1103.         dec de
  1104.         dec de
  1105.         ld a,(de)
  1106.         inc de
  1107.         inc de
  1108.         cp '\'
  1109.         jp z,fff4
  1110.         dec b
  1111.         jp nz,fff0a
  1112.         ld b,7
  1113.         inc de
  1114.         ld a,(de)
  1115.         cp 0ffh
  1116.         jp z,fff0b
  1117.  
  1118. fff2:   ld a,c
  1119.         add a,40
  1120.         call expnd
  1121.  
  1122. fff3:   dec c
  1123.         jp z,mvtxt2
  1124.         push de
  1125.         inc de
  1126.         jp fff3
  1127.  
  1128. fff4:   ld a,(de)
  1129.         cp swtbc
  1130.         jp nz,fff5
  1131.         inc de
  1132.         ld a,(de)
  1133.         ld l,a
  1134.         ld h,0
  1135.         add hl,hl
  1136.         add hl,hl
  1137.         inc hl
  1138.         inc hl
  1139.         inc de
  1140.         add hl,de
  1141.         ex de,hl
  1142.         jp fff0
  1143.  
  1144. fff5:   call cdtst
  1145.         jp c,fff6
  1146.         inc de
  1147.         inc de
  1148.         jp fff0a
  1149.  
  1150. fff6:   cp modbeg
  1151.         jp nz,fff0a
  1152.         ld hl,14
  1153.         add hl,de
  1154.         ex de,hl
  1155.         jp fff0
  1156.  
  1157. sqish:  push bc
  1158.         ld b,a
  1159.         ld a,0ffh
  1160. sqish2: ld (de),a
  1161.         inc de
  1162.         dec b
  1163.         jp nz,sqish2
  1164.         pop bc
  1165.         ret
  1166.  
  1167.  
  1168. expnd:  push hl
  1169.         push bc
  1170.         push af
  1171.         push de
  1172.         lhld eofad
  1173.         ld b,h
  1174.         ld c,l
  1175.         ld e,a
  1176.         ld d,0
  1177.         add hl,de
  1178.         push hl
  1179.         push bc
  1180.         shld eofad
  1181.         ld b,h
  1182.         ld c,l
  1183.         lhld meofad
  1184.         call max
  1185.         shld meofad
  1186.         pop bc
  1187.         pop hl
  1188.         call ckov
  1189.         pop de
  1190.  
  1191. expnd1: call mvbhd
  1192.         pop af
  1193.         ld b,a
  1194.         push de
  1195. expnd4: ld a,0ffh
  1196.         ld (de),a
  1197.         inc de
  1198.         dec b
  1199.         jp nz,expnd4
  1200.         pop de
  1201.         pop bc
  1202.         pop hl
  1203.         ret
  1204.  
  1205.  
  1206. ;
  1207. ; Routine to lde stuff from (BC) to (HL), decrementing both
  1208. ; as we go, until BC passes DE -- doing it by block lde if possible
  1209. ; (if runnign a Z80), or by brute force if on an 8080 or 8085.
  1210. ; Clobbers BC and HL.
  1211. ;
  1212.  
  1213. mvbhd:  lda z80f        ;z80?
  1214.         or a
  1215.         jp z,mvbhdl     ;if not, do it the long way
  1216.  
  1217.         push de
  1218.         push hl
  1219.         ex de,hl
  1220.         call cmh
  1221.         add hl,bc
  1222.         inc hl
  1223.         push hl
  1224.         ld h,b
  1225.         ld l,c
  1226.         pop bc
  1227.         pop de
  1228.         db 0edh,0b8h    ;ldir instuction
  1229.         pop de
  1230.         ret
  1231.  
  1232.  
  1233. mvbhdl: ld a,(bc)               ;do it the long way
  1234.         ld (hl),a
  1235.         ld a,c
  1236.         cp e
  1237.         jp nz,mvbhd2
  1238.         ld a,b
  1239.         cp d
  1240.         ret z
  1241. mvbhd2: dec hl
  1242.         dec bc
  1243.         jp mvbhd
  1244.  
  1245.  
  1246. ;
  1247. ; Return Cy true if byte in A is a code byte:
  1248. ;
  1249.  
  1250. cdtst:  cp concd
  1251.         ret c
  1252.         cp strcd+1
  1253.         ccf
  1254.         ret
  1255.  
  1256. ;
  1257. ; Purge FF's and related garbage/filler bytes from text:
  1258. ;
  1259.  
  1260. fixt:   lhld coda       ;HL is source pointer
  1261.         ld d,h          ;DE is dest pointer
  1262.         ld e,l
  1263.  
  1264. fix0:   ld a,(hl)               ;end of code?
  1265.         or a
  1266.         jp nz,fix2
  1267.  
  1268.         ld (de),a               ;yes. handle strings.
  1269.         inc de
  1270.         inc hl
  1271. fix1:   ld a,(hl)
  1272.         cp 1ah          ;end of strings?
  1273.         jp nz,fix1a     ;if not, still doing strings.
  1274.         ld (de),a               ;yes.
  1275.         ex de,hl
  1276.         shld eofad
  1277.         ret
  1278.  
  1279. fix1a:  ld b,3          ;handle string storge.
  1280.         call ldb
  1281.         ld b,a
  1282.         call ldb
  1283.         jp fix1
  1284.  
  1285. fix2:   call cdtst      ;three byte code?
  1286.         jp c,fix4
  1287.         ld b,3
  1288.         call ldb
  1289.         jp fix0
  1290.  
  1291. fix4:   cp 0ffh ;garbage byte?
  1292.         jp nz,fix5
  1293.         inc hl          ;yes. skip it.
  1294.         jp fix0
  1295.  
  1296. fix5:   cp swtbc        ;switch statement?
  1297.         jp nz,fix8
  1298.  
  1299.         ld (de),a               ;yes.
  1300.         inc de
  1301.         inc hl
  1302. fix6:   ld a,(hl)
  1303.         cp 0ffh
  1304.         jp nz,fix7
  1305.         inc hl
  1306.         jp fix6
  1307. fix7:   push hl
  1308.         ld l,a
  1309.         ld h,0
  1310.         add hl,hl
  1311.         add hl,hl
  1312.         inc hl
  1313.         inc hl
  1314.         inc hl
  1315.         ld b,h
  1316.         ld c,l
  1317.         pop hl
  1318.         call mvmd
  1319.         jp fix0
  1320.  
  1321. fix8:   cp modbeg       ;start of module?
  1322.         jp nz,fix10
  1323.         ld b,12 ;yes. copy module name
  1324.         call ldb
  1325.         jp fix0
  1326.  
  1327. fix10:  ld (de),a
  1328.         inc hl
  1329.         inc de
  1330.         jp fix0
  1331.  
  1332.  
  1333. fix11:  ld hl,oshit
  1334.         call pstgab
  1335.  
  1336. ldb:    inc b
  1337. ldb2:   dec b
  1338.         ret z
  1339.         ld a,(hl)
  1340.         ld (de),a
  1341.         inc hl
  1342.         inc de
  1343.         jp ldb2
  1344.  
  1345.  
  1346.  
  1347. mvmd:   lda z80f
  1348.         or a
  1349.         jp z,mvmdl      ;if on 8080, can't use block lde
  1350.         db 0edh,0b0h    ;else can
  1351.         ret
  1352.  
  1353. mvmdl:  ld a,(hl)               ;do it the hard way for 8080
  1354.         ld (de),a
  1355.         inc hl
  1356.         inc de
  1357.         dec bc
  1358.         ld a,b
  1359.         or c
  1360.         jp nz,mvmd
  1361.         ret
  1362.  
  1363.  
  1364. pascd:  call igsht
  1365.         ret z
  1366.         call cdtst
  1367.         jp nc,pscd2
  1368.         xor a
  1369.         inc a
  1370.         ld a,(de)
  1371.         ret
  1372.  
  1373. pscd2:  inc de
  1374.         inc de
  1375.         inc de
  1376.         jp pascd
  1377.  
  1378.  
  1379. fsemi:  ld a,semi
  1380.  
  1381.  
  1382. ;
  1383. ; Find next occurence of the character passed in A:
  1384. ;
  1385.  
  1386. findc:  ld b,a
  1387. findc1: ld a,(de)
  1388.         cp b
  1389.         ret z
  1390.         or a
  1391.         jp nz,finc2
  1392.         ld hl,stg10
  1393.         jp fatal
  1394.  
  1395. finc2:  cp nlcd
  1396.         jp nz,finc3
  1397.         call bumpnl
  1398.  
  1399. finc3:  inc de
  1400.         call cdtst
  1401.         jp c,finc4
  1402.         inc de
  1403.         inc de
  1404.         jp findc1
  1405.  
  1406. finc4:  push af
  1407.         lda eradf
  1408.         or a
  1409.         jp nz,finc5
  1410.         pop af
  1411.         jp findc1
  1412.  
  1413. finc5:  pop af
  1414.         cp 80h
  1415.         jp c,findc1     ;if no control keyword found, no problem
  1416.         cp 9dh
  1417.         jp nc,findc1
  1418.  
  1419.         cp 8fh          ;special case of a keyword allowed in
  1420.         jp z,findc1     ;an expression: sizeof
  1421.  
  1422.         lhld nlcnt      ;else error...probably missing semicolon
  1423.         push hl
  1424.         lhld errad
  1425.         shld nlcnt
  1426.         ld hl,stg25
  1427.         call perr
  1428.         pop hl
  1429.         shld nlcnt
  1430.         dec de
  1431.         dec de
  1432.         ld a,semi
  1433.         ld (de),a
  1434.         ret
  1435.  
  1436. ;
  1437. ; New routine that expects to see a semicolon as
  1438. ; the first non-trivial item in text; else error given.
  1439. ;
  1440.  
  1441. esemi:  call igsht
  1442.         cp semi ;next thing a semi?
  1443.         ret z           ;if so, OK-- else insert one.
  1444.  
  1445. insrts: lhld nlcnt      ;save real line count
  1446.         push hl
  1447.         lhld esadr      ;get fake count
  1448.         shld nlcnt
  1449.         ld hl,stg25
  1450.         call perr       ;print error
  1451.         pop hl
  1452.         shld nlcnt
  1453.         ld a,negone     ;make room for automatic semi
  1454.         call mvtxt
  1455.         ld a,semi       ;just to aid diagnosing later errors
  1456.         ld (de),a
  1457.         ret
  1458.  
  1459.  
  1460. tstty:  cp chrcd
  1461.         ret c
  1462.         cp gotcd
  1463.         ccf
  1464.         ret
  1465.  
  1466.  
  1467. ;
  1468. ; Return Cy false if character in A is legal anywhere in an identifier name:
  1469. ;
  1470.  
  1471. varch:  call varch2
  1472.         ret nc
  1473.         cp '0'
  1474.         ret c
  1475.         cp '9'+1
  1476.         ccf
  1477.         ret
  1478.  
  1479. ;
  1480. ; Return Cy false if char in A is legal as FIRST char in an identifier name:
  1481. ;
  1482.  
  1483. varch2: cp 'A'
  1484.         ret c
  1485.         cp 'Z'+1
  1486.         ccf
  1487.         ret nc
  1488.         cp 5fh
  1489.         ret z
  1490.         cp 61h
  1491.         ret c
  1492.         cp 7bh
  1493.         ccf
  1494.         ret
  1495.  
  1496.  
  1497. ;
  1498. ; Advance text pointer past identifier at DE:
  1499. ;
  1500.  
  1501. pasvr:  call igsht
  1502. psvr2:  call varch
  1503.         jp nc,psvr3
  1504.         call igsht
  1505.         ret
  1506.  
  1507. psvr3:  inc de
  1508.         ld a,(de)
  1509.         jp psvr2
  1510.  
  1511.  
  1512. ;
  1513. ; Advance text pointer past parentheses at DE:
  1514.  
  1515. mtchp:  push hl
  1516.         call mtchp1
  1517.         pop hl
  1518.         ret
  1519.  
  1520. mtchp1: call igsht
  1521.         cp open
  1522.         jp z,mtchq
  1523.         ld hl,stg40
  1524.         call perr
  1525.         call fsemi
  1526.         ret
  1527.  
  1528. mtchq:  lhld nlcnt
  1529.         shld mtpln
  1530.  
  1531. mtchpa: inc de
  1532. mtchpb: call pascd
  1533.         jp nz,mtchpc
  1534. mtchpe: lhld mtpln
  1535.         shld nlcnt
  1536.         ld hl,stgbp
  1537.         jp fatal
  1538.  
  1539. mtchpc: cp close
  1540.         jp nz,mtp2
  1541.         push hl         ;save line count for error diagnostics
  1542.         lhld nlcnt
  1543.         shld esadr
  1544.         pop hl
  1545.         inc de
  1546.         call igsht
  1547.         ret
  1548.  
  1549. mtp2:   cp semi ;allow semicolons in parentheses only
  1550.         jp nz,mtp3      ;if semiok is non-zero.
  1551.         lda semiok
  1552.         or a
  1553.         jp z,mtchpe
  1554.         jp mtchpa
  1555.  
  1556. mtp3:   cp open
  1557.         jp nz,mtchpa
  1558.         call mtchpa
  1559.         jp mtchpb
  1560.  
  1561. ;
  1562. ; Install identifier at DE in symbol table position given in HL:
  1563. ;
  1564.  
  1565. instt:  push de
  1566.         push de
  1567.         lhld stp
  1568.         push hl
  1569.         ld de,16
  1570.         add hl,de
  1571.         lda coda+1
  1572.         ld b,a
  1573.         ld a,h
  1574.         cp b
  1575.         jp c,instta
  1576. instt0: ld hl,stgom
  1577.         lda preflag
  1578.         or a
  1579.         jp z,fatal
  1580.         jp pstgab
  1581.  
  1582. instta: pop hl
  1583.         pop de
  1584.         ld c,0
  1585. inst2:  ld a,(de)
  1586.         ld (hl),a
  1587.         inc c
  1588.         inc hl
  1589.         inc de
  1590.         ld a,(de)
  1591.         call varch
  1592.         jp c,inst4
  1593.         ld a,c
  1594.         cp 8
  1595.         jp c,inst2
  1596.  
  1597. inst3:  inc de
  1598.         inc c
  1599.         ld a,(de)
  1600.         call varch
  1601.         jp nc,inst3
  1602.  
  1603. inst4:  dec hl
  1604.         ld a,(hl)
  1605.         or 80h
  1606.         ld (hl),a
  1607.         inc hl
  1608.         ld a,8
  1609.         sub c
  1610.         ld e,a
  1611.         ld d,0
  1612.         jp c,inst5
  1613.         add hl,de
  1614. inst5:  shld tempd
  1615.         pop de
  1616.         ret
  1617.  
  1618.  
  1619.  
  1620. cvtst:  push de
  1621.         add hl,hl
  1622.         add hl,hl
  1623.         add hl,hl
  1624.         add hl,hl
  1625.         ex de,hl
  1626.         ld hl,st
  1627.         add hl,de
  1628.         ld de,8
  1629.         add hl,de
  1630.         pop de
  1631.         ld a,(hl)
  1632.         ret
  1633.  
  1634. finds:  lda clev
  1635.         sta flev
  1636.         call fs
  1637.         ret nc
  1638.         xor a
  1639.         sta flev
  1640.  
  1641.  
  1642. fs:     lhld stno
  1643.         ld b,h
  1644.         ld c,l
  1645.         ld hl,st
  1646.  
  1647. fs2:    ld a,b
  1648.         or c
  1649.         jp nz,fs3
  1650.         scf
  1651.         ret
  1652.  
  1653. fs3:    push de
  1654.         push bc
  1655.         call idcmp
  1656.         jp z,fs4
  1657.         ld de,16
  1658. fs3a:   add hl,de
  1659.         pop bc
  1660.         pop de
  1661.         dec bc
  1662.         jp fs2
  1663.  
  1664. fs4:    dec hl
  1665.         ld a,l
  1666.         and 0f8h
  1667.         ld l,a
  1668.         ld de,9
  1669.         add hl,de
  1670.         shld inadsv
  1671.         ld a,(hl)
  1672.         and 3fh
  1673.         ld d,a
  1674.         lda flev
  1675.         cp d
  1676.         jp z,fs5
  1677.         ld de,7
  1678.         jp fs3a
  1679.  
  1680. fs5:    pop hl
  1681.         call cmh
  1682.         ex de,hl
  1683.         lhld stno
  1684.         add hl,de
  1685.         pop de
  1686.         xor a
  1687.         ret
  1688.  
  1689. initst: lhld stsiz
  1690.         ld b,h
  1691.         ld c,l
  1692.         ld hl,st
  1693. inits1: ld (hl),0
  1694.         inc hl
  1695.         dec bc
  1696.         ld a,b
  1697.         or c   
  1698.         jp nz,inits1
  1699.         ret
  1700.  
  1701. ;
  1702. ; compare the symbol table entry at HL with the text identifier
  1703. ; at DE:
  1704. ;
  1705.  
  1706. idcmp:  push de
  1707.         push hl
  1708.         ld c,1          ;initialize char count
  1709. idcmp2: ld a,(hl)
  1710.         and 7fh         ;strip end-of-text bit from char of st entry
  1711.         ld b,a          ;put it in B.
  1712.         ld a,(de)               ;get a character from text.
  1713.         cp b            ;same?
  1714.         jp z,idcmp3     ;if so, go check rest of identifier
  1715. idcp2a: pop hl          ;else no match.
  1716.         pop de
  1717.         xor a           ;clear zero flag
  1718.         inc a           ;by incrementing from zero,
  1719.         scf             ;and also set the carry flag.
  1720.         ret
  1721.  
  1722. idcmp3: ld a,(hl)               ;ok, so far it matches.
  1723.         or a            ;was it the last char of the st entry?
  1724.         inc hl
  1725.         jp m,idcmp4     ;jump if it was
  1726.         inc de          ;it wasn't. bump text pointer, char count,
  1727.         inc c
  1728.         jp idcmp2       ;and go look at next charcter
  1729.  
  1730. idcmp4: ld a,c          ;end of symbol. if we've already seen 8 characters,
  1731.         cp 8            ;ignore rest of symbol at DE (insignificant chars)
  1732.         jp z,idcmp5    
  1733.         inc de          ;haven't seen 8 chars yet...is next char of text
  1734.         ld a,(de)               ;a legal identifier character?
  1735.         call varch
  1736.         jp nc,idcp2a    ;if so, no match.
  1737.  
  1738. idcp4a: xor a           ;we have a match. set Z.
  1739.         pop de
  1740.         pop de
  1741.         ret
  1742.  
  1743. idcmp5: inc de          ;come here to pass over superfluous chars of text
  1744.         ld a,(de)
  1745.         call varch
  1746.         jp c,idcp4a
  1747.         inc c           ;making sure to bump the char count in C as we go.
  1748.         jp idcmp5
  1749.  
  1750.  
  1751. ;
  1752. ; Make function name table:
  1753. ;
  1754.  
  1755. mkfnt:  lhld stp
  1756.         shld fnts
  1757.         shld fntp
  1758.         lhld stno
  1759.         ld b,h
  1760.         ld c,l
  1761.         ld hl,st+8
  1762.  
  1763. mkft1:  ld a,b
  1764.         or c
  1765.         jp nz,mkft2     ;done?
  1766.         lhld fntp       ;yes. make sure we haven't overflowed  
  1767.         ex de,hl                ;the symbol table
  1768.         lhld coda
  1769.         call cmphd      ;return C if code area < end of func name table
  1770.         ret nc
  1771.         ld hl,stgom     ;list too long. complain and abort
  1772.         jp pstgab
  1773.  
  1774. mkft2:  ld a,(hl)
  1775.         rra
  1776.         push hl
  1777.         push bc
  1778.         call c,mkft3
  1779.         pop bc
  1780.         pop hl
  1781.         ld de,16
  1782.         add hl,de
  1783.         dec bc
  1784.         jp mkft1
  1785.  
  1786. mkft3:  ld de,-8
  1787.         add hl,de
  1788.         push hl
  1789.         ld h,b
  1790.         ld l,c
  1791.         call cmh
  1792.         ex de,hl
  1793.         lhld stno
  1794.         add hl,de
  1795.         ex de,hl
  1796.         lhld fntp
  1797.         ld (hl),e
  1798.         inc hl
  1799.         ld (hl),d
  1800.         inc hl
  1801.         pop de
  1802.  
  1803. mkft4:  ld a,(de)
  1804.         ld (hl),a
  1805.         inc de
  1806.         inc hl
  1807.         or a
  1808.         jp p,mkft4
  1809.         shld fntp
  1810.         ret
  1811.  
  1812. mvfnt:  lhld fnts
  1813.         call cmh
  1814.         ex de,hl
  1815.         lhld fntp
  1816.         add hl,de
  1817.         shld st-2
  1818.         ld b,h
  1819.         ld c,l
  1820.         lhld fnts
  1821.         ex de,hl
  1822.         lhld stp
  1823.  
  1824. mvft1:  ld a,b
  1825.         or c
  1826.         jp z,mvft2
  1827.         ld a,(de)
  1828.         ld (hl),a
  1829.         inc hl
  1830.         inc de
  1831.         dec bc
  1832.         jp mvft1
  1833.  
  1834. mvft2:  shld fntp
  1835.         ret
  1836.  
  1837. ;
  1838. ; Perform "big expansion" of text:
  1839. ;
  1840.  
  1841. bexp:   ex de,hl
  1842.         call cmh
  1843.         ld b,h
  1844.         ld c,l
  1845.         lhld eofad
  1846.         push hl
  1847.         push hl
  1848.         add hl,bc
  1849.         ld b,h
  1850.         ld c,l
  1851.         pop hl
  1852.         inc bc
  1853.         add hl,de
  1854.         shld eofad
  1855.         call ckov
  1856.         pop de
  1857.  
  1858. bexp1:  ld a,b
  1859.         or c
  1860.         jp z,bexp2
  1861.         ld a,(de)
  1862.         ld (hl),a
  1863.         dec hl
  1864.         dec bc
  1865.         dec de
  1866.         jp bexp1
  1867.  
  1868. bexp2:  inc de
  1869.         ret
  1870.  
  1871. ;
  1872. ; Either write CCI file to disk (if -az given, CP/M only) or auto-load
  1873. ; into CC2:
  1874. ;
  1875.  
  1876. writf:  lhld extsa      ;put externals size word in place
  1877.         shld st-6
  1878.  
  1879.         ld hl,st        ;get size of symbol table in HL
  1880.         call cmh
  1881.         ex de,hl
  1882.         lhld stp
  1883.         add hl,de
  1884.         shld st-4       ;put symbol table size in place
  1885.  
  1886.         lhld eofad      ;now copy tokenized code down to just past the
  1887.         ld b,h          ;end of the symbol table
  1888.         ld c,l
  1889.         lhld coda
  1890.         ex de,hl
  1891.         lhld fntp
  1892.                
  1893. writ1:  ld a,(de)
  1894.         ld (hl),a
  1895.         inc hl
  1896.         inc de
  1897.         ld a,e
  1898.         cp c
  1899.         jp nz,writ1
  1900.         ld a,d
  1901.         cp b
  1902.         jp nz,writ1
  1903.         shld eofad
  1904.  
  1905.         IF CPM
  1906.         lda chainf
  1907.         or a
  1908.         jp nz,chain
  1909.         ENDIF
  1910.  
  1911.         IF NOT CPM
  1912.         jp chain
  1913.         ENDIF
  1914.  
  1915.         IF CPM
  1916. writ1a: ld hl,fcb+9
  1917.         ld (hl),'C'
  1918.         inc hl
  1919.         ld (hl),'C'
  1920.         inc hl
  1921.         ld (hl),'I'
  1922.         lda odisk       ;set output disk designation
  1923.         sta fcb
  1924.         call delfil
  1925.         call create     ;create output file
  1926.         lhld eofad      ;copy till end of all data
  1927.         shld cpyend
  1928.  
  1929.         ld hl,st-6
  1930. writ2:  call copys
  1931.         push af
  1932.         call writs
  1933.         pop af
  1934.         jp nc,writ2
  1935.         call closef     ;close the output file.
  1936.         ret
  1937.         ENDIF
  1938.  
  1939.  
  1940. chain:
  1941.         lda cc2dsk      ;get default cc2 disk
  1942.         sta cfcb        ;set as first byte of fcb
  1943.  
  1944.         IF NOT ALPHA
  1945.         ;lda nouser     ;don't futz with user areas?
  1946.         ;or a
  1947.         ;jp nz,chain0   ;if not, skip chandng user area
  1948.  
  1949.         ;lda cc2usr     ;get cc2 default user area
  1950.         ;ld e,a
  1951.  
  1952.         ;ld c,sguser
  1953.         ;call bdos      ;change to that user area
  1954.         ENDIF
  1955.  
  1956. chain0: call occ2       ;try to open in default user area and disk
  1957.  
  1958.         ;push af        ;save condition
  1959.         ;lda curdsk     ;switch back to current disk and user area
  1960.         ;inc a
  1961.         ;sta cfcb
  1962.  
  1963.         ;IF NOT ALPHA
  1964.         ;lda nouser
  1965.         ;or a
  1966.         ;jp nz,chain1
  1967.  
  1968.         ;lda curusr     ;change back to current user area
  1969.         ;ld e,a
  1970.  
  1971.         ;ld c,sguser
  1972.         ;call bdos
  1973.         ;ENDIF
  1974.  
  1975. ;chain1:        pop af          ;get back condition of first cc2 open attempt
  1976.         jp nz,ch3               ;go read in if prior open succeeded
  1977.  
  1978.         call occ2       ;else try to read in current disk and user area...
  1979.         jp nz,ch3               ;if ok, go read
  1980.  
  1981.         jp cc2bad       ;else give up
  1982.  
  1983. occ2:   lhld curtop
  1984.         push hl         ;try to open cc2
  1985.         ld de,-33
  1986.         add hl,de
  1987.         push hl
  1988.         ld de,cfcb
  1989.         ld b,16
  1990. ch2:    ld a,(de)
  1991.         ld (hl),a
  1992.         inc hl 
  1993.         inc de
  1994.         dec b
  1995.         jp nz,ch2
  1996.         pop de
  1997.         ld c,openfil
  1998.         call bdos       ;try to open cc2.com
  1999.         pop hl
  2000.         dec hl
  2001.         ld (hl),0               ;clear nr field of CC2 fcb
  2002.         cp 255          ;cc2 on disk?
  2003.         ret
  2004.  
  2005. cc2bad: ld hl,stgcce    ;nope. complain and write out cci file
  2006.  
  2007.         call pstg
  2008.         jp writ1a
  2009.  
  2010. ch3:   
  2011.         call ldef       ;lde schlameel to high ram
  2012.         ld hl,tbuff     ;lde bootstrap to tbuff (== just 80h under MARC)
  2013.         ld de,bootcode
  2014.         ld b,bootlen
  2015. ch4:    ld a,(de)
  2016.         ld (hl),a
  2017.         inc hl
  2018.         inc de
  2019.         dec b
  2020.         jp nz,ch4
  2021.  
  2022. ;
  2023. ; Now set up stack at ram area, and push all data that will have to
  2024. ; be popped back into cc2. The order of pushing, and resulting address
  2025. ; in cc2, are as follows:
  2026. ;
  2027. ;       no.     item    address in cc2
  2028. ;       ---     ----    --------------
  2029. ;       0       kflg    110h
  2030. ;       1       odisk   5fh             (CP/M only)
  2031. ;       2       optimf  104h
  2032. ;       3       loadad  105h-106h
  2033. ;       4       eflag   109h
  2034. ;       5       exaddr  107h-108h
  2035. ;       6       curtop  10ch-10dh
  2036. ;       7       ccpok   10eh            (ccpok: b0, oktort: b1, wboote b2,
  2037. ;                                               zenvf: b3)
  2038. ;               maxmd   10eh            (MARC only)
  2039. ;       8       spsav   10ah-10bh       (CP/M only)
  2040. ;               fnam    10ah-10bh       (MARC only)
  2041. ;       9       erasub  10fh            (CP/M only)
  2042. ;       10      defsub/ 111h-112h       (CP/M only)
  2043. ;               conpol
  2044. ;       11      errbyt  113h-114h       (CP/M only)
  2045. ;      
  2046. ; The bootstrap pops these in the reverse order, or course, and sets
  2047. ; them up in the newly-loaded in cc2.com file.
  2048. ;
  2049.  
  2050.         ld sp,tpa
  2051.         lda kflg        ;save CDB flag
  2052.         push af
  2053.         lda odisk       ;save output disk flag
  2054.         push af
  2055.         lda optim       ;save optimization flag
  2056.         push af
  2057.         lhld loadad     ;save load address
  2058.         push hl
  2059.         lda eflag       ;save external addr given flag
  2060.         push af
  2061.         lhld exaddr     ;save external address if given
  2062.         push hl
  2063.         lhld curtop     ;save current top of memory
  2064.         push hl
  2065.  
  2066.         IF CPM
  2067.         lda ccpok       ;save CCP intact flag
  2068.         or a
  2069.         jp z,bt000
  2070.         ld a,1          ;set b0 to ccpok
  2071. bt000:  ld b,a          ;save in B
  2072.  
  2073.         lda oktort      ;get oktoret flag
  2074.         add a           ;put bit in b1 position
  2075.         add b           ;accumulate
  2076.         ld b,a          ;save it
  2077.  
  2078.         lda wboote      ;set b2 to wboote
  2079.         or a
  2080.         jp z,bt001
  2081.         ld a,4          ;if true, make b2 hi
  2082. bt001:  add b
  2083.  
  2084.         lda zenvf
  2085.         or a
  2086.         jp z,bt002
  2087.         ld a,8          ;set b3
  2088. bt002:  add b
  2089.  
  2090.         push af ;save combination of (b0 b1 b2 b3)
  2091.  
  2092.         ;lhld spsav     ;save CCP's stack pointer
  2093.         ;push hl
  2094.  
  2095.         lda werrs       ;if werrs false, just push erasub
  2096.         or a
  2097.         lda erasub
  2098.         jp z,setbt1
  2099.         or 2            ;if werrs true, but b1 high on erasub
  2100.        
  2101. setbt1: push af
  2102.         lhld defsub     ;save defsub/conpol bytes
  2103.         push hl
  2104.         lhld errbyt     ;get ZCPR3 error byte address
  2105.         push hl
  2106.  
  2107.         lhld curtop     ;put fcb address of cc2 fcb in BC
  2108.         ld de,-33
  2109.         add hl,de
  2110.         ld b,h
  2111.         ld c,l
  2112.         ENDIF
  2113.  
  2114.         jp tbuff        ;go do it
  2115.  
  2116. ;
  2117. ; This is the bootstrap that will run down at tbuff:
  2118. ;
  2119.  
  2120. bootcode:
  2121.         IF CPM          ;first the CP/M version...
  2122.         ld de,tpa       ;(cp/m only code is: 35 bytes)
  2123.         push de         ;save memory load address pointer
  2124.         push bc         ;save cc2's fcb address
  2125.         ld c,sdma       ;set DMA address to current memory load address (DE)
  2126.         call bdos
  2127.         pop de          ;pop cc2's fcb address into DE
  2128.         push de         ;and push back on stack for later
  2129.         ld c,rsequen    ;read a sector
  2130.         call bdos
  2131.         or a
  2132.         pop bc          ;pop cc2's fcb address into BC
  2133.         pop de          ;pop memory load address
  2134.         jp nz,postld    ;if done, go finish up
  2135.         ld hl,80h       ;otherwise add 80h to memory load address
  2136.         add hl,de
  2137.         ex de,hl                ;and put it back in DE
  2138.         jp tbuff+3
  2139.         ENDIF
  2140.  
  2141. ;
  2142. ; pop stuff off stack for CC2:
  2143. ;
  2144.  
  2145. postld:  equ tbuff + $ - bootcode
  2146.         IF CPM
  2147.         pop hl          ;get back wboote flag + extra byte
  2148.         shld ram+113h
  2149.         pop hl          ;get back defsub and conpol bytes
  2150.         shld ram+111h
  2151.         pop af          ;get back erasing submit files flag
  2152.         sta ram+10fh
  2153.         ENDIF
  2154.  
  2155.         ;pop hl         ;pop filename under MARC or saved SP under CP/M
  2156.         ;shld ram+010ah
  2157.  
  2158.         pop af          ;pop ccpok/maxmd flag
  2159.         sta ram+010eh
  2160.  
  2161.         pop hl          ;pop current top of memory address
  2162.         shld ram+010ch
  2163.  
  2164.         pop hl          ;pop external variables address
  2165.         shld ram+0107h
  2166.         pop af          ;pop external address flag
  2167.         sta ram+0109h
  2168.  
  2169.         pop hl          ;pop load address
  2170.         shld ram+0105h
  2171.         pop af          ;pop optimization flag
  2172.         sta ram+0104h
  2173.         pop af          ;pop output disk designation flag
  2174.  
  2175.         IF CPM
  2176.         sta fcb         ;set output disk designation
  2177.         ENDIF
  2178.  
  2179.         pop af          ;pop CDB flag
  2180.         sta ram+110h
  2181.  
  2182.         ld a,1
  2183.         sta ram+103h    ;set chained-to flag
  2184.         jp tpa          ;and go execute
  2185.  
  2186. bootlen: equ $-bootcode ;length of bootstrap
  2187.  
  2188. ;
  2189. ; (end of bootstrap)
  2190. ;
  2191.  
  2192.  
  2193.  
  2194.  
  2195. ldef:   ld de,-(st-6)
  2196.         lhld eofad
  2197.         add hl,de              
  2198.         inc hl
  2199.         ex de,hl                ;DE = length of text
  2200.         lhld curtop
  2201.         ld bc,-36
  2202.         add hl,bc
  2203.         ld b,h
  2204.         ld c,l          ;BC = destination
  2205.         push bc         ;save for later
  2206.         lhld eofad      ;HL = source
  2207. ldef1:  ld a,(hl)
  2208.         ld (bc),a
  2209.         dec bc
  2210.         dec hl
  2211.         dec de
  2212.         ld a,d
  2213.         or e
  2214.         jp nz,ldef1
  2215.         pop hl          ;get addr of where start addr goes
  2216.         inc hl          ;now HL = BDOS - 35
  2217.         ld (hl),c
  2218.         inc hl          ;and BDOS - 34
  2219.         ld (hl),b
  2220.         ret             ;and all done!
  2221.  
  2222.  
  2223.         IF LASM
  2224.         link ccc
  2225.         ENDIF
  2226.