10 ; **** BASIC COMPILER **** 20 ; Macro Subroutines For Two Byte Integer BASIC 30 ; By Phil Lindquist, Union Lake, Michigan 1981 40 ; 50 ; Stack Located in Zero Page Starting at $80 and 60 ; Filling Downward. X Register Used as a Top 70 ; (Bottom) of Stack Pointer. Variables Saved in 80 ; Variable Table VARTAB, Two Bytes Each. Posi- 90 ; tive Integers to 65536 Permitted, No Arrays 100 ; or String Variables. 110 ; 120 CHROUT = $2343 ;Character Output Routine 130 STROUT = $2D73 ;OS65D3 String Print Routine 140 CRLF = $2D6A ;OS65D3 Carriage Return-Line Feed 150 STACK = $0000 ;Page Zero Stack 160 BUFFER = $0000 ;Input Buffer Start 170 KYBD = $DF00 ;Keyboard Address 180 ; 200 * = 40960 210 BEGIN JSR INIT 220 L100 DEX 230 LDA #0 240 STA STACK,X 250 DEX 260 LDA #20 270 STA STACK,X 280 JSR TAB 290 JSR STROUT 300 .BYTE 84,69,83,84,0 310 JSR CRLF 320 L110 JSR CRLF 330 L150 RTS 40000 ; 40010 HEX .BYTE $0,$2,$56 40020 TMP .BYTE 0,0,0 40030 STRX .BYTE 0 40040 STRY .BYTE 0 40050 CNTR .BYTE 0 40060 FLG .BYTE 0 40070 OS .BYTE 0,0 40080 BUFPTR .BYTE 0 40090 ; 40100 ; Subroutine to PRINT Line Number 40110 ; 40120 OUTVAR LDA #0 ;First Convert to Decimal 40130 STA TMP 40140 STA TMP+1 40150 STA TMP+2 40160 ; 40170 SED ;Decimal Mode 40180 ; 40190 LDA STACK,X ;Get Low Byte 40200 STA CNTR 40210 INX 40220 STX STRX 40230 CMP #0 40240 BEQ POUT7 40250 ; 40260 POUT1 LDX #2 40270 SEC 40280 ; 40290 POUT5 LDA TMP,X ;Add One 40300 ADC #0 40310 STA TMP,X 40320 DEX 40330 BPL POUT5 40340 ; 40350 DEC CNTR ;For Each Count 40360 BNE POUT1 40370 ; 40380 POUT7 LDX STRX ;Get High Byte of Line Number 40390 LDA STACK,X 40400 STA CNTR 40410 INX 40420 STX STRX 40430 CMP #0 40440 BEQ POUT8 40450 ; 40460 POUT2 LDX #2 40470 CLC 40480 ; 40490 POUT3 LDA TMP,X ;Add 256 for Each Count 40500 ADC HEX,X 40510 STA TMP,X 40520 DEX 40530 BPL POUT3 40540 ; 40550 DEC CNTR 40560 BNE POUT2 40570 ; 40580 POUT8 CLD ;Reset Hexadecimal Mode 40590 LDA #0 40600 STA FLG ;Reset Flag 40610 ; 40620 LDA TMP ;Print First Two Digits 40630 JSR DIGOUT 40640 ; 40650 LDA TMP+1 ;Print Next Two Digits 40660 JSR DIGOUT 40670 ; 40680 LDA TMP+2 ;Print Last Two Digits 40690 JSR DIGOUT 40700 LDX STRX 40710 RTS 40720 ; 40730 DIGOUT PHA ;Save Number 40740 LSR A 40750 LSR A 40760 LSR A 40770 LSR A 40780 JSR DOUT2 40790 PLA 40800 ; 40810 DOUT2 AND #$F ;Get Lowest Digit 40820 BNE DOUT3 40830 LDA FLG ;Print Leading Blanks 40840 BEQ DOUT4 40850 LDA #$30 40860 BNE DOUT5 40870 ; 40880 DOUT4 LDA #$20 ;Blank 40890 BNE DOUT5 40900 ; 40910 DOUT3 ORA #$30 ;Build ASCII Character 40920 INC FLG ;Adjust Leading Blank Flag 40930 ; 40940 DOUT5 JMP CHROUT ;And Finally Print and Return 40950 ; 40960 SPC LDA STACK,X ;Subroutine to Print Spaces 40970 STA CNTR ; Number Provided On Top 40980 INX ; Of Stack 40990 INX 41000 CMP #0 41010 BEQ SPCND 41020 ; 41030 SPC1 LDA #32 41040 JSR CHROUT ;PRINT " "; 41050 DEC CNTR 41060 BNE SPC1 41070 ; 41080 SPCND RTS 41081 ; 41082 TAB LDA STACK,X ;TAB Function - Column 41083 STA $2639 ; Number on Top of Stack 41084 INX 41085 INX 41086 RTS 41090 ; 41100 INIT CLD ;Initialization Routine 41110 LDX #$80 41120 RTS 41130 ; 41140 PSHVAR DEX ;Push Variable Value on Stack 41150 INY 41160 LDA VARTAB,Y 41170 STA STACK,X 41180 DEX 41190 DEY 41200 LDA VARTAB,Y 41210 STA STACK,X 41220 RTS 41230 ; 41240 POKE LDA STACK,X ;Value on Top 41250 STA (STACK+2,X) ;Address in Second 41260 JMP POP2 41270 ; 41280 POP3 INX ;Pop Three Off Stack 41290 INX 41300 POP2 INX ;Pop Two 41310 INX 41320 POP1 INX ;Pop Top 41330 INX 41340 RTS 41350 ; 41360 PSHONE LDA #0 ;Put One on Top 41370 JSR ONE1 41380 LDA #1 41390 ONE1 DEX 41400 STA STACK,X 41410 RTS 41420 ; 41430 DUP JSR DUP1 41440 DUP1 DEX 41450 LDA STACK+2,X 41460 STA STACK,X 41470 RTS 41480 ; 41490 LET LDA STACK,X ;Store Top in Address 41500 STA (STACK+2,X) ; in Second Position 41510 INC STACK+2,X ; on Stack 41520 BNE LETCON 41530 INC STACK+3,X 41540 ; 41550 LETCON INX ;Pop Two in Process 41560 LDA STACK,X 41570 INX 41580 STA (STACK,X) 41590 INX 41600 INX 41610 RTS 41620 ; 41630 PSHADD CLC ;Push Variable Address on Top 41640 ; 41650 COMH = VARTAB/256 ;Variable Number in A Reg 41660 COML = COMH*256 41670 COML = VARTAB-COML 41680 ; 41690 ADC #COML 41700 DEX 41710 DEX 41720 STA STACK,X 41730 LDA #0 41740 ADC #COMH 41750 STA STACK+1,X 41760 RTS 41770 ; 41780 PEEK LDA (STACK,X) ;Subroutine Replaces Top 41790 STA STACK,X ; of Stack with Contents 41800 LDA #0 ; of Memory Location 41810 STA STACK+1,X ; Addressed by Top 41820 RTS 41830 ; 41840 NXTIN JSR CRLF 41850 INLINE LDX #0 ;CHARACTER COUNT = X 41860 NXTINP JSR $2340 ;INECHO 41870 CMP #$5F ;CHECK FOR BACKSPACE 41880 BNE INOK 41890 DEX 41900 BMI NXTIN 41910 STA BUFFER,X 41920 JSR STROUT 41930 .BYTE 8,8,' ',8,8,0 41940 JMP NXTINP ;TRY AGAIN 41950 ; 41960 INOK CMP #$15 ;CHECK FOR CONTROL-U 41970 BEQ NXTIN 41980 STA BUFFER,X 41990 CMP #$0D ;CHECK FOR CARRIAGE RETURN 42000 BEQ DONEIN 42010 INX 42020 BPL NXTINP ;CHECK FOR END-OF-BUFFER 42030 ; 42040 LDA #$0D 42050 BNE INOK+4 42060 ; 42070 DONEIN JMP CRLF 42080 ; 42090 ; 42100 X4OS CLC 42110 ROL OS 42120 ROL OS+1 42130 X2OS CLC 42140 ROL OS 42150 ROL OS+1 42160 RTS 42170 ; 42180 GETNUM STX STRX ;Get Input Number 42190 LDA #'? ;Put on Stack 42200 JSR CHROUT 42210 JSR INLINE 42220 LDA #0 42230 STA OS 42240 STA OS+1 42250 STA BUFPTR 42260 AGAIN LDX BUFPTR 42270 GLOOP1 LDA BUFFER,X 42280 CMP #32 42290 BNE GLOOP 42300 INX 42310 BNE GLOOP1 42320 ; 42330 GLOOP LDA BUFFER,X 42340 CMP #$D ;Check for Carriage Return 42350 BEQ DUNLIN 42360 ; 42370 CMP #', ;Check for Comma 42380 BEQ DUNLIN 42390 ; 42400 JSR X2OS ;OS = 10 * OS 42410 LDA OS 42420 STA TMP 42430 LDA OS+1 42440 STA TMP+1 42450 ; 42460 JSR X4OS 42470 ; 42480 CLC 42490 LDA OS 42500 ADC TMP 42510 STA OS 42520 ; 42530 LDA OS+1 42540 ADC TMP+1 42550 STA OS+1 42560 ; 42570 LDA BUFFER,X 42580 INX 42590 SEC 42600 SBC #$30 42610 BCC ERROR1 42620 CMP #$A 42630 BPL ERROR1 42640 ; 42650 CLC 42660 ADC OS 42670 STA OS 42680 ; 42690 BCC GEND 42700 INC OS+1 42710 GEND JMP GLOOP 42720 ; 42730 ERROR1 LDA #$E 42740 BNE *+2 42750 ERROR2 LDA #$F 42760 JMP $2AC4 42770 ; 42780 DUNLIN INX 42790 STX BUFPTR 42800 LDX STRX 42810 LDA OS+1 42820 DEX 42830 STA STACK,X 42840 LDA OS 42850 DEX 42860 STA STACK,X 42870 RTS 42880 ; 42890 ADD CLC ;Addition Subroutine 42900 JSR ADD1 ;Integer BASIC, No Sign 42910 ; 42920 ADD1 LDA STACK,X 42930 ADC STACK+2,X 42940 STA STACK+2,X 42950 INX 42960 RTS 42970 ; 42980 SUB SEC ;Subtraction Subroutine 42990 JSR SUB1 ;Integer BASIC, No Sign 43000 ; 43010 SUB1 LDA STACK,X 43020 SBC STACK+2,X 43030 STA STACK+2,X 43040 INX 43050 RTS 43060 ; 43070 MUL LDA #0 ;Multiplication Subroutine 43080 STA TMP ;See BYTE October 1981 43090 STA TMP+1 43100 ; 43110 HALF LSR STACK+1,X 43120 ROR STACK,X 43130 BCC DOUBLE 43140 CLC 43150 LDA TMP 43160 ADC STACK+2,X 43170 STA TMP 43180 ; 43190 LDA TMP+1 43200 ADC STACK+3,X 43210 STA TMP+1 43220 ; 43230 DOUBLE ASL STACK+2,X 43240 ROL STACK+3,X 43250 ; 43260 LDA STACK,X 43270 ORA STACK+1,X 43280 BNE HALF 43290 ; 43300 INX 43310 INX 43320 LDA TMP 43330 STA STACK,X 43340 LDA TMP+1 43350 STA STACK+1,X 43360 RTS 43370 ; 43380 NEXT CLC 43390 LDA (STACK+4,X) 43400 ADC STACK,X 43410 STA (STACK+4,X) 43420 STA TMP 43430 ; 43440 INC STACK+4,X 43450 BNE NEXT1 43460 INC STACK+5,X 43470 ; 43480 NEXT1 LDA (STACK+4,X) 43490 ADC STACK+1,X 43500 STA (STACK+4,X) 43510 STA TMP+1 43520 ; 43530 LDA STACK+4,X 43540 BNE NEXT2 43550 DEC STACK+5,X 43560 ; 43570 NEXT2 DEC STACK+4,X 43580 ; 43590 SEC 43600 LDA STACK+2,X ;Check For End of Loop 43610 SBC TMP 43620 LDA STACK+3,X 43630 SBC TMP+1 43640 RTS 43650 ; 43660 EQ LDA STACK,X ;Compare Top Ites 43670 CMP STACK+2,X ; on Stack 43680 BNE FALSE 43690 ; 43700 LDA STACK+1,X 43710 CMP STACK+3,X 43720 BNE FALSE 43730 ; 43740 TRUE LDA #$FF ;Set All Bits On 43750 BNE *+4 43760 ; 43770 FALSE LDA #00 ;Set All Bits Off 43780 INX 43790 INX 43800 STA STACK,X 43810 STA STACK+1,X 43820 RTS 43830 ; 43840 NE JSR EQ 43850 ; 43860 COMPL LDA STACK ;Complement 43870 AND #$FF 43880 STA STACK,X 43890 LDA STACK+1,X 43900 AND #$FF 43910 STA STACK+1,X 43920 RTS 43930 ; 43940 NEG JSR COMPL ;Negate 43950 CLC 43960 LDA STACK,X 43970 ADC #1 43980 STA STACK,X 43990 BCC NEG1 44000 ; 44010 INC STACK+1,X 44020 NEG1 RTS 44030 ; 44040 VARTAB .END