home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / c64 / utilities / PromShellv2b.sfx / crunch.src (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1990-02-12  |  4.7 KB  |  130 lines
  1. 10 *= $c44a
  2. 20 ;crunch.src
  3. 30 .s
  4. 40 .d crunch
  5. 50 ;
  6. 60 txttab = $2b
  7. 70 vartab = $2d
  8. 80 arytab = $2f
  9. 90 strend = $30
  10. 100 ;
  11. 110 chrget = $73
  12. 120 txtptr = $7a
  13. 130 chrput = $81
  14. 140 putptr = $88
  15. 150 ;
  16. 160 maxlen = $50
  17. 170 max =$fa
  18. 180 length = $fb
  19. 190 sabuf = $fc
  20. 200 ;
  21. 210 warmst = $a002
  22. 220 linkprg = $a533
  23. 230 strout = $ab1e
  24. 240 ;
  25. 250 adc44a ldx #$17; save chrget, set up chrput routine
  26. 260 saveit lda chrget,x:sta savebuf,x:dex:bpl saveit:ldx #$07:clc
  27. 270 lda txttab:adc #$ff:sta chrget,x:inx:lda txttab+1:adc #$ff:sta chrget,x:inx
  28. 280 lda #$60:sta chrget,x
  29. 290 putit lda chrget,x:sta chrput,x:dex:bpl putit
  30. 300 lda #putptr:sta chrput+1:lda #putptr+1:sta chrput+5:lda #$8d:sta chrput+6
  31. 310 ;
  32. 320 ; initialize counter to end-of-line
  33. 330 lda #maxlen:sta max:sta length
  34. 340 ;
  35. 350 ;check for $ac in "*= $tart" line, skip over defs if found
  36. 360 ldy #$05:lda (txtptr),y:cmp #$ac:bne newfile:iny:iny:iny:iny:ldx #$00
  37. 370 ;
  38. 380 start1 lda (txtptr),y:sta sabuf,x:iny:inx:cpx #$04:bcc start1
  39. 390 ;
  40. 400 ;ascii hex digits now at sabuf, txtptr still at basic-1
  41. 410 dey:tya:clc:adc txtptr:sta txtptr:bcc start2:inc txtptr+1
  42. 420 ;
  43. 430 ;next call to chrget fetches the byte following the start address
  44. 440 ;now find the matching string in the first line of program code
  45. 450 start2 ldx #$00
  46. 460 start3 jsr chrget:bne start5:jsr chrget:jsr chrget:bne start4
  47. 470 ;
  48. 480 ;found third zero byte, no start-of-code so print message and quit
  49. 490 lda #<nocode:ldy #>nocode:jsr strout:ldx #$17:jmp done2
  50. 500 ;
  51. 510 ;found hibyte of line link so discard line number and fetch byte of line
  52. 520 start4 jsr chrget:jsr chrget:jmp start2
  53. 530 ;
  54. 540 start5 cmp sabuf,x:bne start2:inx:cpx #$04:bcc start3:lda #$0a:sta length
  55. 550 lda #<crunching:ldy #>crunching:jsr strout
  56. 560 ;
  57. 570 ;found, so set up chrput and fall through in midline
  58. 580 lda txtptr:sta putptr:lda txtptr+1:sta putptr+1
  59. 590 ;
  60. 600 midline jsr chrget:beq endline:bpl midline1:inc length; tokenized "or"
  61. 610 midline1 jsr chrput:inc length:bne midline
  62. 620 ;
  63. 630 ;step chrput back if at beginning of new file
  64. 640 newfile lda putptr:bne newfile1:dec putptr+1
  65. 650 newfile1 dec putptr
  66. 660 lda #<crunching:ldy #>crunching:jsr strout
  67. 670 ;
  68. 680 ;check to see if end of program
  69. 690 endline ldy #$02:lda (txtptr),y:bne endline1:jmp done
  70. 700 ;
  71. 710 ;check next line for pseudop, jump, rts/rti or label
  72. 720 endline1 ldy #$05:lda (txtptr),y:cmp #$2e:beq label1; "." pseudop
  73. 730 cmp #$3b:beq label1; ";" pseudop
  74. 740 cmp #$4a:beq endline2; j, check m
  75. 750 cmp #$52:bne endline3; r, check t
  76. 760 endline2 iny:lda (txtptr),y:cmp #$4d:beq stopline:cmp #$54:beq stopline
  77. 770 ; not jm/rt, can't be jt, rm, ja or ra so fall through
  78. 780 endline3 cmp #$41:bne endline4; if not "a" then not label
  79. 790 ;
  80. 800 ;check for "def" token (adefxx label) or "d" (adxxxx label)
  81. 810 iny:lda (txtptr),y:cmp #$96:beq label:cmp #$44:bne endline4
  82. 820 ;
  83. 830 ;check for space following adc instruction, otherwise it's a label
  84. 840 iny:iny:lda (txtptr),y:cmp #$20:bne label
  85. 850 endline4 jmp addline
  86. 860 ;
  87. 870 ;labelled lines may be .byte, rts/rti/jmp:  leave in one line if found
  88. 880 label iny:lda (txtptr),y:cmp #$20:bne label; get past the label
  89. 890 iny:lda (txtptr),y:cmp #$2e:beq pseudop; .byte line
  90. 900 cmp #$4a:beq label0:cmp #$52:bne newline; j or r else simple label
  91. 910 label0 iny:lda (txtptr),y:cmp #$54:beq pseudop:cmp #$4d:bne newline; t or m
  92. 920 label1 beq pseudop; jmps to one-liners
  93. 930 ;
  94. 940 ;if unlabelled jmp/rts/rti found, stop line after adding this instruction
  95. 950 stopline iny:lda (txtptr),y:bne stopline:dey:dey:dey:tya:clc:adc length
  96. 960 cmp max:bcs pseudop:lda max:sta length:bne addline1
  97. 970 ;
  98. 980 ;start new line: move line links and number and (NULL) to midline
  99. 990 newline lda #$00:jsr chrput:ldx #$03:stx length; allow for line # expansion
  100. 1000 newline1 jsr chrget:jsr chrput:inc length:dex:bpl newline1:jmp midline
  101. 1010 ;
  102. 1020 pseudop lda #$00:jsr chrput:lda max:sta length:ldx #$03
  103. 1030 pseudop1 jsr chrget:jsr chrput:dex:bpl pseudop1
  104. 1040 pseudop2 jsr chrget:bne pseudop3:jmp endline
  105. 1050 pseudop3 jsr chrput:bne pseudop2
  106. 1060 ;
  107. 1070 addline iny:lda (txtptr),y:bne addline; .y-3 = length to add
  108. 1080 dey:dey:dey:tya:clc:adc length:cmp max:bcs newline;check for space
  109. 1090 ;
  110. 1100 ;append the line and discard the links and number
  111. 1110 addline1 lda #$3a:jsr chrput:inc length:ldx #$03
  112. 1120 addline2 jsr chrget:dex:bpl addline2:jmp midline
  113. 1130 ;
  114. 1140 done ldx #$03:lda #$00
  115. 1150 done1 jsr chrput:dex:bpl done1
  116. 1160 lda putptr:sta vartab:sta arytab:sta strend
  117. 1170 lda putptr+1:sta vartab+1:sta arytab+1:sta strend+1:ldx #$17
  118. 1180 done2 lda savebuf,x:sta chrget,x:dex:bpl done2
  119. 1190 jsr linkprg:lda #<crunched:ldy #>crunched:jsr strout:jmp (warmst)
  120. 1200 savebuf .byte 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
  121. 1210 nocode .byte "[147][213]nable to match hex digits of start":.byte 13
  122. 1220 .byte "address (*= $xxxx) to label of first":.byte 13
  123. 1230 .byte "line of code following definitions.":.byte 13
  124. 1240 .byte "[211]hould be ":.byte 34:.byte "ad0801":.byte 34:.byte "type label"
  125. 1250 .byte 13 0
  126. 1260 crunching .byte "[195]runching...":.byte 13 0
  127. 1270 crunched .byte "[145][195]runched!   ":.byte 13 0 0 0
  128. 1280 ;
  129. 1290 .end crunch.src
  130.