8bitfiles.net/archives/archives.tar/archives/genie-commodore-file-library/C64-128Toolkit/DECODE.SDA/CRUNCH.SRC

Commodore BASIC | 2019-04-13 | 4.7 KB | 130 lines

10 *= $C44A
20 ;CRUNCH.SRC
30 .S
40 .D CRUNCH
50 ;
60 TXTTAB = $2B
70 VARTAB = $2D
80 ARYTAB = $2F
90 STREND = $30
100 ;
110 CHRGET = $73
120 TXTPTR = $7A
130 CHRPUT = $81
140 PUTPTR = $88
150 ;
160 MAXLEN = $50
170 MAX =$FA
180 LENGTH = $FB
190 SABUF = $FC
200 ;
210 WARMST = $A002
220 LINKPRG = $A533
230 STROUT = $AB1E
240 ;
250 ADC44A LDX #$17; SAVE CHRGET, SET UP CHRPUT ROUTINE
260 SAVEIT LDA CHRGET,X:STA SAVEBUF,X:DEX:BPL SAVEIT:LDX #$07:CLC
270 LDA TXTTAB:ADC #$FF:STA CHRGET,X:INX:LDA TXTTAB+1:ADC #$FF:STA CHRGET,X:INX
280 LDA #$60:STA CHRGET,X
290 PUTIT LDA CHRGET,X:STA CHRPUT,X:DEX:BPL PUTIT
300 LDA #PUTPTR:STA CHRPUT+1:LDA #PUTPTR+1:STA CHRPUT+5:LDA #$8D:STA CHRPUT+6
310 ;
320 ; INITIALIZE COUNTER TO END-OF-LINE
330 LDA #MAXLEN:STA MAX:STA LENGTH
340 ;
350 ;CHECK FOR $AC IN "*= $TART" LINE, SKIP OVER DEFS IF FOUND
360 LDY #$05:LDA (TXTPTR),Y:CMP #$AC:BNE NEWFILE:INY:INY:INY:INY:LDX #$00
370 ;
380 START1 LDA (TXTPTR),Y:STA SABUF,X:INY:INX:CPX #$04:BCC START1
390 ;
400 ;ASCII HEX DIGITS NOW AT SABUF, TXTPTR STILL AT BASIC-1
410 DEY:TYA:CLC:ADC TXTPTR:STA TXTPTR:BCC START2:INC TXTPTR+1
420 ;
430 ;NEXT CALL TO CHRGET FETCHES THE BYTE FOLLOWING THE START ADDRESS
440 ;NOW FIND THE MATCHING STRING IN THE FIRST LINE OF PROGRAM CODE
450 START2 LDX #$00
460 START3 JSR CHRGET:BNE START5:JSR CHRGET:JSR CHRGET:BNE START4
470 ;
480 ;FOUND THIRD ZERO BYTE, NO START-OF-CODE SO PRINT MESSAGE AND QUIT
490 LDA #<NOCODE:LDY #>NOCODE:JSR STROUT:LDX #$17:JMP DONE2
500 ;
510 ;FOUND HIBYTE OF LINE LINK SO DISCARD LINE NUMBER AND FETCH BYTE OF LINE
520 START4 JSR CHRGET:JSR CHRGET:JMP START2
530 ;
540 START5 CMP SABUF,X:BNE START2:INX:CPX #$04:BCC START3:LDA #$0A:STA LENGTH
550 LDA #<CRUNCHING:LDY #>CRUNCHING:JSR STROUT
560 ;
570 ;FOUND, SO SET UP CHRPUT AND FALL THROUGH IN MIDLINE
580 LDA TXTPTR:STA PUTPTR:LDA TXTPTR+1:STA PUTPTR+1
590 ;
600 MIDLINE JSR CHRGET:BEQ ENDLINE:BPL MIDLINE1:INC LENGTH; TOKENIZED "OR"
610 MIDLINE1 JSR CHRPUT:INC LENGTH:BNE MIDLINE
620 ;
630 ;STEP CHRPUT BACK IF AT BEGINNING OF NEW FILE
640 NEWFILE LDA PUTPTR:BNE NEWFILE1:DEC PUTPTR+1
650 NEWFILE1 DEC PUTPTR
660 LDA #<CRUNCHING:LDY #>CRUNCHING:JSR STROUT
670 ;
680 ;CHECK TO SEE IF END OF PROGRAM
690 ENDLINE LDY #$02:LDA (TXTPTR),Y:BNE ENDLINE1:JMP DONE
700 ;
710 ;CHECK NEXT LINE FOR PSEUDOP, JUMP, RTS/RTI OR LABEL
720 ENDLINE1 LDY #$05:LDA (TXTPTR),Y:CMP #$2E:BEQ LABEL1; "." PSEUDOP
730 CMP #$3B:BEQ LABEL1; ";" PSEUDOP
740 CMP #$4A:BEQ ENDLINE2; J, CHECK M
750 CMP #$52:BNE ENDLINE3; R, CHECK T
760 ENDLINE2 INY:LDA (TXTPTR),Y:CMP #$4D:BEQ STOPLINE:CMP #$54:BEQ STOPLINE
770 ; NOT JM/RT, CAN'T BE JT, RM, JA OR RA SO FALL THROUGH
780 ENDLINE3 CMP #$41:BNE ENDLINE4; IF NOT "A" THEN NOT LABEL
790 ;
800 ;CHECK FOR "DEF" TOKEN (ADEFXX LABEL) OR "D" (ADXXXX LABEL)
810 INY:LDA (TXTPTR),Y:CMP #$96:BEQ LABEL:CMP #$44:BNE ENDLINE4
820 ;
830 ;CHECK FOR SPACE FOLLOWING ADC INSTRUCTION, OTHERWISE IT'S A LABEL
840 INY:INY:LDA (TXTPTR),Y:CMP #$20:BNE LABEL
850 ENDLINE4 JMP ADDLINE
860 ;
870 ;LABELLED LINES MAY BE .BYTE, RTS/RTI/JMP:  LEAVE IN ONE LINE IF FOUND
880 LABEL INY:LDA (TXTPTR),Y:CMP #$20:BNE LABEL; GET PAST THE LABEL
890 INY:LDA (TXTPTR),Y:CMP #$2E:BEQ PSEUDOP; .BYTE LINE
900 CMP #$4A:BEQ LABEL0:CMP #$52:BNE NEWLINE; J OR R ELSE SIMPLE LABEL
910 LABEL0 INY:LDA (TXTPTR),Y:CMP #$54:BEQ PSEUDOP:CMP #$4D:BNE NEWLINE; T OR M
920 LABEL1 BEQ PSEUDOP; JMPS TO ONE-LINERS
930 ;
940 ;IF UNLABELLED JMP/RTS/RTI FOUND, STOP LINE AFTER ADDING THIS INSTRUCTION
950 STOPLINE INY:LDA (TXTPTR),Y:BNE STOPLINE:DEY:DEY:DEY:TYA:CLC:ADC LENGTH
960 CMP MAX:BCS PSEUDOP:LDA MAX:STA LENGTH:BNE ADDLINE1
970 ;
980 ;START NEW LINE: MOVE LINE LINKS AND NUMBER AND (null) TO MIDLINE
990 NEWLINE LDA #$00:JSR CHRPUT:LDX #$03:STX LENGTH; ALLOW FOR LINE # EXPANSION
1000 NEWLINE1 JSR CHRGET:JSR CHRPUT:INC LENGTH:DEX:BPL NEWLINE1:JMP MIDLINE
1010 ;
1020 PSEUDOP LDA #$00:JSR CHRPUT:LDA MAX:STA LENGTH:LDX #$03
1030 PSEUDOP1 JSR CHRGET:JSR CHRPUT:DEX:BPL PSEUDOP1
1040 PSEUDOP2 JSR CHRGET:BNE PSEUDOP3:JMP ENDLINE
1050 PSEUDOP3 JSR CHRPUT:BNE PSEUDOP2
1060 ;
1070 ADDLINE INY:LDA (TXTPTR),Y:BNE ADDLINE; .Y-3 = LENGTH TO ADD
1080 DEY:DEY:DEY:TYA:CLC:ADC LENGTH:CMP MAX:BCS NEWLINE;CHECK FOR SPACE
1090 ;
1100 ;APPEND THE LINE AND DISCARD THE LINKS AND NUMBER
1110 ADDLINE1 LDA #$3A:JSR CHRPUT:INC LENGTH:LDX #$03
1120 ADDLINE2 JSR CHRGET:DEX:BPL ADDLINE2:JMP MIDLINE
1130 ;
1140 DONE LDX #$03:LDA #$00
1150 DONE1 JSR CHRPUT:DEX:BPL DONE1
1160 LDA PUTPTR:STA VARTAB:STA ARYTAB:STA STREND
1170 LDA PUTPTR+1:STA VARTAB+1:STA ARYTAB+1:STA STREND+1:LDX #$17
1180 DONE2 LDA SAVEBUF,X:STA CHRGET,X:DEX:BPL DONE2
1190 JSR LINKPRG:LDA #<CRUNCHED:LDY #>CRUNCHED:JSR STROUT:JMP (WARMST)
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
1210 NOCODE .BYTE "[147][213]NABLE TO MATCH HEX DIGITS OF START":.BYTE 13
1220 .BYTE "ADDRESS (*= $XXXX) TO LABEL OF FIRST":.BYTE 13
1230 .BYTE "LINE OF CODE FOLLOWING DEFINITIONS.":.BYTE 13
1240 .BYTE "[211]HOULD BE ":.BYTE 34:.BYTE "AD0801":.BYTE 34:.BYTE "TYPE LABEL"
1250 .BYTE 13 0
1260 CRUNCHING .BYTE "[195]RUNCHING...":.BYTE 13 0
1270 CRUNCHED .BYTE "[145][195]RUNCHED!   ":.BYTE 13 0 0 0
1280 ;
1290 .END CRUNCH.SRC