10
20
30
40
50
60
70
80
90
100
110
120 :
130 ver$="1.05 (08-Dec-2016)":ver%=5
140 lptr=&70:dptr=&72:tmpX=&74:tmpY=&75:flag=&76
150 lomem=&00:vartop=&02:top=&12:PageHi=&18
160 TknREM=&F4:TknTHEN=&8C:TknELSE=&8B
170 osbyte=&FFF4
180 :
190 DIM mcode% &200:load%=&0500
200 FOR P=0 TO 1:opt%=P*2+4
210 P%=load%:O%=mcode%
220 [OPT opt%
230 .exec%
240 JMP start:BRK:BRK:BRK :\ Header identifies
250 EQUB &62 :EQUB copy-exec% :\ this as 6502 code
260 EQUB ver%:EQUS "Crunch" :\ Program name
270 EQUB &00 :EQUS ver$ :\ Program version
280 .copy
290 EQUB &00 :EQUS "(C)J.G.Harston":EQUB 0
300 EQUD load%
310 :
320 .start
330 TSX:LDY &102,X:INY:CPY #&F9:BCC NoTube
340 LDA &103,X:STA &EE:STA &F2 :\ Restore caller's environment
350 LDA &104,X:STA &EF:STA &F3
360 .NoTube
370 LDA #187 :\ Check BASIC is current language
380 .ChkBasic
390 STX lptr:LDX #0:LDY #255:JSR osbyte
400 EOR #71:CMP #187:BNE ChkBasic
410 TXA:EOR lptr:AND #63:BEQ RunningInBasic
420 BRK:EQUB 249:EQUS "Not in BASIC":BRK
430 :
440 .RunningInBasic
450 LDA #0:STA lptr+0:STA dptr+0 :\ Point to start of prog
460 LDA PageHi:STA lptr+1:STA dptr+1 :\ Set up src and dest pointers
470 :
480 \ Everything prior to here can be used as workspace
490 :
500 .ScanNewLine
510 LDY #0:LDX #0 :\ Point to start of line, clear flag
520 JSR CopyChar:JSR CopyChar :\ Copy CR, NumHi
530 CMP #&FF:BNE P%+5:JMP EndOfProg :\ No more program
540 JSR CopyChar:JSR CopyChar:PHA :\ Copy NumLo, Len, save source len
550 .ScanStatementStart
560 DEY:LDA #0:STA flag :\ Clear statement flag
570 .ScanStatement
580 INY:LDA (lptr),Y
590 CMP #ASC" ":BEQ ScanStatement :\ Remove leading spaces
600 CMP #ASC":":BEQ ScanStatement :\ Remove leading colons
610 CMP #TknREM:BEQ RemoveREM :\ REM marks end of line
620 CMP #ASC"*":BNE ScanLine :\ Not *command
630 .CopyCommand
640 JSR CopyChar
650 CMP #13:BNE CopyCommand :\ Copy whole *command
660 JMP UpdateLineLength
670 .RemoveREM
680 BEQ ScanLineEnd
690 .ScanLineNum
700 JSR CopyChar:JSR CopyChar :\ Copy embedded line number
710 JSR CopyChar
720 .ScanLine
730 LDA (lptr),Y :\ Get source character
740 CMP #13:BEQ ScanLineEnd :\ End of line
750 CMP #34:BNE ScanLineStore
760 ASL A:EOR flag:STA flag :\ Toggle quote flag in bit 6
770 LDA #34
780 .ScanLineStore
790 JSR StoreChar :\ Copy character to crunched line
800 BIT flag:BVS ScanLine :\ Within quotes, keep copying
810 CMP #&8D:BEQ ScanLineNum :\ Embedded line number
820 CMP #ASC"\":BEQ ScanComment :\ Probable assembler comment
830 CMP #ASC";":BEQ ScanComment :\ Possible assembler comment
840 CMP #ASC":":BEQ ScanSpaces :\ Remove spaces before colon
850 CMP #&80:BCC ScanLine :\ Not a token, continue scanning line
860 .ScanSpaces :\ Remove spaces around tokens
870 PHA :\ Save character just stored
880 LDY tmpX :\ Point to stored character
890 ASL A:BPL SkipPreSpace :\ Not a command token if &80-&BF
900 ROL flag:SEC:ROR flag :\ Set flag bit 7=command token seen
910 .SkipPreSpace
920 DEY:CPY #4:BCC SkipSpaceDone :\ Backed up to start of line
930 LDA (dptr),Y :\ Get character before current
940 CMP #ASC" ":BEQ SkipPreSpace :\ Skip spaces before current character
950 .SkipSpaceDone
960 INY:TYA:TAX:LDY tmpY :\ Update pointers
970 PLA:JSR StoreChar :\ Copy character to crunched line
980 CMP #ASC":" :\ Check for end of statement
990 .JumpToStart
1000 BEQ ScanStatementStart :\ Scan from start of statement
1010 CMP #TknTHEN:BEQ JumpToStart
1020 CMP #TknELSE:BEQ JumpToStart
1030 .SkipPostSpace
1040 LDA (lptr),Y:INY
1050 CMP #ASC" ":BEQ SkipPostSpace :\ Skip spaces after token
1060 DEY:BNE ScanLine :\ Continue scanning statement
1070 :
1080 .ScanComment
1090 BIT flag:BMI ScanLine :\ Not an assembler comment
1100 DEX:DEY :\ Point to '\' or '
1110 .ScanCommentLp
1120 INY:LDA (lptr),Y :\ Get character
1130 CMP #13:BEQ ScanLineEnd :\ Found end of line
1140 CMP #ASC":":BNE ScanCommentLp :\ Loop until end of comment
1150 JMP ScanStatementStart :\ Start scanning next statement
1160 :
1170 .ScanLineEnd :\ Y=>source <cr>, X=>dest location for <cr>
1180 STY tmpY:TXA:TAY
1190 .DropColons :\ Now move back and drop colons and spaces
1200 CPY #5:BCC MoveToNextLine :\ Null line, ignore it
1210 DEC tmpY:DEY:LDA (dptr),Y :\ Look at previous character
1220 CMP #ASC":":BEQ DropColons :\ Move back if a colon
1230 CMP #ASC" ":BEQ DropColons :\ Move back if a space
1240 INC tmpY:INY:TYA:TAX:LDY tmpY
1250 LDA #13:JSR StoreChar :\ Point back to where CR should be
1260 .UpdateLineLength
1270 DEX
1280 TXA:LDY #3:STA (dptr),Y :\ Ensure (dptr),len points to Y
1290 JSR AddAtoDPTR :\ Bump dest to point to next line
1300 .MoveToNextLine
1310 PLA :\ Get saved length of source line
1320 JSR AddAtoLPTR:JMP ScanNewLine:\ Update source pointer, loop to next line
1330 :
1340 .EndOfProg
1350 TXA:JSR AddAtoDPTR :\ Update EndOfProg pointers
1360 LDA dptr+0:STA top+0
1370 LDA dptr+1:STA top+1
1380 RTS :\ Finished
1390 :
1400 .CopyChar
1410 LDA (lptr),Y :\ Get from source line
1420 .StoreChar
1430 STY tmpY:STX tmpX:LDY tmpX
1440 STA (dptr),Y:LDY tmpY :\ Store in crunched line
1450 INX:INY:RTS :\ Update pointers
1460 :
1470 .AddAtoLPTR
1480 LDX #lptr:BNE AddAtoPTR :\ Update lptr
1490 .AddAtoDPTR
1500 LDX #dptr :\ Update dptr
1510 .AddAtoPTR
1520 CLC:ADC 0,X:STA 0,X
1530 LDA #0:ADC 1,X:STA 1,X
1540 RTS
1550 :
1560 ]NEXT
1570 A$="*Save Crunch "+STR$~mcode%+" "+STR$~O%+" "+STR$~exec%+" "+STR$~load%
1580 PRINT"Saving: "A$;:OSCLIA$:PRINT