Mercurial > hg > index.cgi
annotate bas12.s @ 1:704b2c9dc19e default tip
Remove extraneous unused and incorrect definition
author | William Astle <lost@l-w.ca> |
---|---|
date | Wed, 02 Jan 2019 10:11:19 -0700 |
parents | 605ff82c4618 |
children |
rev | line source |
---|---|
0
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1 *pragma nolist |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2 include defs.s |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3 *pragma list |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
5 ; COLOR BASIC ROM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
7 org BASIC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
8 ; This is the official set of ROM entry points. It is unfortunate that the generic input ("console in") routine is not exposed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
9 ; here. It is also unfortunate that no open and close file routines are exposed. This and other oversignts led to a lot of |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
10 ; software either having to re-invent the wheel or calling directly into the ROM instead of via these official entry points. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
11 POLCAT fdb KEYIN ; indirect jump, get a keystroke |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
12 CHROUT fdb PUTCHR ; indirect jump, output character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
13 CSRDON fdb CASON ; indirect jump, turn cassette on and start reading |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
14 BLKIN fdb GETBLK ; indirect jump, read a block from tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
15 BLKOUT fdb SNDBLK ; indirect jump, write a block to tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
16 JOYIN fdb GETJOY ; indirect jump, read joystick axes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
17 WRTLDR fdb WRLDR ; indirect jump, turn cassette on and write a leader |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
18 ; Initialization code. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
19 LA00E lds #LINBUF+LBUFMX+1 ; put the stack in the line input buffer which is a safe place for now |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
20 lda #0x37 ; enable the cartidge interrupt (to detect autostarting cartridges) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
21 sta PIA1+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
22 lda RSTFLG ; get warm start flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
23 cmpa #0x55 ; is it valid? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
24 bne BACDST ; brif not - cold start |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
25 ldx RSTVEC ; get warm start routine pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
26 lda ,x ; get first byte of the routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
27 cmpa #0x12 ; is it NOP? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
28 bne BACDST ; brif not - the routine is invalid so do a cold start |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
29 jmp ,x ; transfer control to the warm start routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
30 ; RESET/power on comes here |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
31 RESVEC leay LA00E,pcr ; point to warm start check code |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
32 LA02A ldx #PIA1 ; point to PIA1 - we're going to rely on the mirroring to reach PIA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
33 clr -3,x ; set PIA0 DA to direction mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
34 clr -1,x ; set PIA0 DB to direction mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
35 clr -4,x ; set PIA0 DA to inputs |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
36 ldd #0xff34 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
37 sta -2,x ; set PIA0 DB to outputs |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
38 stb -3,x ; set PIA0 DA to data mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
39 stb -1,x ; set PIA0 DB to data mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
40 clr 1,x ; set PIA1 DA to direction mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
41 clr 3,x ; set PIA1 DB to direction mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
42 deca |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
43 sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
44 lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
45 sta 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
46 stb 1,x ; set PIA1 DA to data mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
47 stb 3,x ; set PIA1 DB to data mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
48 clr 2,x ; set VDG to alpha-numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
49 ldb #2 ; make RS232 marking ("stop" bit) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
50 stb ,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
51 ldu #SAMREG ; point to SAM register |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
52 ldb #16 ; 16 bits to clear |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
53 LA056 sta ,u++ ; clear a bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
54 decb ; done all? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
55 bne LA056 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
56 sta SAMREG+9 ; put display at 0x400 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
57 tfr b,dp ; set direct page to 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
58 ldb #4 ; use as a mask to check RAMSZ input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
59 sta -2,x ; set RAMSZ strobe high |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
60 bitb 2,x ; check RAMSZ input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
61 beq LA072 ; brif set for 4K RAMs |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
62 clr -2,x ; set strobe low |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
63 bitb 2,x ; check input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
64 beq LA070 ; brif set for 64K rams |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
65 leau -2,u ; adjust pointer to set SAM for 16K RAMs |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
66 LA070 sta -3,u ; program SAM for either 16K or 64K RAMs |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
67 LA072 jmp ,y ; transfer control to startup routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
68 ; Cold start jumps here |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
69 BACDST ldx #VIDRAM+1 ; point past the top of the first 1K of memory (for double predec below) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
70 LA077 clr ,--x ; clear a byte (last will actually try clearing LSB of RESET vector in ROM) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
71 leax 1,x ; move forward one byte (will set Z if we're done) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
72 bne LA077 ; brif not donw yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
73 jsr LA928 ; clear the screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
74 clr ,x+ ; put the constant zero that lives before the program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
75 stx TXTTAB ; set beginning of program storage |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
76 LA084 lda 2,x ; get value from memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
77 coma ; make it different |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
78 sta 2,x ; try putting different into memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
79 cmpa 2,x ; did it matcH? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
80 bne LA093 ; brif not - we found the end of memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
81 leax 1,x ; move pointer forward |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
82 com 1,x ; restore the original memory contents |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
83 bra LA084 ; try another byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
84 LA093 stx TOPRAM ; save top of memory (one below actual top because we need a byte for VAL() to work) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
85 stx MEMSIZ ; save top of string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
86 stx STRTAB ; set bottom of allocated string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
87 leax -200,x ; allocate 200 bytes of string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
88 stx FRETOP ; set top of actually free memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
89 tfr x,s ; put the stack there |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
90 ldx #LA10D ; point to variable initializer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
91 ldu #CMPMID ; point to variables to initialize (first batch) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
92 ldb #28 ; 28 bytes in first batch |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
93 jsr LA59A ; copy bytes to variables |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
94 ldu #IRQVEC ; point to variables to initialize (second batch) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
95 ldb #30 ; 30 bytes this time |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
96 jsr LA59A ; copy bytes to variables |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
97 ldx -12,x ; get SN error address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
98 stx 3,u ; set ECB's command handlers to error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
99 stx 8,u |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
100 ldx #RVEC0 ; point to RAM vectors |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
101 ldd #0x394b ; write 75 RTS opcodes (25 RAM vectors) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
102 LA0C0 sta ,x+ ; put an RTS |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
103 decb ; done? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
104 bne LA0C0 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
105 sta LINHDR-1 ; make temporary line header data for line encoding have a nonzero next line pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
106 jsr LAD19 ; do a "NEW" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
107 ldx #'E*256+'X ; magic number to detect ECB ROM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
108 cmpx EXBAS ; is there an ECB ROM? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
109 lbeq EXBAS+2 ; brif so - launch it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
110 andcc #0xaf ; start interrupts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
111 ldx #LA147-1 ; point to sign on message |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
112 jsr LB99C ; print it out |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
113 ldx #BAWMST ; warm start routine address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
114 stx RSTVEC ; set vector there |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
115 lda #0x55 ; warm start valid flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
116 sta RSTFLG ; mark warm start valid |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
117 bra LA0F3 ; go to direct mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
118 ; Warm start entry point |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
119 BAWMST nop ; valid routine marker |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
120 clr DEVNUM ; reset output/input to screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
121 jsr LAD33 ; do a partial NEW |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
122 andcc #0xaf ; start interrupts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
123 jsr LA928 ; clear the screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
124 LA0F3 jmp LAC73 ; go to direct mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
125 ; FIRQ service routine - this handles starting autostart cartridges |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
126 BFRQSV tst PIA1+3 ; is it the cartridge interrupt? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
127 bmi LA0FC ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
128 rti |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
129 LA0FC jsr LA7D1 ; delay for a while |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
130 jsr LA7D1 ; delay for another while |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
131 leay <LA108,pcr ; point to cartridge starter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
132 jmp LA02A ; go initialize everything clean for the cartridge |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
133 LA108 clr RSTFLG ; force a cold start a cartridge reset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
134 jmp ROMPAK ; transfer control to the cartridge |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
135 ; Variable initializers (first batch) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
136 LA10D fcb 18 ; mid band partition of the 1200/2400 Hz period |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
137 fcb 24 ; upper limit of 1200 Hz period |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
138 fcb 10 ; upper limit of 2400 Hz period |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
139 fdb 128 ; number of 0x55s for cassette leader |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
140 fcb 11 ; cursor blink delay |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
141 fdb 88 ; 600 baud delay constant |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
142 fdb 1 ; printer carriage return delay constant |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
143 fcb 16 ; printer tab field width |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
144 fcb 112 ; last printer tab zone |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
145 fcb 132 ; printer carriage width |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
146 fcb 0 ; printer carriage position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
147 fdb LB44A ; default execution address for EXEC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
148 inc CHARAD+1 ;* character fetching routines (DP portion) - we first do a two |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
149 bne LA123 ;* two stage increment of CHARAD then load the value into A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
150 inc CHARAD ;* before transferring control to the bottom half routine in ROM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
151 LA123 lda >0 ; NOTE: the 0 is a placeholder, extended addressing is required |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
152 jmp BROMHK |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
153 ; Variable initializers (second batch) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
154 jmp BIRQSV ; IRQ handler |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
155 jmp BFRQSV ; FIRQ handler |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
156 jmp LB44A ; default USR() address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
157 fcb 0x80,0x4f,0xc7,0x52,0x59 ; random seed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
158 fcb 0xff ; capslock flag - default to upper case |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
159 fdb DEBDEL ; keyboard debounce delay (why is it a variable?) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
160 jmp LB277 ; exponentiation handler vector |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
161 fcb 53 ; (command interpretation table) 53 commands |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
162 fdb LAA66 ; (command interpretation table) reserved words list (commands) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
163 fdb LAB67 ; (command interpretation table) jump table (commands) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
164 fcb 20 ; (command interpretation table) 20 functions |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
165 fdb LAB1A ; (command interpretation table) reserved words list (functions) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
166 fdb LAA29 ; (command interpretation table) jump table (functions) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
167 ; This is the signon message. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
168 LA147 fcc 'COLOR BASIC 1.2' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
169 fcb 0x0d |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
170 fcc '(C) 1982 TANDY' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
171 fcb 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
172 ; This is the "invalid colour" CLS easter egg text. Basically 11 wasted bytes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
173 LA166 fcc 'MICROSOFT' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
174 fcb 0x0d,0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
175 ; Read a character from current device and mask off bit 7 (keep it as 7 bit ASCII) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
176 LA171 bsr LA176 ; get character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
177 anda #0x7f ; mask off high bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
178 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
179 ; Generic read routine. Reads a character from the device specified by DEVNUM. If no input was available, |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
180 ; CINBFL will bet nonzero (on EOF). If input was available, CINBFL will be zero. Note that this routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
181 ; has undefined results when called on an output only device. All registers except CC and A are preserved. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
182 LA176 jsr RVEC4 ; do RAM hook |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
183 clr CINBFL ; flag data available |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
184 tst DEVNUM ; is it keyboard? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
185 beq LA1B1 ; brif so - blink cursor and wait for key press |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
186 tst CINCTR ; is there anything in cassette input buffer? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
187 bne LA186 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
188 com CINBFL ; flag EOF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
189 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
190 ; Read character from cassette file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
191 LA186 pshs u,y,x,b ; preserve registers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
192 ldx CINPTR ; get input buffer pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
193 lda ,x+ ; get character from buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
194 pshs a ; save it for return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
195 stx CINPTR ; save new input buffer pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
196 dec CINCTR ; count character just consumed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
197 bne LA197 ; brif buffer is not empty yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
198 jsr LA635 ; go read another block, if any, to refill the buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
199 LA197 puls a,b,x,y,u,pc ; restore registers and return the character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
200 ; Blink the cursor. This might be better timed via an interrupt or something. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
201 LA199 dec BLKCNT ; is it time to blink the cursor? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
202 bne LA1AB ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
203 ldb #11 ; reset blink timer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
204 stb BLKCNT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
205 ldx CURPOS ; get cursor position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
206 lda ,x ; get character at the cursor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
207 adda #0x10 ; move to next color |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
208 ora #0x8f ; make sure it's a grahpics block with all elements lit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
209 sta ,x ; put new cursor block on screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
210 LA1AB ldx #DEBDEL ; we'll use the debounce delay for the cursor blink timer (10ms) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
211 LA1AE jmp LA7D3 ; go count X down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
212 ; Blink cursor while waiting for a key press |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
213 LA1B1 pshs x,b ; save registers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
214 LA1B3 bsr LA199 ; go do a cursor iteration |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
215 bsr KEYIN ; go read a key |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
216 beq LA1B3 ; brif no key pressed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
217 ldb #0x60 ; VDG screen space character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
218 stb [CURPOS] ; blank cursor out |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
219 puls b,x,pc ; restore registers and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
220 ; This is the actual keyboard polling routine. Returns 0 if no new key is down. Compared to the 1.0 and 1.1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
221 ; ROMs, this routine is quite a lot more compact and robust. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
222 LA1C1 clr PIA0+2 ; strobe all columns |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
223 lda PIA0 ; get rows |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
224 coma ; bits set if keys down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
225 lsla ; remove the comparator input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
226 beq LA244 ; brif no keys down - don't actually poll the keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
227 KEYIN pshs u,x,b ; save registers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
228 ldu #PIA0 ; point to keyboard PIA |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
229 ldx #KEYBUF ; point to state table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
230 clra ; clear carry, set column to 0xff (no strobe) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
231 deca ; (note: deca does not affect C) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
232 pshs x,a ; save column counter and make a couple of holes for temporaries |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
233 sta 2,u ; set strobe to no columns |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
234 LA1D9 rol 2,u ; move to next column (C is 0 initially, 1 after) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
235 bcc LA220 ; brif we shifted out a 0 - we've done 8 columns |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
236 inc 0,s ; bump column counter (first bump goes to 0) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
237 bsr LA23A ; read row data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
238 sta 1,s ; save key data (for debounce check and later saving) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
239 eora ,x ; now bits set if key state changed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
240 anda ,x ; now bits are only set if a key has been pressed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
241 ldb 1,s ; get new key data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
242 stb ,x+ ; save in state table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
243 tsta ; was a key down? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
244 beq LA1D9 ; brif not - do another (nothing above cleared C) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
245 ldb 2,u ; get strobe data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
246 stb 2,s ; save it for debounce check |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
247 ldb #0xf8 ; set up so B is 0 after first add |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
248 LA1F4 addb #8 ; add 8 for each row |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
249 lsra ; did we hit the right row? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
250 bcc LA1F4 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
251 addb 0,s ; add in column number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
252 beq LA245 ; brif @ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
253 cmpb #26 ; letter? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
254 bhi LA247 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
255 orb #0x40 ; bias into letter range |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
256 bsr LA22E ; check for SHIFT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
257 ora CASFLG ; merge in capslock state |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
258 bne LA20C ; brif either capslock or SHIFT - keep upper case |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
259 orb #0x20 ; move to lower case |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
260 LA20C stb 0,s ; save ASCII value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
261 ldx DEBVAL ; get debounce delay |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
262 bsr LA1AE ; do the 10ms debounce delay |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
263 ldb #0xff ; set strobe to none - only joystick buttons register now |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
264 bsr LA238 ; read keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
265 inca ; A now 0 if no buttons down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
266 bne LA220 ; brif button down - return nothing since we have interference |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
267 LA21A ldb 2,s ; get column strobe data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
268 bsr LA238 ; read row data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
269 cmpa 1,s ; does it match original read? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
270 LA220 puls a,x ; clean up stack and get return value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
271 bne LA22B ; brif failed debounce or a joystick button down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
272 cmpa #0x12 ; is it SHIFT-0? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
273 bne LA22C ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
274 com CASFLG ; swap capslock state |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
275 LA22B clra ; set no key down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
276 LA22C puls b,x,u,pc ; restore registers and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
277 LA22E lda #0x7f ; column strobe for SHIFT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
278 sta 2,u ; set column |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
279 lda ,u ; get row data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
280 coma ; set if key down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
281 anda #0x40 ; only keep SHIFT state |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
282 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
283 LA238 stb 2,u ; save strobe data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
284 LA23A lda ,u ; get row data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
285 ora #0x80 ; mask off comparator so it doesn't interfere |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
286 tst 2,u ; are we on column 7? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
287 bmi LA244 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
288 ora #0xc0 ; also mask off SHIFT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
289 LA244 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
290 LA245 ldb #51 ; scan code for @ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
291 LA247 ldx #CONTAB-0x36 ; point to code table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
292 cmpb #33 ; arrows, space, zero? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
293 blo LA264 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
294 ldx #CONTAB-0x54 ; adjust to other half of table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
295 cmpb #48 ; ENTER, CLEAR, BREAK, @? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
296 bhs LA264 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
297 bsr LA22E ; read shift state |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
298 cmpb #43 ; is it a number, colon, semicolon? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
299 bls LA25D ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
300 eora #0x40 ; invert shift state for others |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
301 LA25D tsta ; shift down? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
302 bne LA20C ; brif not - return result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
303 addb #0x10 ; add in offset to shifted character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
304 bra LA20C ; go return result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
305 LA264 lslb ; two entries per key |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
306 bsr LA22E ; check SHIFT state |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
307 beq LA26A ; brif not shift |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
308 incb ; point to shifted entry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
309 LA26A ldb b,x ; get actual key code |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
310 bra LA20C ; go return result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
311 CONTAB fcb 0x5e,0x5f ; <UP> (^, _) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
312 fcb 0x0a,0x5b ; <DOWN> (LF, [) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
313 fcb 0x08,0x15 ; <LEFT> (BS, ^U) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
314 fcb 0x09,0x5d ; <RIGHT> (TAB, ]) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
315 fcb 0x20,0x20 ; <SPACE> |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
316 fcb 0x30,0x12 ; <0> (0, ^R) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
317 fcb 0x0d,0x0d ; <ENTER> (CR, CR) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
318 fcb 0x0c,0x5c ; <CLEAR> (FF, \) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
319 fcb 0x03,0x03 ; <BREAK> (^C, ^C) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
320 fcb 0x40,0x13 ; <@> (@, ^S) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
321 ; Generic output routine. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
322 ; Output character in A to the device specified by DEVNUM. All registers are preserved except CC. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
323 ; Sending output to a device that does not support output is undefined. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
324 PUTCHR jsr RVEC3 ; call RAM hook |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
325 pshs b ; save B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
326 ldb DEVNUM ; get desired device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
327 incb ; set flags (Z for -1, etc.) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
328 puls b ; restore B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
329 bmi LA2BF ; brif < -1 (line printer) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
330 bne LA30A ; brif > -1 (screen) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
331 ; Write character to tape file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
332 pshs x,b,a ; save registers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
333 ldb FILSTA ; get file status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
334 decb ; input file? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
335 beq LA2A6 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
336 ldb CINCTR ; get character count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
337 incb ; account for this character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
338 bne LA29E ; brif buffer not full |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
339 bsr LA2A8 ; write previously full block to tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
340 LA29E ldx CINPTR ; get output buffer pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
341 sta ,x+ ; put character in output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
342 stx CINPTR ; save new buffer pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
343 inc CINCTR ; account for this character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
344 LA2A6 puls a,b,x,pc ; restore registers and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
345 ; Write a block of data to tape. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
346 LA2A8 ldb #1 ; data block type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
347 LA2AA stb BLKTYP ; set block type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
348 ldx #CASBUF ; point to output buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
349 stx CBUFAD ; set buffer pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
350 ldb CINCTR ; get number of bytes in the block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
351 stb BLKLEN ; set length to write |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
352 pshs u,y,a ; save registers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
353 jsr LA7E5 ; write a block to tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
354 puls a,y,u ; restore registers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
355 jmp LA650 ; reset buffer pointers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
356 ; Send byte to line printer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
357 LA2BF pshs x,b,a,cc ; save registers and interrupt status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
358 orcc #0x50 ; disable interrupts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
359 LA2C3 ldb PIA1+2 ; get RS232 status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
360 lsrb ; get status to C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
361 bcs LA2C3 ; brif busy - loop until not busy |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
362 bsr LA2FB ; set output to marking |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
363 clrb ; transmit one start bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
364 bsr LA2FD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
365 ldb #8 ; counter for 8 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
366 LA2D0 pshs b ; save bit count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
367 clrb ; zero output bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
368 lsra ; bet output bit to C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
369 rolb ; get output bit to correct bit for output byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
370 lslb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
371 bsr LA2FD ; transmit bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
372 puls b ; get back bit counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
373 decb ; are we done yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
374 bne LA2D0 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
375 bsr LA2FB ; send stop bit (marking) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
376 puls cc,a ; restore interrupt status and output character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
377 cmpa #0x0d ; carriage return? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
378 beq LA2ED ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
379 inc LPTPOS ; bump output position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
380 ldb LPTPOS ; get new position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
381 cmpb LPTWID ; end of line? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
382 blo LA2F3 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
383 LA2ED clr LPTPOS ; reset position to start of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
384 bsr LA305 ; do carriage return delay |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
385 bsr LA305 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
386 LA2F3 ldb PIA1+2 ; get RS232 status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
387 lsrb ; get status to C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
388 bcs LA2F3 ; brif still busy, keep waiting |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
389 puls b,x,pc ; restore registers and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
390 LA2FB ldb #2 ; set output to high (marking) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
391 LA2FD stb PIA1 ; set RS232 output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
392 bsr LA302 ; do baud delay (first iteration) then fall through for second |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
393 LA302 ldx LPTBTD ; get buard rate delay constant |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
394 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
395 LA305 ldx LPTLND ; get carriage return delay constant |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
396 jmp LA7D3 ; count X down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
397 ; Output character to screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
398 LA30A pshs x,b,a ; save registers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
399 ldx CURPOS ; get cursor pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
400 cmpa #0x08 ; backspace? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
401 bne LA31D ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
402 cmpx #VIDRAM ; at top of screen? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
403 beq LA35D ; brif so - it's a no-op |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
404 lda #0x60 ; VDG space character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
405 sta ,-x ; put a space at previous location and move pointer back |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
406 bra LA344 ; save new cursor position and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
407 LA31D cmpa #0x0d ; carriage return? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
408 bne LA32F ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
409 ldx CURPOS ; get cursor pointer (why? we already have it) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
410 LA323 lda #0x60 ; VDG space character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
411 sta ,x+ ; put output space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
412 tfr x,d ; see if we at a multiple of 32 now |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
413 bitb #0x1f |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
414 bne LA323 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
415 bra LA344 ; go check for scrolling |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
416 LA32F cmpa #0x20 ; control character? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
417 blo LA35D ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
418 tsta ; is it graphics block? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
419 bmi LA342 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
420 cmpa #0x40 ; number or special? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
421 blo LA340 ; brif so (flip "case" bit) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
422 cmpa #0x60 ; upper case alpha? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
423 blo LA342 ; brif so - keep it unmodified |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
424 anda #0xdf ; clear bit 5 (inverse video) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
425 LA340 eora #0x40 ; flip inverse video bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
426 LA342 sta ,x+ ; output character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
427 LA344 stx CURPOS ; save new cursor position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
428 cmpx #VIDRAM+511 ; end of screen? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
429 bls LA35D ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
430 ldx #VIDRAM ; point to start of screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
431 LA34E ldd 32,x ; get two characters from next row |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
432 std ,x++ ; put them on this row |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
433 cmpx #VIDRAM+0x1e0 ; at start of last row on screen? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
434 blo LA34E ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
435 ldb #0x60 ; VDG space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
436 jsr LA92D ; blank out last line (borrow CLS's loop) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
437 LA35D puls a,b,x,pc ; restore registers and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
438 ; Set up device parameters for output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
439 LA35F jsr RVEC2 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
440 pshs x,b,a ; save registers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
441 clr PRTDEV ; flag device as a screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
442 lda DEVNUM ; get devicenumber |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
443 beq LA373 ; brif screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
444 inca ; is it tape? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
445 beq LA384 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
446 ldx LPTCFW ; get tab width and last tab stop for printer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
447 ldd LPTWID ; get line width and current position for printer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
448 bra LA37C ; set parameters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
449 LA373 ldb CURPOS+1 ; get LSB of cursor position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
450 andb #0x1f ; now we have the offset into the line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
451 ldx #0x1010 ; 16 character tab, position 16 is last tab stop |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
452 lda #32 ; screen is 32 characters wide |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
453 LA37C stx DEVCFW ; save tab width and last tab stop for active device |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
454 stb DEVPOS ; save line position for current device |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
455 sta DEVWID ; save line width for current device |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
456 puls a,b,x,pc ; restore registers and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
457 LA384 com PRTDEV ; flag device as non-display |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
458 ldx #0x0100 ; tab width is 1, last tab field is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
459 clra ; line width is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
460 clrb ; character position on line is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
461 bra LA37C ; go set parameters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
462 ; This is the line input routine used for reading lines for Basic, both in immediate mode and for |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
463 ; INPUT and LINE INPUT. Exit with C set if terminated by BREAK and C clear if terminated by ENTER. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
464 ; The actualy entry point is LA390. Note that this routine echoes to *all* devices. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
465 LA38D jsr LA928 ; clear screen (CLEAR key handling) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
466 LA390 jsr RVEC12 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
467 clr IKEYIM ; reset cached input character from BREAK check |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
468 ldx #LINBUF+1 ; point to line input buffer (input pointer) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
469 ldb #1 ; Number of characters in line (we start at 1 so BS handling is easier) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
470 LA39A jsr LA171 ; get an input character, only keep low 7 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
471 tst CINBFL ; is it EOF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
472 bne LA3CC ; brif EOF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
473 tst DEVNUM ; is it keyboard input? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
474 bne LA3C8 ; brif not - don't do line editing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
475 cmpa #0x0c ; form feed (CLEAR)? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
476 beq LA38D ; brif so - clear screen and reset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
477 cmpa #0x08 ; backspace? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
478 bne LA3B4 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
479 decb ; move back one character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
480 beq LA390 ; brif we were at the start of the line - reset and start again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
481 leax -1,x ; move input pointer back |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
482 bra LA3E8 ; echo the backspace and continue |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
483 LA3B4 cmpa #0x15 ; SHIFT-LEFT (kill line)? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
484 bne LA3C2 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
485 LA3B8 decb ; at start of line? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
486 beq LA390 ; brif so - reset and restart |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
487 lda #0x08 ; echo a backspace |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
488 jsr PUTCHR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
489 bra LA3B8 ; see if we've erased everything yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
490 LA3C2 cmpa #0x03 ; BREAK? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
491 orcc #1 ; set C if it is (only need Z for the next test |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
492 beq LA3CD ; brif BREAK - exit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
493 LA3C8 cmpa #0x0d ; ENTER (CR) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
494 bne LA3D9 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
495 LA3CC clra ; clear carry (it might not be clear on EOF) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
496 LA3CD pshs cc ; save ENTER/BREAK flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
497 jsr LB958 ; echo a carriage return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
498 clr ,x ; make sure we have a NUL at the end of the buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
499 ldx #LINBUF ; point to input buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
500 puls cc,pc ; restore ENTER/BREAK flag and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
501 LA3D9 cmpa #0x20 ; control character? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
502 blo LA39A ; brif so - skip it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
503 cmpa #'z+1 ; above z? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
504 bhs LA39A ; brif so - ignore it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
505 cmpb #LBUFMX ; is the buffer full? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
506 bhs LA39A ; brif so - ignore extra characters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
507 sta ,x+ ; put character in the buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
508 incb ; bump character count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
509 LA3E8 jsr PUTCHR ; echo character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
510 bra LA39A ; go handle next input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
511 ; Check if DEVNUM Is valid for reading. Raise FM error if open but not for reading. NO error if not open. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
512 LA3ED jsr RVEC5 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
513 lda DEVNUM ; get device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
514 beq LA415 ; brif keyboard - always valid |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
515 inca ; is it tape? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
516 bne LA403 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
517 lda FILSTA ; get tape file status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
518 bne LA400 ; brif file is open |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
519 LA3FB ldb #22*2 ; raise NO error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
520 jmp LAC46 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
521 LA400 deca ; is it in input mode? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
522 beq LA415 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
523 LA403 jmp LA616 ; raise FM error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
524 ; Check if DEVNUM is valid for writing. Raise FM error if open but not for writing. NO error if not open. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
525 LA406 jsr RVEC6 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
526 lda DEVNUM ; get device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
527 inca ; is it tape? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
528 bne LA415 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
529 lda FILSTA ; get file status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
530 beq LA3FB ; brif not open |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
531 deca ; is it open for reading? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
532 beq LA403 ; brif so - bad mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
533 LA415 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
534 ; CLOSE command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
535 CLOSE beq LA426 ; brif no file specified - close all files |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
536 jsr LA5A5 ; parse device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
537 LA41B bsr LA42D ; close specified file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
538 jsr GETCCH ; is there more? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
539 beq LA44B ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
540 jsr LA5A2 ; check for comma and parse another device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
541 bra LA41B ; go close this one |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
542 ; Close all files handler. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
543 LA426 jsr RVEC7 ; Yup. The RAM hook dance. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
544 lda #-1 ; start with tape file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
545 sta DEVNUM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
546 ; Close file specified in DEVNUM. Note that this never fails. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
547 LA42D jsr RVEC8 ; You know it. RAM hook. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
548 lda DEVNUM ; get device we're closing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
549 clr DEVNUM ; reset to screen/keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
550 inca ; is it tape? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
551 bne LA44B ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
552 lda FILSTA ; get file status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
553 cmpa #2 ; is it output? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
554 bne LA449 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
555 lda CINCTR ; is there anything waiting to be written? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
556 beq LA444 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
557 jsr LA2A8 ; write final block of data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
558 LA444 ldb #0xff ; write EOF block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
559 jsr LA2AA |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
560 LA449 clr FILSTA ; mark tape file closed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
561 LA44B rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
562 ; CSAVE command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
563 CSAVE jsr LA578 ; parse filename |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
564 jsr GETCCH ; see what we have after the file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
565 beq LA469 ; brif none |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
566 jsr LB26D ; make sure there's a comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
567 ldb #'A ; make sure there's an A after |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
568 jsr LB26F |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
569 bne LA44B ; brif not end of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
570 clra ; file type 0 (basic program) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
571 jsr LA65C ; write out header block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
572 lda #-1 ; set output to tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
573 sta DEVNUM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
574 clra ; set Z so we list the whole program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
575 jmp LIST ; go list the program to tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
576 LA469 clra ; file type 0 (basic program) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
577 ldx ZERO ; set to binary file mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
578 jsr LA65F ; write header block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
579 clr FILSTA ; close files |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
580 inc BLKTYP ; set block type to data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
581 jsr WRLDR ; write out a leader |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
582 ldx TXTTAB ; point to start of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
583 LA478 stx CBUFAD ; set buffer location |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
584 lda #255 ; block size to 255 bytes (max size) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
585 sta BLKLEN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
586 ldd VARTAB ; get end of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
587 subd CBUFAD ; how much is left? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
588 beq LA491 ; brif we have nothing left |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
589 cmpd #255 ; do we have a full block worth? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
590 bhs LA48C ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
591 stb BLKLEN ; save actual remainder as block length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
592 LA48C jsr SNDBLK ; write a block out |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
593 bra LA478 ; go do another block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
594 LA491 neg BLKTYP ; set block type to 0xff (EOF) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
595 clr BLKLEN ; no data in EOF block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
596 jmp LA7E7 ; write EOF, stop tape, and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
597 ; CLOAD and CLOADM commands |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
598 CLOAD clr FILSTA ; close tape file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
599 cmpa #'M ; is it ClOADM? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
600 beq LA4FE ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
601 leas 2,s ; clean up stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
602 jsr LA5C5 ; parse file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
603 jsr LA648 ; go find the file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
604 tst CASBUF+10 ; is it binary? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
605 beq LA4C8 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
606 lda CASBUF+9 ; is it ASCII? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
607 beq LA4CD ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
608 jsr LAD19 ; clear out existing program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
609 lda #-1 ; set up for reading from tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
610 sta DEVNUM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
611 inc FILSTA ; set tape file to input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
612 jsr LA635 ; go read first block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
613 jmp LAC7C ; go to immediate mode to read in the program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
614 ; This is the EOF handler for immediate mode. It's rather assinine for this to be located here. It is |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
615 ; probably an artifact of a substantially different code layout prior to compacting the ROM to fit in |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
616 ; 8K. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
617 LA4BF jsr RVEC13 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
618 jsr LA42D ; close file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
619 jmp LAC73 ; go back to immediate mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
620 LA4C8 lda CASBUF+8 ; get file type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
621 beq LA4D0 ; brif basic program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
622 LA4CD jmp LA616 ; raise FM error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
623 LA4D0 jsr LAD19 ; erase existing program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
624 jsr CASON ; start reading tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
625 ldx TXTTAB ; get start of program storage |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
626 LA4D8 stx CBUFAD ; set load address for block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
627 ldd CBUFAD ; get start of block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
628 inca ; bump by 256 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
629 jsr LAC37 ; check if there's room for a maximum sized block of 255 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
630 jsr GETBLK ; go read a block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
631 bne LA4F8 ; brif there was an error during reading |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
632 lda BLKTYP ; get type of block read |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
633 beq LA4F8 ; brif header block - IO error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
634 bpl LA4D8 ; brif data block - read another |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
635 stx VARTAB ; save new end of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
636 bsr LA53B ; stop tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
637 ldx #LABED-1 ; point to "OK" prompt |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
638 jsr LB99C ; show prompt |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
639 jmp LACE9 ; reset various things and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
640 LA4F8 jsr LAD19 ; clear out partial program load |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
641 LA4FB jmp LA619 ; raise IO error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
642 ; This is the CLOADM command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
643 LA4FE jsr GETNCH ; eat the "M" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
644 bsr LA578 ; parse file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
645 jsr LA648 ; go find the file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
646 LA505 ldx ZERO ; default offset is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
647 jsr GETCCH ; see if there's something after the file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
648 beq LA511 ; brif no offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
649 jsr LB26D ; make sure there's a comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
650 jsr LB73D ; evaluate offset to X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
651 LA511 lda CASBUF+8 ; get file mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
652 cmpa #2 ; M/L program? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
653 bne LA4CD ; brif not - FM error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
654 ldd CASBUF+11 ; get load address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
655 leau D,x ; add in offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
656 stu EXECJP ; set EXEC default address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
657 tst CASBUF+10 ; is it binary? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
658 bne LA4CD ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
659 ldd CASBUF+13 ; get load address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
660 leax d,x ; add in offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
661 stx CBUFAD ; set buffer address for loading |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
662 jsr CASON ; start up tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
663 LA52E jsr GETBLK ; read a block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
664 bne LA4FB ; brif error reading |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
665 stx CBUFAD ; save new load address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
666 tst BLKTYP ; set flags on block type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
667 beq LA4FB ; brif another header - IO error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
668 bpl LA52E ; brif it was data - read more |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
669 LA53B jmp LA7E9 ; turn off tape and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
670 ; The EXEC command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
671 EXEC beq LA545 ; brif no argument - use default address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
672 jsr LB73D ; evaluate EXEC address to X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
673 stx EXECJP ; set new default EXEC address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
674 LA545 jmp [EXECJP] ; transfer control to execution address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
675 ; Break check for LIST so it doesn't interrupt ASCII saves. Why is this here instead of with the rest of the break |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
676 ; check logic or packaged up with LIST? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
677 LA549 jsr RVEC11 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
678 lda DEVNUM ; get device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
679 inca ; is it tape? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
680 beq LA5A1 ; brif so - don't do break check |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
681 jmp LADEB ; do the actual break check |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
682 ; Evaluate an expression and make sure it is within the limits of the screen and sets the cursor position. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
683 ; This really should be located with the PRINT command. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
684 LA554 jsr LB3E4 ; evaluate a positive expression to D |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
685 subd #511 ; is it within bounds? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
686 lbhi LB44A ; brif not - error out |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
687 addd #VIDRAM+511 ; adjust to be within the screen (and undo the SUBD above) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
688 std CURPOS ; set cursor position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
689 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
690 ; INKEY$ function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
691 INKEY lda IKEYIM ; was a key down during break check? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
692 bne LA56B ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
693 jsr KEYIN ; poll the keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
694 LA56B clr IKEYIM ; reset the break check cache |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
695 sta FPA0+3 ; store result for later return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
696 lbne LB68F ; brif a key was down - return it as a string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
697 sta STRDES ; set string length to 0 (no key down) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
698 jmp LB69B ; return the NULL string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
699 ; Parse a filename |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
700 LA578 ldx #CFNBUF ; point to file name buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
701 clr ,x+ ; zero out file name length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
702 lda #0x20 ; space character to initialize file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
703 LA57F sta ,x+ ; put a space in the buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
704 cmpx #CASBUF ; at end of file name? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
705 bne LA57F ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
706 jsr GETCCH ; get input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
707 beq LA5A1 ; brif no name present |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
708 jsr LB156 ; evaluate the file name expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
709 jsr LB654 ; point to start of the file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
710 ldu #CFNBUF ; point to file name buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
711 stb ,u+ ; save string length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
712 beq LA5A1 ; brif empty - we're done |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
713 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
714 LA598 ldb #8 ; copy 8 bytes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
715 ; Move B bytes from (X) to (U) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
716 LA59A lda ,x+ ; copy a byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
717 sta ,u+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
718 decb ; done yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
719 bne LA59A ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
720 LA5A1 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
721 ; Parse a device number and check validity |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
722 LA5A2 jsr LB26D ; check for comma and SN error if not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
723 LA5A5 cmpa #'# ; do we have a #? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
724 bne LA5AB ; brif not (it's optional) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
725 jsr GETNCH ; munch the # |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
726 LA5AB jsr LB141 ; evaluate the expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
727 LA5AE jsr INTCNV ; convert it to an integer in D |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
728 rolb ; move sign of B into C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
729 adca #0 ; add sign of B to A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
730 bne LA61F ; brif A doesn't match the sign of B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
731 rorb ; restore B (ADCA will have set C if B was negative) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
732 stb DEVNUM ; set device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
733 jsr RVEC1 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
734 beq LA5C4 ; brif device number set to screen/keyboard (valid) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
735 bpl LA61F ; brif not negative (not valid) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
736 cmpb #-2 ; is it printer or tape? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
737 blt LA61F ; brif not (not valid) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
738 LA5C4 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
739 ; Read file name from the line and do an error if anything follows it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
740 LA5C5 bsr LA578 ; parse file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
741 jsr GETCCH ; set flags on current character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
742 LA5C9 beq LA5C4 ; brif nothing there - it's good |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
743 jmp LB277 ; raise SN error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
744 ; EOF functoin |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
745 EOF jsr RVEC14 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
746 lda DEVNUM ; get device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
747 pshs a ; save it (so we can restore it later) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
748 bsr LA5AE ; check the device number (which is in FPA0) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
749 jsr LA3ED ; check validity for reading |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
750 LA5DA clrb ; not EOF = 0 (FALSE) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
751 lda DEVNUM ; get device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
752 beq LA5E4 ; brif keyboard - never EOF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
753 tst CINCTR ; is there anything in the input buffer? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
754 bne LA5E4 ; brif so - not EOF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
755 comb ; set EOF flag to -1 (true) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
756 LA5E4 puls a ; get back original device |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
757 sta DEVNUM ; restore it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
758 LA5E8 sex ; sign extend result to 16 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
759 jmp GIVABF ; go return the result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
760 ; SKIPF command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
761 SKIPF bsr LA5C5 ; parse file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
762 bsr LA648 ; look for the file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
763 jsr LA6D1 ; read the file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
764 bne LA619 ; brif error reading file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
765 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
766 ; OPEN command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
767 OPEN jsr RVEC0 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
768 jsr LB156 ; get file status (input/output) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
769 jsr LB6A4 ; get first character of status string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
770 pshs b ; save status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
771 bsr LA5A2 ; parse a comma then the device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
772 jsr LB26D ; make sure there's a comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
773 bsr LA5C5 ; parse the file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
774 lda DEVNUM ; get device number of the file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
775 clr DEVNUM ; reset actual device to the screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
776 puls b ; get back status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
777 cmpb #'I ; INPUT? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
778 beq LA624 ; brif so - open a file for INPUT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
779 cmpb #'O ; OUTPUT? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
780 beq LA658 ; brif so - open a file for OUTPUT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
781 LA616 ldb #21*2 ; raise FM error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
782 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
783 LA619 ldb #20*2 ; raise I/O error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
784 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
785 LA61C ldb #18*2 ; raise AO error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
786 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
787 LA61F ldb #19*2 ; raise DN error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
788 jmp LAC46 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
789 LA624 inca ; are we opening the tape? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
790 bmi LA616 ; brif printer - FM error; printer can't be opened for READ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
791 bne LA657 ; brif screen - screen is always open |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
792 bsr LA648 ; read header block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
793 lda CASBUF+9 ; clear A if binary or machine language file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
794 anda CASBUF+10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
795 beq LA616 ; bad file mode if not data file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
796 inc FILSTA ; open file for input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
797 LA635 jsr LA701 ; start tape, read block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
798 bne LA619 ; brif error during read |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
799 tst BLKTYP ; check block type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
800 beq LA619 ; brif header block - something's wrong |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
801 bmi LA657 ; brif EOF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
802 lda BLKLEN ; get length of block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
803 beq LA635 ; brif empty block - read another |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
804 LA644 sta CINCTR ; set buffer count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
805 bra LA652 ; reset buffer pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
806 LA648 tst FILSTA ; is the file open? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
807 bne LA61C ; brif so - AO error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
808 bsr LA681 ; search for file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
809 bne LA619 ; brif error on read |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
810 LA650 clr CINCTR ; mark buffer empty |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
811 LA652 ldx #CASBUF ; set buffer pointer to start of buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
812 stx CINPTR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
813 LA657 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
814 LA658 inca ; check for tape device |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
815 bne LA657 ; brif not tape (nothing doing - it's always open) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
816 inca ; make file type 1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
817 LA65C ldx #0xffff ; ASCII and data mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
818 LA65F tst FILSTA ; is file open? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
819 bne LA61C ; brif so - raise error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
820 ldu #CASBUF ; point to tape buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
821 stu CBUFAD ; set address of block to write |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
822 sta 8,u ; set file type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
823 stx 9,u ; set ASCII flag and mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
824 ldx #CFNBUF+1 ; point to file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
825 jsr LA598 ; move file name to the tape buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
826 clr BLKTYP ; set for header block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
827 lda #15 ; 15 bytes in a header block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
828 sta BLKLEN ; set block length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
829 jsr LA7E5 ; write the block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
830 lda #2 ; set file type to output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
831 sta FILSTA |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
832 bra LA650 ; reset file pointers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
833 ; Search for correct cassette file name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
834 LA681 ldx #CASBUF ; point to cassette buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
835 stx CBUFAD ; set location to read blocks to |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
836 LA686 lda CURLIN ; are we in immediate mode? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
837 inca |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
838 bne LA696 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
839 jsr LA928 ; clear screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
840 ldx CURPOS ; get start of screen (set after clear) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
841 ldb #'S ; for "searching" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
842 stb ,x++ ; put it on the screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
843 stx CURPOS ; save cursor position to be one past the search indicator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
844 LA696 bsr LA701 ; read a block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
845 orb BLKTYP ; merge error flag with block type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
846 bne LA6D0 ; brif error or not header |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
847 ldx #CASBUF ; point to block just read |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
848 ldu #CFNBUF+1 ; point to the desired name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
849 ldb #8 ; compare 8 characters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
850 clr ,-s ; set flag to "match" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
851 LA6A6 lda ,x+ ; get character from just read block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
852 ldy CURLIN ; immediate mode? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
853 leay 1,y |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
854 bne LA6B4 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
855 clr DEVNUM ; set output to screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
856 jsr PUTCHR ; display character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
857 LA6B4 suba ,u+ ; subtract from desired file name (nonzero if no match) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
858 ora ,s ; merge with match flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
859 sta ,s ; save new match flag (will be nonzero if any character differs) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
860 decb ; done all characters? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
861 bne LA6A6 ; brif not - do another |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
862 lda ,s+ ; get match flag (and set flags) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
863 beq LA6CB ; brif we have a match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
864 tst -9,u ; did we actually have a file name or will any file do? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
865 beq LA6CB ; brif any file will do |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
866 bsr LA6D1 ; go read past the file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
867 bne LA6D0 ; return on error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
868 bra LA686 ; keep looking |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
869 LA6CB lda #'F ; for "found" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
870 bsr LA6F8 ; put "F" on screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
871 clra ; set Z to indicat eno errors |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
872 LA6D0 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
873 LA6D1 tst CASBUF+10 ; check type of file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
874 bne LA6DF ; brif "blocked" file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
875 jsr CASON ; turn on tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
876 LA6D9 bsr GETBLK ; read a block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
877 bsr LA6E5 ; error or EOF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
878 bra LA6D9 ; read another block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
879 LA6DF bsr LA701 ; read a single block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
880 bsr LA6E5 ; error or EOF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
881 bra LA6DF ; read another block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
882 LA6E5 bne LA6ED ; got error reading block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
883 lda BLKTYP ; check block type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
884 nega ; A is 0 now if EOF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
885 bmi LA700 ; brif not end of file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
886 deca ; clear error indicator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
887 LA6ED sta CSRERR ; set error flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
888 leas 2,s ; don't return to original caller |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
889 bra LA705 ; turn off motor and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
890 LA6F3 lda VIDRAM ; get first char on screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
891 eora #0x40 ; flip case |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
892 LA6F8 ldb CURLIN ; immediate mode? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
893 incb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
894 bne LA700 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
895 sta VIDRAM ; save flipped case character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
896 LA700 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
897 ; Read a single block from tape (for a "blocked" file) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
898 LA701 bsr CASON ; start tape going |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
899 bsr GETBLK ; read block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
900 LA705 jsr LA7E9 ; stop tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
901 ldb CSRERR ; get error status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
902 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
903 ; Read a block from tape - this does the heavy lifting |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
904 GETBLK orcc #0x50 ; disable interrupts (timing is important) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
905 bsr LA6F3 ; reverse video of upper left character in direct mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
906 ldx CBUFAD ; point to destination buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
907 clra ; reset read byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
908 LA712 bsr LA755 ; read a bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
909 rora ; move bit into accumulator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
910 cmpa #0x3c ; have we synched on the start of the block data yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
911 bne LA712 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
912 bsr LA749 ; read block type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
913 sta BLKTYP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
914 bsr LA749 ; get block size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
915 sta BLKLEN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
916 adda BLKTYP ; accumulate checksum |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
917 sta CCKSUM ; save current checksum |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
918 lda BLKLEN ; get back count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
919 sta CSRERR ; initialize counter; we use this since it will be ovewritten later anyway |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
920 beq LA73B ; brif empty block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
921 LA72B bsr LA749 ; read a byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
922 sta ,x ; save in buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
923 cmpa ,x+ ; make sure it wrote |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
924 bne LA744 ; brif error if it didn't match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
925 adda CCKSUM ; accumulate checksum |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
926 sta CCKSUM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
927 dec CSRERR ; read all bytes? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
928 bne LA72B ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
929 LA73B bsr LA749 ; read checksum from tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
930 suba CCKSUM ; does it match? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
931 beq LA746 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
932 lda #1 ; checksum error flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
933 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
934 LA744 lda #2 ; non-RAM error flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
935 LA746 sta CSRERR ; save error status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
936 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
937 LA749 lda #8 ; read 8 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
938 sta CPULWD ; initialize counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
939 LA74D bsr LA755 ; read a bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
940 rora ; put it into accumulator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
941 dec CPULWD ; got all 8 bits? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
942 bne LA74D ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
943 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
944 LA755 bsr LA75D ; get time between transitions |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
945 ldb CPERTM ; get timer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
946 decb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
947 cmpb CMPMID ; set C if timer is below the transition point - high or 1; clear otherwise |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
948 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
949 LA75D clr CPERTM ; reset timer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
950 tst CBTPHA ; check which phase we synched on |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
951 bne LA773 ; brif HI-LO synch |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
952 LA763 bsr LA76C ; read input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
953 bcs LA763 ; brif still high |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
954 LA767 bsr LA76C ; read input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
955 bcc LA767 ; brif still low |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
956 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
957 LA76C inc CPERTM ; bump timer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
958 ldb PIA1 ; get input bit to C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
959 rorb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
960 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
961 LA773 bsr LA76C ; read input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
962 bcc LA773 ; brif still low |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
963 LA777 bsr LA76C ; read output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
964 bcs LA777 ; brif still high |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
965 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
966 ; Start tape and look for sync bytes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
967 CASON orcc #0x50 ; disable interrupts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
968 bsr LA7CA ; turn on tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
969 clr CPULWD ; reset timer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
970 LA782 bsr LA763 ; wait for low-high transition |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
971 LA784 bsr LA7AD ; wait for it to go low again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
972 bhi LA797 ; brif in range for 1200 Hz |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
973 LA788 bsr LA7A7 ; wait for it to go high again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
974 blo LA79B ; brif in range for 2400 Hz |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
975 dec CPULWD ; decrement counter (synched on low-high) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
976 lda CPULWD ; get counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
977 cmpa #-96 ; have we seen 96 1-0-1-0 patterns (48 0x55s)? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
978 LA792 bne LA782 ; brif not - wait some more |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
979 sta CBTPHA ; save phase we synched on |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
980 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
981 LA797 bsr LA7A7 ; wait for it to go high again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
982 bhi LA784 ; brif another 1200 Hz, 2 in a row, try again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
983 LA79B bsr LA7AD ; wait for it to go low again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
984 blo LA788 ; brif another 2400 Hz; go try again for high |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
985 inc CPULWD ; bump counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
986 lda CPULWD ; get counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
987 suba #96 ; set 0 if we've seen enought 0-1-0-1 patterns (0xaa) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
988 bra LA792 ; set phase and return or keep waiting |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
989 LA7A7 clr CPERTM ; reset period timer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
990 bsr LA767 ; wait for high |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
991 bra LA7B1 ; set flags on result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
992 LA7AD clr CPERTM ; reset period timer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
993 bsr LA777 ; wait for low |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
994 LA7B1 ldb CPERTM ; get period count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
995 cmpb CMP0 ; is it too long for 1200Hz? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
996 bhi LA7BA ; brif so - reset counts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
997 cmpb CMP1 ; set C if 2400Hz, clear C if 1200 Hz |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
998 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
999 LA7BA clr CPULWD ; reset sync counter (too slow or drop out) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1000 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1001 ; MOTOR command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1002 MOTOR tfr a,b ; save ON/OFF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1003 jsr GETNCH ; eat the ON/OFF token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1004 cmpb #0xaa ; OFF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1005 beq LA7E9 ; brif so - turn off tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1006 cmpb #0x88 ; ON? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1007 jsr LA5C9 ; SN error if no match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1008 ; Turn on tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1009 LA7CA lda PIA1+1 ; get motor control value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1010 ora #8 ; turn on bit 3 (starts motor) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1011 bsr LA7F0 ; put it back (dumb but it saves a byte) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1012 LA7D1 ldx ZERO ; maximum delay timer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1013 LA7D3 leax -1,x ; count down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1014 bne LA7D3 ; brif not at 0 yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1015 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1016 ; Write a synch leader to tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1017 WRLDR orcc #0x50 ; disable interrupts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1018 bsr LA7CA ; turn on tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1019 ldx SYNCLN ; get count of 0x55s to write |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1020 LA7DE bsr LA828 ; write a 0x55 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1021 leax -1,x ; done? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1022 bne LA7DE ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1023 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1024 ; Write sync bytes and a block, then stop tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1025 LA7E5 bsr WRLDR ; write sync |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1026 LA7E7 bsr SNDBLK ; write block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1027 ; Turn off tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1028 LA7E9 andcc #0xaf ; enable interrupts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1029 lda PIA1+1 ; get control register |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1030 anda #0xf7 ; disable motor bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1031 LA7F0 sta PIA1+1 ; set motor enable bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1032 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1033 ; Write a block to tape. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1034 SNDBLK orcc #0x50 ; disable interrupts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1035 ldb BLKLEN ; get block size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1036 stb CSRERR ; initialize character counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1037 lda BLKLEN ; initialize checksum |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1038 beq LA805 ; brif empty block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1039 ldx CBUFAD ; point to tape buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1040 LA800 adda ,x+ ; accumulate checksum |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1041 decb ; end of block data? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1042 bne LA800 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1043 LA805 adda BLKTYP ; accumulate block type into checksum |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1044 sta CCKSUM ; save calculated checksum |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1045 ldx CBUFAD ; point to buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1046 bsr LA828 ; send a 0x55 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1047 lda #0x3c ; and then a 0x3c |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1048 bsr LA82A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1049 lda BLKTYP ; send block type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1050 bsr LA82A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1051 lda BLKLEN ; send block size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1052 bsr LA82A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1053 tsta ; empty block? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1054 beq LA824 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1055 LA81C lda ,x+ ; send character from block data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1056 bsr LA82A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1057 dec CSRERR ; are we done yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1058 bne LA81C ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1059 LA824 lda CCKSUM ; send checksum |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1060 bsr LA82A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1061 LA828 lda #0x55 ; send a 0x55 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1062 LA82A pshs a ; save output byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1063 ldb #1 ; initialize bit probe |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1064 LA82E lda CLSTSN ; get ending value of last cycle |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1065 sta PIA1 ; set DA |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1066 ldy #LA85C ; point to sine wave table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1067 bitb ,s ; is bit set? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1068 bne LA848 ; brif so - do high frequency |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1069 LA83B lda ,y+ ; get next sample (use all for low frequency) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1070 cmpy #LA85C+36 ; end of table? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1071 beq LA855 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1072 sta PIA1 ; set output sample |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1073 bra LA83B ; do another sample |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1074 LA848 lda ,y++ ; get next sample (use every other for high frequency) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1075 cmpy #LA85C+36 ; end of table? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1076 beq LA855 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1077 sta PIA1 ; send output sample |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1078 bra LA848 ; do another sample |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1079 LA855 sta CLSTSN ; save last sample that *would* have been sent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1080 lslb ; shift mask to next bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1081 bcc LA82E ; brif not done all 8 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1082 puls a,pc ; get back original character and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1083 ; This is the sample table for the tape sine wave |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1084 LA85C fcb 0x82,0x92,0xaa,0xba,0xca,0xda |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1085 fcb 0xea,0xf2,0xfa,0xfa,0xfa,0xf2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1086 fcb 0xea,0xda,0xca,0xba,0xaa,0x92 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1087 fcb 0x7a,0x6a,0x52,0x42,0x32,0x22 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1088 fcb 0x12,0x0a,0x02,0x02,0x02,0x0a |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1089 fcb 0x12,0x22,0x32,0x42,0x52,0x6a |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1090 ; SET command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1091 SET bsr LA8C1 ; get absolute screen position of graphics block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1092 pshs x ; save character location |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1093 jsr LB738 ; evaluate comma then expression in B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1094 puls x ; get back character pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1095 cmpb #8 ; valid colour? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1096 bhi LA8D5 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1097 decb ; normalize colours |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1098 bmi LA895 ; brif colour 0 (use current colour) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1099 lda #0x10 ; 16 patterns per colour |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1100 mul |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1101 bra LA89D ; go save the colour |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1102 LA895 ldb ,x ; get current value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1103 bpl LA89C ; brif not grahpic |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1104 andb #0x70 ; keep only the colour |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1105 skip1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1106 LA89C clrb ; reset block to all black |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1107 LA89D pshs b ; save colour |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1108 bsr LA90D ; force a ) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1109 lda ,x ; get current screen value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1110 bmi LA8A6 ; brif graphic block already |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1111 clra ; force all pixels off |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1112 LA8A6 anda #0x0f ; keep only pixel data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1113 ora GRBLOK ; set the desired pixel |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1114 ora ,s+ ; merge with desired colour |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1115 LA8AC ora #0x80 ; force it to be a graphic block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1116 sta ,x ; put new block on screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1117 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1118 ; RESET command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1119 RESET bsr LA8C1 ; get address of desired block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1120 bsr LA90D ; force a ) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1121 clra ; zero block (no pixels) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1122 ldb ,x ; is it graphics? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1123 bpl LA8AC ; brif not - just blank the block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1124 com GRBLOK ; invert pixel data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1125 andb GRBLOK ; turn off the desired pixel |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1126 stb ,x ; put new pixel data on screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1127 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1128 ; Parse SET/RESET/POINT coordinates except for closing ) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1129 LA8C1 jsr LB26A ; make sure it starts with ( |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1130 LA8C4 jsr RVEC21 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1131 jsr LB70B ; get first coordinate |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1132 cmpb #63 ; valid horizontal coordinate |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1133 bhi LA8D5 ; brif out of range |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1134 pshs b ; save horizontal coordinate |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1135 jsr LB738 ; look for , followed by vertical coordinate |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1136 cmpb #31 ; in range for vertical? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1137 LA8D5 bhi LA948 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1138 pshs b ; save vertical coordinate |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1139 lsrb ; divide by two (two blocks per row) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1140 lda #32 ; 32 bytes per row |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1141 mul ; now we have the offset into video RAM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1142 ldx #VIDRAM ; point to start of screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1143 leax d,x ; now X points to the correct character row |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1144 ldb 1,s ; get horizontal coordinate |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1145 lsrb ; divide by two (two per character cell) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1146 abx ; now we're pointing to the correct character cell |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1147 puls a,b ; get back coordinates (vertical in A) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1148 anda #1 ; keep only row offset of vertical |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1149 rorb ; get column offset of horizontal to C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1150 rola ; now we have "row * 2 + col" in A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1151 ldb #0x10 ; make a bit mask (one bit left of first pixel) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1152 LA8EE lsrb ; move mask right |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1153 deca ; at the right pixel? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1154 bpl LA8EE ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1155 stb GRBLOK ; save graphics block mask |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1156 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1157 ; POINT function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1158 POINT bsr LA8C4 ; evaluate coordinates |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1159 ldb #0xff ; default colour value is -1 (not graphics) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1160 lda ,x ; get character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1161 bpl LA90A ; brif not graphics |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1162 anda GRBLOK ; is desired pixel set? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1163 beq LA909 ; brif not - return 0 for "black" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1164 ldb ,x ; get graphics data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1165 lsrb ; shift right 4 to get colour in low bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1166 lsrb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1167 lsrb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1168 lsrb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1169 andb #7 ; lose the graphics block bias |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1170 LA909 incb ; shift colours into 1 to 8 range |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1171 LA90A jsr LA5E8 ; convert B to floating point |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1172 LA90D jmp LB267 ; make sure we have a ) and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1173 ; CLS command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1174 CLS jsr RVEC22 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1175 LA913 beq LA928 ; brif no colour - just do a basic screen clear |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1176 jsr LB70B ; evaluate colour number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1177 cmpb #8 ; valid colour? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1178 bhi LA937 ; brif not - do the easter egg |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1179 tstb ; color 0? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1180 beq LA925 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1181 decb ; normalize to 0 based colour numbers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1182 lda #0x10 ; 16 blocks per colour |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1183 mul ; now we have the base code for that colour |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1184 orb #0x0f ; set all pixels |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1185 LA925 orb #0x80 ; make it a graphics block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1186 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1187 LA928 ldb #0x60 ; VDG screen space character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1188 ldx #VIDRAM ; point to start of screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1189 LA92D stx CURPOS ; set cursor position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1190 LA92F stb ,x+ ; blank a character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1191 cmpx #VIDRAM+511 ; end of screen? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1192 bls LA92F ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1193 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1194 LA937 bsr LA928 ; clear te screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1195 ldx #LA166-1 ; point to the easter egg |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1196 jmp LB99C ; go display it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1197 ; Evaluate an expression to B, prefixed by a comma, and do FC error if 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1198 LA93F jsr LB26D ; force a comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1199 LA942 jsr LB70B ; evaluate expression to B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1200 tstb ; is it 0? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1201 bne LA984 ; brif not - return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1202 LA948 jmp LB44A ; raise FC error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1203 ; SOUND command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1204 SOUND bsr LA942 ; evaluate frequency |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1205 stb SNDTON ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1206 bsr LA93F ; evaluate duration (after a comma) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1207 LA951 lda #4 ; constant factor for duration (each increment is 1/15 of a second) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1208 mul |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1209 std SNDDUR ; save length of sound (IRQ will count it down) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1210 lda PIA0+3 ; enable 60 Hz interrupt |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1211 ora #1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1212 sta PIA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1213 clr ARYDIS ; clear array disable flag for some reason |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1214 bsr LA9A2 ; connect DAC to MUX output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1215 bsr LA976 ; turn on sound |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1216 LA964 bsr LA985 ; store mid range output value and delay |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1217 lda #0xfe ; store high value and delay |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1218 bsr LA987 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1219 bsr LA985 ; store mid range value and delay |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1220 lda #2 ; store low value and delay |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1221 bsr LA987 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1222 ldx SNDDUR ; has timer expired? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1223 bne LA964 ; brif not, do another wave |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1224 ; Disable sound output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1225 LA974 clra ; bit 3 to 0 will disable output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1226 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1227 ; Enable sound output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1228 LA976 lda #8 ; bit 3 set to enable output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1229 sta ,-s ; save desired value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1230 lda PIA1+3 ; get control register value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1231 anda #0xf7 ; reset value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1232 ora ,s+ ; set to desired value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1233 sta PIA1+3 ; set new sound output status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1234 LA984 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1235 LA985 lda #0x7e ; mid range value for DAC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1236 LA987 sta PIA1 ; set DAC output value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1237 lda SNDTON ; get frequency |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1238 LA98C inca ; increment it (gives shorter count with higher values, so higher frequencies work) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1239 bne LA98C ; brif not done yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1240 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1241 ; AUDIO command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1242 AUDIO tfr a,b ; save ON/OFF token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1243 jsr GETNCH ; munch the ON/OFF token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1244 cmpb #0xaa ; OFF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1245 beq LA974 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1246 subb #0x88 ; ON? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1247 jsr LA5C9 ; do SN error if not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1248 incb ; now B is 1 - cassette sound source |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1249 bsr LA9A2 ; set MUX input to tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1250 bra LA976 ; enable sound |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1251 ; Set MUX source to value in B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1252 LA9A2 ldu #PIA0+1 ; point to PIA0 control register A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1253 bsr LA9A7 ; program bit 0 then fall through for bit 1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1254 LA9A7 lda ,u ; get control register value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1255 anda #0xf7 ; reset mux control bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1256 asrb ; shift desired value to C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1257 bcc LA9B0 ; brif this bit is clear |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1258 ora #8 ; set the bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1259 LA9B0 sta ,u++ ; set register value and move to next register |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1260 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1261 ; IRQ service routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1262 BIRQSV lda PIA0+3 ; check for VSYNC interrupt |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1263 bpl LA9C5 ; brif not - return. BUG: should clear HSYNC interrupt status first |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1264 lda PIA0+2 ; clear VSYNC interrupt status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1265 ldx >SNDDUR ; are we counting down for SOUND? (force extended in case DP is modified) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1266 beq LA9C5 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1267 leax -1,x ; count down one tick |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1268 stx >SNDDUR ; save new count (forced extended in case DP is modified) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1269 LA9C5 rti |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1270 ; JOYSTK function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1271 JOYSTK jsr LB70E ; evaluate which joystick axis is desired |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1272 cmpb #3 ; valid axis? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1273 lbhi LB44A ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1274 tstb ; want axis 0? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1275 bne LA9D4 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1276 bsr GETJOY ; read axis data if axis 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1277 LA9D4 ldx #POTVAL ; point to axis values |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1278 ldb FPA0+3 ; get desired axis |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1279 ldb b,x ; get axis value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1280 jmp LB4F3 ; return value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1281 ; Read all four joystick axes. Note that this routine will try 10 times to get a value that matches |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1282 ; the value obtained during the *previous call to this routine*. Thus, if the axis value has changed, |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1283 ; this routine will do the read *ten times* before just returning the last value. This is assininely |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1284 ; slow and probably a bug since it seems more logical to look for two matching reads in a row. Note |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1285 ; also that this routine should be using PSHS and PULS but it doesn't. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1286 GETJOY bsr LA974 ; turn off sound |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1287 ldx #POTVAL+4 ; point to the end of the axis data (we'll work backwards) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1288 ldb #3 ; start with axis 3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1289 LA9E5 lda #10 ; 10 tries to see if we match *the last call* to this routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1290 std ,--s ; save retry counter and axis number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1291 bsr LA9A2 ; set MUX for the correct axis |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1292 LA9EB ldd #0x4080 ; set initial trial value to mid range and the next difference to add/subtract to half |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1293 LA9EE sta ,-s ; store the add/subtract value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1294 orb #2 ; keep rs232 output marking |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1295 stb PIA1 ; set DAC output to the trial value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1296 eorb #2 ; remove RS232 output value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1297 lda PIA0 ; read the comparator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1298 bmi LA9FF ; brif comparator output is high (DAC is lower than the axis value) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1299 subb ,s ; subtract next bit value (split the difference toward 0) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1300 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1301 LA9FF addb ,s ; add next bit value (split the different toward infinity) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1302 lda ,s+ ; get bit value back |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1303 lsra ; cut in half |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1304 cmpa #1 ; have we done that last value for the DAC? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1305 bne LA9EE ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1306 lsrb ; normalize the axis value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1307 lsrb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1308 cmpb -1,x ; does it match the read from the last call to this routine? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1309 beq LAA12 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1310 dec ,s ; are we out of retries? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1311 bne LA9EB ; brif not - try again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1312 LAA12 stb ,-x ; save new value and move pointer back |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1313 ldd ,s++ ; get axis counter and clean up retry counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1314 decb ; move to next axis |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1315 bpl LA9E5 ; brif still more axes to do |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1316 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1317 ; This is the "bottom half" of the character fetching routines. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1318 BROMHK cmpa #'9+1 ; is it >= colon? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1319 bhs LAA28 ; brif so Z set if colon, C clear. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1320 cmpa #0x20 ; space? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1321 bne LAA24 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1322 jmp GETNCH ; move on to another character if space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1323 LAA24 suba #'0 ; normalize ascii digit to 0-9; we already handled above digit 9 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1324 suba #-'0 ; this will cause a carry for any value that was already positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1325 LAA28 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1326 ; Jump table for functions |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1327 LAA29 fdb SGN ; SGN 0x80 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1328 fdb INT ; INT 0x81 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1329 fdb ABS ; ABS 0x82 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1330 fdb USRJMP ; USR 0x83 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1331 fdb RND ; RND 0x84 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1332 fdb SIN ; SIN 0x85 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1333 fdb PEEK ; PEEK 0x86 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1334 fdb LEN ; LEN 0x87 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1335 fdb STR ; STR$ 0x88 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1336 fdb VAL ; VAL 0x89 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1337 fdb ASC ; ASC 0x8a |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1338 fdb CHR ; CHR$ 0x8b |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1339 fdb EOF ; EOF 0x8c |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1340 fdb JOYSTK ; JOYSTK 0x8d |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1341 fdb LEFT ; LEFT$ 0x8e |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1342 fdb RIGHT ; RIGHT$ 0x8f |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1343 fdb MID ; MID$ 0x90 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1344 fdb POINT ; POINT 0x91 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1345 fdb INKEY ; INKEY$ 0x92 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1346 fdb MEM ; MEM 0x93 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1347 ; Operator precedence and jump table (binary ops except relational) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1348 LAA51 fcb 0x79 ; + |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1349 fdb LB9C5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1350 fcb 0x79 ; - |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1351 fdb LB9BC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1352 fcb 0x7b ; * |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1353 fdb LBACC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1354 fcb 0x7b ; / |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1355 fdb LBB91 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1356 fcb 0x7f ; ^ (exponentiation) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1357 fdb EXPJMP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1358 fcb 0x50 ; AND |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1359 fdb LB2D5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1360 fcb 0x46 ; OR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1361 fdb LB2D4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1362 ; Reserved words table for commands |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1363 LAA66 fcs 'FOR' ; 0x80 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1364 fcs 'GO' ; 0x81 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1365 fcs 'REM' ; 0x82 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1366 fcs "'" ; 0x83 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1367 fcs 'ELSE' ; 0x84 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1368 fcs 'IF' ; 0x85 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1369 fcs 'DATA' ; 0x86 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1370 fcs 'PRINT' ; 0x87 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1371 fcs 'ON' ; 0x88 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1372 fcs 'INPUT' ; 0x89 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1373 fcs 'END' ; 0x8a |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1374 fcs 'NEXT' ; 0x8b |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1375 fcs 'DIM' ; 0x8c |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1376 fcs 'READ' ; 0x8d |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1377 fcs 'RUN' ; 0x8e |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1378 fcs 'RESTORE' ; 0x8f |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1379 fcs 'RETURN' ; 0x90 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1380 fcs 'STOP' ; 0x91 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1381 fcs 'POKE' ; 0x92 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1382 fcs 'CONT' ; 0x93 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1383 fcs 'LIST' ; 0x94 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1384 fcs 'CLEAR' ; 0x95 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1385 fcs 'NEW' ; 0x96 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1386 fcs 'CLOAD' ; 0x97 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1387 fcs 'CSAVE' ; 0x98 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1388 fcs 'OPEN' ; 0x99 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1389 fcs 'CLOSE' ; 0x9a |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1390 fcs 'LLIST' ; 0x9b |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1391 fcs 'SET' ; 0x9c |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1392 fcs 'RESET' ; 0x9d |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1393 fcs 'CLS' ; 0x9e |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1394 fcs 'MOTOR' ; 0x9f |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1395 fcs 'SOUND' ; 0xa0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1396 fcs 'AUDIO' ; 0xa1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1397 fcs 'EXEC' ; 0xa2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1398 fcs 'SKIPF' ; 0xa3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1399 fcs 'TAB(' ; 0xa4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1400 fcs 'TO' ; 0xa5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1401 fcs 'SUB' ; 0xa6 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1402 fcs 'THEN' ; 0xa7 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1403 fcs 'NOT' ; 0xa8 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1404 fcs 'STEP' ; 0xa9 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1405 fcs 'OFF' ; 0xaa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1406 fcs '+' ; 0xab |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1407 fcs '-' ; 0xac |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1408 fcs '*' ; 0xad |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1409 fcs '/' ; 0xae |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1410 fcs '^' ; 0xaf |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1411 fcs 'AND' ; 0xb0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1412 fcs 'OR' ; 0xb1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1413 fcs '>' ; 0xb2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1414 fcs '=' ; 0xb3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1415 fcs '<' ; 0xb4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1416 ; Reserved word list for functions |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1417 LAB1A fcs 'SGN' ; 0x80 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1418 fcs 'INT' ; 0x81 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1419 fcs 'ABS' ; 0x82 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1420 fcs 'USR' ; 0x83 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1421 fcs 'RND' ; 0x84 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1422 fcs 'SIN' ; 0x85 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1423 fcs 'PEEK' ; 0x86 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1424 fcs 'LEN' ; 0x87 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1425 fcs 'STR$' ; 0x88 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1426 fcs 'VAL' ; 0x89 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1427 fcs 'ASC' ; 0x8a |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1428 fcs 'CHR$' ; 0x8b |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1429 fcs 'EOF' ; 0x8c |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1430 fcs 'JOYSTK' ; 0x8d |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1431 fcs 'LEFT$' ; 0x8e |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1432 fcs 'RIGHT$' ; 0x8f |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1433 fcs 'MID$' ; 0x90 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1434 fcs 'POINT' ; 0x91 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1435 fcs 'INKEY$' ; 0x92 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1436 fcs 'MEM' ; 0x93 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1437 ; Jump table for commands |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1438 LAB67 fdb FOR ; 0x80 FOR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1439 fdb GO ; 0x81 GO |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1440 fdb REM ; 0x82 REM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1441 fdb REM ; 0x83 ' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1442 fdb REM ; 0x84 ELSE |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1443 fdb IFTOK ; 0x85 IF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1444 fdb DATA ; 0x86 DATA |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1445 fdb PRINT ; 0x87 PRINT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1446 fdb ON ; 0x88 ON |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1447 fdb INPUT ; 0x89 INPUT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1448 fdb ENDTOK ; 0x8a END |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1449 fdb NEXT ; 0x8b NEXT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1450 fdb DIM ; 0x8c DIM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1451 fdb READ ; 0x8d READ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1452 fdb RUN ; 0x8e RUN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1453 fdb RESTOR ; 0x8f RESTORE |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1454 fdb RETURN ; 0x90 RETURN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1455 fdb STOP ; 0x91 STOP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1456 fdb POKE ; 0x92 POKE |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1457 fdb CONT ; 0x93 CONT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1458 fdb LIST ; 0x94 LIST |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1459 fdb CLEAR ; 0x95 CLEAR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1460 fdb NEW ; 0x96 NEW |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1461 fdb CLOAD ; 0x97 CLOAD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1462 fdb CSAVE ; 0x98 CSAVE |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1463 fdb OPEN ; 0x99 OPEN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1464 fdb CLOSE ; 0x9a CLOSE |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1465 fdb LLIST ; 0x9b LLIST |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1466 fdb SET ; 0x9c SET |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1467 fdb RESET ; 0x9d RESET |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1468 fdb CLS ; 0x9e CLS |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1469 fdb MOTOR ; 0x9f MOTOR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1470 fdb SOUND ; 0xa0 SOUND |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1471 fdb AUDIO ; 0xa1 AUDIO |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1472 fdb EXEC ; 0xa2 EXEC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1473 fdb SKIPF ; 0xa3 SKIPF |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1474 ; Error message table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1475 LABAF fcc 'NF' ; 0 NEXT without FOR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1476 fcc 'SN' ; 1 Syntax error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1477 fcc 'RG' ; 2 RETURN without GOSUB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1478 fcc 'OD' ; 3 Out of data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1479 fcc 'FC' ; 4 Illegal function call |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1480 fcc 'OV' ; 5 Overflow |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1481 fcc 'OM' ; 6 Out of memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1482 fcc 'UL' ; 7 Undefined line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1483 fcc 'BS' ; 8 Bad subscript |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1484 fcc 'DD' ; 9 Redimensioned array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1485 fcc '/0' ; 10 Division by 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1486 fcc 'ID' ; 11 Illegal direct statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1487 fcc 'TM' ; 12 Type mismatch |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1488 fcc 'OS' ; 13 Out of string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1489 fcc 'LS' ; 14 String too long |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1490 fcc 'ST' ; 15 String formula too complex |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1491 fcc 'CN' ; 16 Can't continue |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1492 fcc 'FD' ; 17 Bad file data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1493 fcc 'AO' ; 18 File already open |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1494 fcc 'DN' ; 19 Device number error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1495 fcc 'IO' ; 20 Input/output error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1496 fcc 'FM' ; 21 Bad file mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1497 fcc 'NO' ; 22 File not open |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1498 fcc 'IE' ; 23 Input past end of file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1499 fcc 'DS' ; 24 Direct statement in file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1500 LABE1 fcn ' ERROR' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1501 LABE8 fcn ' IN ' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1502 LABED fcb 0x0d |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1503 LABEE fcc 'OK' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1504 fcb 0x0d,0x00 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1505 LABF2 fcb 0x0d |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1506 fcn 'BREAK' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1507 ; Search stack for a FOR/NEXT stack frame. Stop search when something that isn't a FOR/NEXT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1508 ; stack frame is found. Enter with the index variable descriptor pointer in VARDES, or NULL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1509 ; for the first match. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1510 ; |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1511 ; NOTE: this routine can be reworked to avoid needed two temporaries by taking advantage of the |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1512 ; 6809's registers. This requires some minor tweaks where the routine is called. Further, the |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1513 ; use of B is completely pointless and, even if B is going to be used, why is it reloaded on |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1514 ; every loop? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1515 LABF9 leax 4,s ; skip past our caller and the main command loop return address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1516 LABFB ldb #18 ; each FOR/NEXT frame is 18 bytes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1517 stx TEMPTR ; save current search pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1518 lda ,x ; get first byte of this frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1519 suba #0x80 ; set to 0 if FOR/NEXT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1520 bne LAC1A ; brif not FOR/NEXT (we hit the end of the stack for a GOSUB frame) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1521 ldx 1,x ; get index variable descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1522 stx TMPTR1 ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1523 ldx VARDES ; get desired index descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1524 beq LAC16 ; brif NULL - we found something |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1525 cmpx TMPTR1 ; does this one match? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1526 beq LAC1A ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1527 ldx TEMPTR ; get back frame pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1528 abx ; move to next entry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1529 bra LABFB ; check next block of data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1530 LAC16 ldx TMPTR1 ; get index variable of this frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1531 stx VARDES ; set it as the one found |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1532 LAC1A ldx TEMPTR ; get matching frame pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1533 tsta ; set Z if FOR/NEXT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1534 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1535 ; This is a block copy routine which copies from top to bottom. It's not clear that the use of |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1536 ; this routine actually saves any ROM space compared to just implementing the copies directly |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1537 ; once all the marshalling to set up the parameter variables is taken into account. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1538 LAC1E bsr LAC37 ; check to see if stack collides with D |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1539 LAC20 ldu V41 ; point to destination |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1540 leau 1,u ; offset for pre-dec |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1541 ldx V43 ; point to source |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1542 leax 1,x ; offset for pre-dec |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1543 LAC28 lda ,-x ; get source byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1544 pshu a ; store at destination (sta ,-u would be less weird) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1545 cmpx V47 ; at the bottom of the copy? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1546 bne LAC28 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1547 stu V45 ; save final destination address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1548 LAC32 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1549 ; Check for 2*B (0 <= B <= 127) bytes for free memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1550 LAC33 clra ; zero extend |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1551 aslb ; times 2 (loses bit 7 of B) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1552 addd ARYEND ; add to top of used memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1553 LAC37 addd #STKBUF ; add a fudge factor for interpreter operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1554 bcs LAC44 ; brif >65535! |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1555 sts BOTSTK ; get current stack pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1556 cmpd BOTSTK ; is our new address above that? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1557 blo LAC32 ; brif not - no error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1558 LAC44 ldb #6*2 ; raise OM error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1559 ; The error servicing routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1560 LAC46 jsr RVEC16 ; do the RAM hook dance (ON ERROR reserved hook) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1561 LAC49 jsr RVEC17 ; do the RAM hook dance again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1562 jsr LA7E9 ; turn off tape |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1563 jsr LA974 ; disable sound |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1564 jsr LAD33 ; reset stack, etc. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1565 clr DEVNUM ; reset output to screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1566 jsr LB95C ; do a newline |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1567 jsr LB9AF ; send a ? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1568 ldx #LABAF ; point to error table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1569 abx ; offset to correct message |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1570 bsr LACA0 ; send a char from X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1571 bsr LACA0 ; send another char from X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1572 ldx #LABE1-1 ; point to "ERROR" message |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1573 LAC68 jsr LB99C ; print ERROR message (or BREAK) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1574 lda CURLIN ; are we in immediate mode? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1575 inca |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1576 beq LAC73 ; brif not - go to immediate mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1577 jsr LBDC5 ; print "IN ****" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1578 ; This is the immediate mode loop |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1579 LAC73 jsr LB95C ; do a newline if needed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1580 LAC76 ldx #LABEE-1 ; point to prompt (without leading CR) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1581 jsr LB99C ; show prompt |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1582 LAC7C jsr LA390 ; read an input line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1583 ldu #0xffff ; flag immediate mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1584 stu CURLIN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1585 bcs LAC7C ; brif we ended on BREAK - just go for another line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1586 tst CINBFL ; EOF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1587 lbne LA4BF ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1588 stx CHARAD ; save start of input line as input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1589 jsr GETNCH ; get character from input line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1590 beq LAC7C ; brif no input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1591 bcs LACA5 ; brif numeric - adding or removing a line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1592 ldb #2*24 ; code for "direct statement in file" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1593 tst DEVNUM ; keyboard input? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1594 bne LAC46 ; brif not - complain about direct statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1595 jsr LB821 ; go tokenize the input line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1596 jmp LADC0 ; go execute the newly tokenized line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1597 LACA0 lda ,x+ ; get character and advance pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1598 jmp LB9B1 ; output it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1599 LACA5 jsr LAF67 ; convert line number to binary |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1600 ldx BINVAL ; get converted number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1601 stx LINHDR ; put it before the line we just read |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1602 jsr LB821 ; tokenize the input line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1603 stb TMPLOC ; save line length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1604 bsr LAD01 ; find where the line should be in the program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1605 bcs LACC8 ; brif the line number isn't already present |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1606 ldd V47 ; get address where the line is in the program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1607 subd ,x ; get the difference between here and the end of the line (negative) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1608 addd VARTAB ; subtract line length from the end of the program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1609 std VARTAB ; save new end of program address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1610 ldu ,x ; get start of next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1611 LACC0 pulu a ; get source byte (lda ,u+ would be less weird) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1612 sta ,x+ ; move it down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1613 cmpx VARTAB ; have we moved everything yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1614 bne LACC0 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1615 LACC8 lda LINBUF ; see if there is actually a line to input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1616 beq LACE9 ; brif not - we just needed to remove the line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1617 ldd VARTAB ; get current end of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1618 std V43 ; set as source pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1619 addb TMPLOC ; add in the length of the new line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1620 adca #0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1621 std V41 ; save destination pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1622 jsr LAC1E ; make sure there's enough room and then make a hole for the new line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1623 ldu #LINHDR-2 ; point to the line (well, 4 bytes before it, incl line number and fake next line pointer) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1624 LACDD pulu a ; get byte from new line (lda ,u+ would be less weird) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1625 sta ,x+ ; stow it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1626 cmpx V45 ; at the end of the hole we just made? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1627 bne LACDD ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1628 ldx V41 ; get save new top of program address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1629 stx VARTAB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1630 LACE9 bsr LAD21 ; reset variables, etc. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1631 bsr LACEF ; adjust next line pointers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1632 bra LAC7C ; go read another input line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1633 ; Recompute next line pointers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1634 LACEF ldx TXTTAB ; point to start of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1635 LACF1 ldd ,x ; get address of next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1636 beq LAD16 ; brif end of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1637 leau 4,x ; move past pointer and line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1638 LACF7 lda ,u+ ; are we at the end of the line? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1639 bne LACF7 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1640 stu ,x ; save new next line pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1641 ldx ,x ; point to next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1642 bra LACF1 ; process the next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1643 ; Find a line in the program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1644 LAD01 ldd BINVAL ; get desired line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1645 ldx TXTTAB ; point to start of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1646 LAD05 ldu ,x ; get address of next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1647 beq LAD12 ; brif end of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1648 cmpd 2,x ; do we have a match? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1649 bls LAD14 ; brif our search number is <= the number here |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1650 ldx ,x ; move to next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1651 bra LAD05 ; check another line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1652 LAD12 orcc #1 ; set C for not found |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1653 LAD14 stx V47 ; save address of matching line *or* line just after where it would have been |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1654 LAD16 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1655 ; NEW command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1656 ; This routine has multiple entry points used for various "levels" of NEW |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1657 NEW bne LAD14 ; brif there was input given; should be LAD16! |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1658 LAD19 ldx TXTTAB ; point to start of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1659 clr ,x+ ; blank out program (with NULL next line pointer) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1660 clr ,x+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1661 stx VARTAB ; save end of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1662 LAD21 ldx TXTTAB ; get start of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1663 jsr LAEBB ; put input pointer there |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1664 LAD26 ldx MEMSIZ ; reset string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1665 stx STRTAB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1666 jsr RESTOR ; reset DATA pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1667 ldx VARTAB ; clear out scalars and arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1668 stx ARYTAB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1669 stx ARYEND |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1670 LAD33 ldx #STRSTK ; reset the string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1671 stx TEMPPT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1672 ldx ,s ; get return address (we're going to reset the stack) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1673 lds FRETOP ; reset the stack to top of memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1674 clr ,-s ; put stopper so FOR/NEXT search will actually stop here |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1675 clr OLDPTR ; reset "CONT" state |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1676 clr OLDPTR+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1677 clr ARYDIS ; un-disable arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1678 jmp ,x ; return to original caller |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1679 ; FOR command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1680 FOR lda #0x80 ; disable array parsing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1681 sta ARYDIS |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1682 jsr LET ; assign start value to index |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1683 jsr LABF9 ; search stack for matching FOR/NEXT frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1684 leas 2,s ; lose return address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1685 bne LAD59 ; brif variable not already being used |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1686 ldx TEMPTR ; get address of matched data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1687 leas b,x ; move stack pointer to the end of it (B is set to 18 in the stack search) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1688 LAD59 ldb #9 ; is there room for 18 bytes in memory? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1689 jsr LAC33 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1690 jsr LAEE8 ; get address of the end of this statement in X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1691 ldd CURLIN ; get line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1692 pshs x,b,a ; save next line address and current line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1693 ldb #0xa5 ; make sure we have TO |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1694 jsr LB26F |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1695 jsr LB143 ; make sure we have a numeric index |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1696 jsr LB141 ; evaluate terminal condition value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1697 ldb FP0SGN ; pack FPA0 in place |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1698 orb #0x7f |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1699 andb FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1700 stb FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1701 ldy #LAD7F ; where to come back to |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1702 jmp LB1EA ; stash terminal condition on the stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1703 LAD7F ldx #LBAC5 ; point to FP 1.0 (default step) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1704 jsr LBC14 ; unpack it to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1705 jsr GETCCH ; get character after the terminal |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1706 cmpa #0xa9 ; is it STEP? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1707 bne LAD90 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1708 jsr GETNCH ; eat STEP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1709 jsr LB141 ; evaluate step condition |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1710 LAD90 jsr LBC6D ; get "status" of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1711 jsr LB1E6 ; stash FPA0 on the stack (for step value) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1712 ldd VARDES ; get variable descriptor pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1713 pshs d ; put that on the stack too |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1714 lda #0x80 ; flag the frame as a FOR/NEXT frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1715 pshs a |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1716 ; Main command interpretation loop |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1717 LAD9E jsr RVEC20 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1718 andcc #0xaf ; make sure interrupts are running |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1719 bsr LADEB ; check for BREAK/pause |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1720 ldx CHARAD ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1721 stx TINPTR ; save input pointer for start of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1722 lda ,x+ ; get current input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1723 beq LADB4 ; brif end of line - move to another line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1724 cmpa #': ; end of statement? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1725 beq LADC0 ; brif so - keep processing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1726 LADB1 jmp LB277 ; raise a syntax error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1727 LADB4 lda ,x++ ; get MSB of next line pointer and skip past pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1728 sta ENDFLG |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1729 beq LAE15 ; brif MSB of next line address is 0 (do END) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1730 ldd ,x+ ; get line number but only advance one |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1731 std CURLIN ; set current line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1732 stx CHARAD ; set input pointer to one before line text |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1733 LADC0 jsr GETNCH ; move past statement separator or to first character in line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1734 bsr LADC6 ; process a command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1735 bra LAD9E ; handle next statement or line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1736 LADC6 beq LAE40 ; return if end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1737 tsta ; is it a token? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1738 lbpl LET ; brif not - do a LET |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1739 cmpa #0xa3 ; above SKIPF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1740 bhi LADDC ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1741 ldx COMVEC+3 ; point to jump table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1742 lsla ; two bytes per entry (loses the token bias) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1743 tfr a,b ; put it in B for unsigned ABX |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1744 abx |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1745 jsr GETNCH ; move past token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1746 jmp [,x] ; transfer control to the handler (which will return to the main loop) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1747 LADDC cmpa #0xb4 ; is it a non-executable token? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1748 bls LADB1 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1749 jmp [COMVEC+13] ; transfer control to ECB command handler |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1750 ; RESTORE command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1751 RESTOR ldx TXTTAB ; point to beginning of the program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1752 leax -1,x ; move back one (to compensate for "GETNCH") |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1753 LADE8 stx DATPTR ; save as new data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1754 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1755 ; BREAK check |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1756 LADEB jsr LA1C1 ; read keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1757 beq LADFA ; brif no key down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1758 LADF0 cmpa #3 ; BREAK? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1759 beq STOP ; brif so - do a STOP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1760 cmpa #0x13 ; pause (SHIFT-@)? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1761 beq LADFB ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1762 sta IKEYIM ; cache key for later INKEY$ so break check doesn't break INKEY$ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1763 LADFA rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1764 LADFB jsr KEYIN ; read keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1765 beq LADFB ; brif no key down |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1766 bra LADF0 ; process pressed key in case BREAK or SHIFT-@ again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1767 ; END command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1768 ENDTOK jsr LA426 ; close files |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1769 jsr GETCCH ; re-get input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1770 bra LAE0B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1771 ; STOP command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1772 STOP orcc #1 ; flag "STOP" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1773 LAE0B bne LAE40 ; brif not end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1774 ldx CHARAD ; save current input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1775 stx TINPTR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1776 LAE11 ror ENDFLG ; save END/STOP flag (C) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1777 leas 2,s ; lose return address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1778 LAE15 ldx CURLIN ; get current input line (end of program comes here) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1779 cmpx #0xffff ; immediate mode? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1780 beq LAE22 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1781 stx OLDTXT ; save line where we stopped executing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1782 ldx TINPTR ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1783 stx OLDPTR ; save location where we stopped executing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1784 LAE22 clr DEVNUM ; reset to screen/keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1785 ldx #LABF2-1 ; point to BREAK message |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1786 tst ENDFLG ; are we doing "BREAK"? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1787 lbpl LAC73 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1788 jmp LAC68 ; go do the BREAK message and return to main loop |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1789 ; CONT command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1790 CONT bne LAE40 ; brif not end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1791 ldb #2*16 ; code for can't continue |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1792 ldx OLDPTR ; get saved execution pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1793 lbeq LAC46 ; brif no saved pointer - raise CN error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1794 stx CHARAD ; reset input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1795 ldx OLDTXT ; reset current line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1796 stx CURLIN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1797 LAE40 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1798 ; CLEAR command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1799 CLEAR beq LAE6F ; brif no argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1800 jsr LB3E6 ; evaluate string space size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1801 pshs d ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1802 ldx MEMSIZ ; get memory size (top of memory) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1803 jsr GETCCH ; is there anything after the string space size? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1804 beq LAE5A ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1805 jsr LB26D ; force a comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1806 jsr LB73D ; get top of memory value in X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1807 leax -1,x ; move back one (top of cleared space) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1808 cmpx TOPRAM ; is it within the memory available? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1809 bhi LAE72 ; brif higher than top of memory - OM error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1810 LAE5A tfr x,d ; so we can do math for checking memory usage |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1811 subd ,s++ ; subtract out string space value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1812 bcs LAE72 ; brif less than 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1813 tfr d,u ; U is bottom of cleared space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1814 subd #STKBUF ; also account for slop space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1815 bcs LAE72 ; brif less than 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1816 subd VARTAB ; is there still room for the program? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1817 blo LAE72 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1818 stu FRETOP ; set top of free memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1819 stx MEMSIZ ; set size of usable memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1820 LAE6F jmp LAD26 ; erase variables, etc. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1821 LAE72 jmp LAC44 ; raise OM error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1822 ; RUN command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1823 RUN jsr RVEC18 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1824 jsr LA426 ; close any open files |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1825 jsr GETCCH ; is there a line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1826 lbeq LAD21 ; brif no line number - start from beginning |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1827 jsr LAD26 ; clear variables, etc. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1828 bra LAE9F ; "GOTO" the line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1829 ; GO command (GOTO and GOSUB) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1830 GO tfr a,b ; save TO/SUB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1831 LAE88 jsr GETNCH ; eat the TO/SUB token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1832 cmpb #0xa5 ; TO? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1833 beq LAEA4 ; brif GOTO |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1834 cmpb #0xa6 ; SUB? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1835 bne LAED7 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1836 ldb #3 ; room for 6 bytes? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1837 jsr LAC33 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1838 ldu CHARAD ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1839 ldx CURLIN ; get line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1840 lda #0xa6 ; flag for GOSUB frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1841 pshs u,x,a ; set stack frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1842 LAE9F bsr LAEA4 ; do "GOTO" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1843 jmp LAD9E ; go back to main loop |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1844 ; Actual GOTO is here |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1845 LAEA4 jsr GETCCH ; get current input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1846 jsr LAF67 ; convert number to binary |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1847 bsr LAEEB ; move input pointer to end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1848 leax 1,x ; point to start of next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1849 ldd BINVAL ; get desired line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1850 cmpd CURLIN ; is it beyond here? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1851 bhi LAEB6 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1852 ldx TXTTAB ; start search at beginning of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1853 LAEB6 jsr LAD05 ; find line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1854 bcs LAED2 ; brif not found |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1855 LAEBB leax -1,x ; move to just before start of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1856 stx CHARAD ; reset input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1857 LAEBF rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1858 ; RETURN command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1859 RETURN bne LAEBF ; exit if argument given |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1860 lda #0xff ; set VARDES to an illegal value so we ignore FOR frames |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1861 sta VARDES |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1862 jsr LABF9 ; look for a GOSUB frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1863 tfr x,s ; reset stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1864 cmpa #0xa6-0x80 ; is it a GOSUB frame? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1865 beq LAEDA ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1866 ldb #2*2 ; code for RETURN without GOSUB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1867 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1868 LAED2 ldb #7*2 ; code for undefined line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1869 jmp LAC46 ; raise error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1870 LAED7 jmp LB277 ; raise syntax error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1871 LAEDA puls a,x,u ; get back saved line number and input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1872 stx CURLIN ; reset line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1873 stu CHARAD ; reset input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1874 ; DATA command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1875 DATA bsr LAEE8 ; move input pointer to end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1876 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1877 ; REM command (also ELSE) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1878 REM bsr LAEEB ; move input pointer to end of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1879 stx CHARAD ; save new input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1880 LAEE7 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1881 ; Return end of statement (LAEE8) or line (AEEB) in X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1882 LAEE8 ldb #': ; colon is statement terminator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1883 skip1lda |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1884 LAEEB clrb ; make main terminator NUL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1885 stb CHARAC ; save terminator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1886 clrb ; end of line - always terminates |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1887 ldx CHARAD ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1888 LAEF1 tfr b,a ; save secondary terminator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1889 ldb CHARAC ; get main terminator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1890 sta CHARAC ; save secondary |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1891 LAEF7 lda ,x ; get input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1892 beq LAEE7 ; brif end of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1893 pshs b ; save terminator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1894 cmpa ,s+ ; does it match? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1895 beq LAEE7 ; brif so - bail |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1896 leax 1,x ; move pointer ahead |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1897 cmpa #'" ; start of string? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1898 beq LAEF1 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1899 inca ; functon token? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1900 bne LAF0C ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1901 leax 1,x ; skip second part of function token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1902 LAF0C cmpa #0x85+1 ; IF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1903 bne LAEF7 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1904 inc IFCTR ; bump "IF" count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1905 bra LAEF7 ; get check another input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1906 ; IF command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1907 IFTOK jsr LB141 ; evaluate condition |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1908 jsr GETCCH ; find out what's after the conditin |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1909 cmpa #0x81 ; GO? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1910 beq LAF22 ; treat same as THEN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1911 ldb #0xa7 ; make sure we have a THEN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1912 jsr LB26F |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1913 LAF22 lda FP0EXP ; get true/false (false is 0) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1914 bne LAF39 ; brif condition true |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1915 clr IFCTR ; reset IF counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1916 LAF28 bsr DATA ; skip over statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1917 tsta ; end of line? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1918 beq LAEE7 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1919 jsr GETNCH ; get start of this statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1920 cmpa #0x84 ; ELSE? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1921 bne LAF28 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1922 dec IFCTR ; is it a matching ELSE? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1923 bpl LAF28 ; brif not - keep looking |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1924 jsr GETNCH ; eat the ELSE |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1925 LAF39 jsr GETCCH ; get current input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1926 lbcs LAEA4 ; brif numeric - to a GOTO |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1927 jmp LADC6 ; let main loop interpret the next command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1928 ; ON command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1929 ON jsr LB70B ; evaluate index expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1930 LAF45 ldb #0x81 ; make sure we have "GO" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1931 jsr LB26F |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1932 pshs a ; save TO/SUB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1933 cmpa #0xa6 ; SUB? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1934 beq LAF54 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1935 cmpa #0xa5 ; TO? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1936 LAF52 bne LAED7 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1937 LAF54 dec FPA0+3 ; are we at the right index? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1938 bne LAF5D ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1939 puls b ; get TO/SUB token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1940 jmp LAE88 ; go do GOTO or GOSUB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1941 LAF5D jsr GETNCH ; munch a character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1942 bsr LAF67 ; parse line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1943 cmpa #', ; is there another line following? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1944 beq LAF54 ; brif so - see if we're there yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1945 puls b,pc ; clean up TO/SUB token and return - we fell through |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1946 ; Parse a line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1947 LAF67 ldx ZERO ; initialize line number accumulator to 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1948 stx BINVAL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1949 LAF6B bcc LAFCE ; brif not numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1950 suba #'0 ; adjust to actual value of digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1951 sta CHARAC ; save digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1952 ldd BINVAL ; get accumulated number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1953 cmpa #24 ; will this overflow? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1954 bhi LAF52 ; brif so - raise syntax error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1955 aslb ; times 2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1956 rola |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1957 aslb ; times 4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1958 rola |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1959 addd BINVAL ; times 5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1960 aslb ; times 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1961 rola |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1962 addb CHARAC ; add in digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1963 adca #0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1964 std BINVAL ; save new accumulated number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1965 jsr GETNCH ; fetch next character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1966 bra LAF6B ; process next digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1967 ; LET command (the LET keyword requires Extended Basic) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1968 LET jsr LB357 ; evaluate destination variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1969 stx VARDES ; save descriptor pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1970 ldb #0xb3 ; make sure we have = |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1971 jsr LB26F |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1972 lda VALTYP ; get destination variable type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1973 pshs a ; save it for later |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1974 jsr LB156 ; evaluate the expression to assign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1975 puls a ; get back original variable type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1976 rora ; put type in C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1977 jsr LB148 ; make sure the current result matches the type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1978 lbeq LBC33 ; bri fnumeric - copy FPA0 to variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1979 LAFA4 ldx FPA0+2 ; point to descriptor of replacement string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1980 ldd FRETOP ; get bottom of string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1981 cmpd 2,x ; is the string already in string space? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1982 bhs LAFBE ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1983 cmpx VARTAB ; is the descriptor in variable space? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1984 blo LAFBE ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1985 LAFB1 ldb ,x ; get length of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1986 jsr LB50D ; allocate space for this string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1987 ldx V4D ; get descriptor pointer back |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1988 jsr LB643 ; copy string into string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1989 ldx #STRDES ; point to temporary string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1990 LAFBE stx V4D ; save descriptor pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1991 jsr LB675 ; remove string from string stack if appropriate |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1992 ldu V4D ; get back replacement descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1993 ldx VARDES ; get target descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1994 pulu a,b,y ; get string length (A) and data pointer (Y) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1995 sta ,x ; save new length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1996 sty 2,x ; save new pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1997 LAFCE rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1998 ; READ and INPUT commands. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
1999 LAFCF fcc '?REDO' ; The ?REDO message |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2000 fcb 0x0d,0x00 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2001 LAFD6 ldb #2*17 ; bad file data code |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2002 tst DEVNUM ; are we reading from the keyboard? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2003 beq LAFDF ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2004 LAFDC jmp LAC46 ; raise the error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2005 LAFDF lda INPFLG ; are we doing INPUT? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2006 beq LAFEA ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2007 ldx DATTXT ; get line number where the DATA statement happened |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2008 stx CURLIN ; set current line number to that so can report the correct location |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2009 jmp LB277 ; raise a syntax error on bad data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2010 LAFEA ldx #LAFCF-1 ; show the ?REDO if we're doing INPUT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2011 jsr LB99C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2012 ldx TINPTR ;* reset input pointer to start of statement (this will cause the |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2013 stx CHARAD ;* INPUT statement to be re-executed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2014 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2015 INPUT ldb #11*2 ; code for illegal direct statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2016 ldx CURLIN ; are we in immediate mode? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2017 leax 1,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2018 beq LAFDC ; brif so - raise ID error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2019 bsr LB002 ; go do the INPUT thing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2020 clr DEVNUM ; reset device to screen/keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2021 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2022 LB002 cmpa #'# ; is there a device number? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2023 bne LB00F ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2024 jsr LA5A5 ; parse device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2025 jsr LA3ED ; make sure it's valid for input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2026 jsr LB26D ; make sure we have a comma after the device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2027 LB00F cmpa #'" ; is there a prompt string? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2028 bne LB01E ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2029 jsr LB244 ; parse the prompt string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2030 ldb #'; ; make sure we have a semicolon after the prompt |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2031 jsr LB26F |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2032 jsr LB99F ; print the prompt |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2033 LB01E ldx #LINBUF ; point to line input buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2034 clr ,x ; NUL first byte to indicate no data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2035 tst DEVNUM ; is it keyboard input? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2036 bne LB049 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2037 bsr LB02F ; read a line from the keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2038 ldb #', ; put a comma at the start of the buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2039 stb ,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2040 bra LB049 ; go process some input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2041 LB02F jsr LB9AF ; send a ? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2042 jsr LB9AC ; send a space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2043 LB035 jsr LA390 ; read input from the keyboard |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2044 bcc LB03F ; brif not BREAK |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2045 leas 4,s ; clean up stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2046 LB03C jmp LAE11 ; go process BREAK |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2047 LB03F ldb #2*23 ; input past end of file error code |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2048 tst CINBFL ; was it EOF? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2049 bne LAFDC ; brif so - raise the error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2050 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2051 READ ldx DATPTR ; fetch current DATA pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2052 skip1lda ; set A to nonzero (for READ) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2053 LB049 clra ; set A to zero (for INPUT) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2054 sta INPFLG ; record whether we're doing READ or INPUT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2055 stx DATTMP ; save current input location |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2056 LB04E jsr LB357 ; evaluate a variable (destination of data) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2057 stx VARDES ; save descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2058 ldx CHARAD ; save interpreter input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2059 stx BINVAL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2060 ldx DATTMP ; get data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2061 lda ,x ; is there anything to read? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2062 bne LB069 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2063 lda INPFLG ; is it INPUT? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2064 bne LB0B9 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2065 jsr RVEC10 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2066 jsr LB9AF ; send a ? (so subsequent lines get ??) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2067 bsr LB02F ; go read an input line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2068 LB069 stx CHARAD ; save data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2069 jsr GETNCH ; fetch next data character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2070 ldb VALTYP ; do we want a number? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2071 beq LB098 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2072 ldx CHARAD ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2073 sta CHARAC ; save initial character as the delimiter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2074 cmpa #'" ; do we have a string delimiter? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2075 beq LB08B ; brif so - use " as both delimiters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2076 leax -1,x ; back up input if we don't have a delimiter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2077 clra ; set delimiter to NUL (end of line) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2078 sta CHARAC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2079 jsr LA35F ; set up print parameters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2080 tst PRTDEV ; is it a file type device? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2081 bne LB08B ; brif so - use two NULs |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2082 lda #': ; use colon as one delimiter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2083 sta CHARAC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2084 lda #', ; and use comma as the other |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2085 LB08B sta ENDCHR ; save second terminator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2086 jsr LB51E ; parse out the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2087 jsr LB249 ; move input pointer past the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2088 jsr LAFA4 ; assign the string to the variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2089 bra LB09E ; go see if there's more to read |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2090 LB098 jsr LBD12 ; parse a numeric string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2091 jsr LBC33 ; assign the numbe to the variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2092 LB09E jsr GETCCH ; get current input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2093 beq LB0A8 ; brif end of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2094 cmpa #', ; check for comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2095 lbne LAFD6 ; brif not - we have bad data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2096 LB0A8 ldx CHARAD ; get current data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2097 stx DATTMP ; save the data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2098 ldx BINVAL ; restore the interpreter input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2099 stx CHARAD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2100 jsr GETCCH ; get current input from program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2101 beq LB0D5 ; brif end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2102 jsr LB26D ; make sure there's a comma between variables |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2103 bra LB04E ; go read another item |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2104 LB0B9 stx CHARAD ; reset input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2105 jsr LAEE8 ; search for end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2106 leax 1,x ; move past end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2107 tsta ; was it end of line? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2108 bne LB0CD ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2109 ldb #2*3 ; code for out of data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2110 ldu ,x++ ; get pointer to next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2111 beq LB10A ; brif end of program - raise OD error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2112 ldd ,x++ ; get line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2113 std DATTXT ; record it for raising errors in DATA statements |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2114 LB0CD lda ,x ; do we have a DATA statement? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2115 cmpa #0x86 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2116 bne LB0B9 ; brif not - keep scanning |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2117 bra LB069 ; go process the input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2118 LB0D5 ldx DATTMP ; get data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2119 ldb INPFLG ; were we doing READ? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2120 lbne LADE8 ; brif so - save DATA pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2121 lda ,x ; is there something after the input in the input buffer? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2122 beq LB0E7 ; brif not - we consumed everything |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2123 ldx #LB0E8-1 ; print the ?EXTRA IGNORED message |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2124 jmp LB99C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2125 LB0E7 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2126 LB0E8 fcc '?EXTRA IGNORED' |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2127 fcb 0x0d,0x00 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2128 ; NEXT command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2129 NEXT bne LB0FE ; brif argument given |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2130 ldx ZERO ; set to NULL descriptor pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2131 bra LB101 ; go process "any index will do" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2132 LB0FE jsr LB357 ; evaluate the variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2133 LB101 stx VARDES ; save the index we're looking for |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2134 jsr LABF9 ; search the stack for the matching frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2135 beq LB10C ; brif we found a matching frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2136 ldb #0 ; code for NEXT without FOR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2137 LB10A bra LB153 ; raise the error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2138 LB10C tfr x,s ; reset the stack to the start of the stack frame |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2139 leax 3,x ; point to the STEP value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2140 jsr LBC14 ; copy the value to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2141 lda 8,s ; get step direction |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2142 sta FP0SGN ; save as sign of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2143 ldx VARDES ; point to index variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2144 jsr LB9C2 ; add (X) to FPA0 (steps the index) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2145 jsr LBC33 ; save new value to the index |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2146 leax 9,s ; point to terminal condition |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2147 jsr LBC96 ; compare the new index value with the terminal |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2148 subb 8,s ; set B=0 if we hit the terminal (or passed it with nonzero step) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2149 beq LB134 ; brif loop complete |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2150 ldx 14,s ; restore line number and input pointer to start of loop |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2151 stx CURLIN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2152 ldx 16,s |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2153 stx CHARAD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2154 LB131 jmp LAD9E ; return to interpretation loop |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2155 LB134 leas 18,s ; remove the frame from the stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2156 jsr GETCCH ; get character after the index |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2157 cmpa #', ; do we have more indexes? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2158 bne LB131 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2159 jsr GETNCH ; munch the comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2160 bsr LB0FE ; go process another value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2161 ; NOTE: despite the BSR on the preceding line, execution of the NEXT command will not fall |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2162 ; through this point, nor will the stack grow without bound. The BSR is required to make sure |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2163 ; the stack is aligned properly for the stack search for the subsequent index variable. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2164 ; |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2165 ; The following is the expression evaluation system. It has various entry points including for type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2166 ; checking. This really consists of two co-routines, one for evaluating operators and one for individual |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2167 ; terms. However, it does some rather confusing stack operations so it's a bit difficult to follow |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2168 ; just how some of this works. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2169 ; |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2170 ; Evaluate numeric expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2171 LB141 bsr LB156 ; evaluate an expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2172 ; TM error if string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2173 LB143 andcc #0xfe ; clear C to indicate we want a number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2174 skip2keepc |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2175 ; TM error if numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2176 LB146 orcc #1 ; set C to indicate we want a string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2177 ; TM error if: C = 1 and number, OR C = 0 and string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2178 LB148 tst VALTYP ; set flags on the current value to (doesn't change C) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2179 bcs LB14F ; brif we want a string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2180 bpl LB0E7 ; brif we have a number (we want a number) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2181 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2182 LB14F bmi LB0E7 ; brif we have a string (we want a string) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2183 LB151 ldb #12*2 ; code for TM error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2184 LB153 jmp LAC46 ; raise the error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2185 ; The general expression evaluation entry point |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2186 LB156 bsr LB1C6 ; back up input pointer to compensate for GETNCH below |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2187 LB158 clra ; set operator precedence to 0 (no previous operator) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2188 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2189 LB15A pshs b ; save relational operator flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2190 pshs a ; save previous operator precedence |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2191 ldb #1 ; make sure we aren't overflowing the stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2192 jsr LAC33 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2193 jsr LB223 ; go evaluate the first term |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2194 LB166 clr TRELFL ; flag no relational operators seen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2195 LB168 jsr GETCCH ; get input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2196 LB16A suba #0xb2 ; token for > (lowest relational operator) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2197 blo LB181 ; brif below relational operators |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2198 cmpa #3 ; there are three relational operators, is it one? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2199 bhs LB181 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2200 cmpa #1 ; set C if > |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2201 rola ; shift C into bit 0 (4: <, 2: =, 1: >) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2202 eora TRELFL ; flip the bit for this operator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2203 cmpa TRELFL ; did the result get lower? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2204 blo LB1DF ; brif so - we have a duplicate so raise an error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2205 sta TRELFL ; save new operator flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2206 jsr GETNCH ; munch the operator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2207 bra LB16A ; go see if we have another one |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2208 LB181 ldb TRELFL ; do we have a relational comparison? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2209 bne LB1B8 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2210 lbcc LB1F4 ; brif the token is above the relational operators |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2211 adda #7 ; put operators starting at 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2212 bhs LB1F4 ; brif we're above 0 - it's an operator, Jim |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2213 adca VALTYP ; add carry, numeric flag, and modified token number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2214 lbeq LB60F ; brif we have string and A is + - do concatenation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2215 adca #-1 ; restore operator number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2216 pshs a ; save operator number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2217 asla ; times 2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2218 adda ,s+ ; and times 3 (3 bytes per entry) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2219 ldx #LAA51 ; point to operator pecedence and jump table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2220 leax a,x ; point to correct entry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2221 LB19F puls a ; get precedence of previous operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2222 cmpa ,x ; is hit higher (or same) than the current one? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2223 bhs LB1FA ; brif so - we need to process that operator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2224 bsr LB143 ; TM error if we have a string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2225 LB1A7 pshs a ; save previous operation precedence |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2226 bsr LB1D4 ; push operator handler address and FPA0 onto the stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2227 ldx RELPTR ; get pointer to arithmetic/logical table entry for last operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2228 puls a ; get back precedence |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2229 bne LB1CE ; brif we had a relational operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2230 tsta ; check precedence of previous operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2231 lbeq LB220 ; brif end of expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2232 bra LB203 ; go handle operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2233 LB1B8 asl VALTYP ; get type of value to C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2234 rolb ; mix it in to bit 0 of relational flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2235 bsr LB1C6 ; back up input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2236 ldx #LB1CB ; point to relational operator precedence and handler |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2237 stb TRELFL ; save relational comparison flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2238 clr VALTYP ; result will be numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2239 bra LB19F ; to process the operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2240 LB1C6 ldx CHARAD ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2241 jmp LAEBB ; back it up one and put it back |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2242 LB1CB fcb 0x64 ; precedence of relational comparison |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2243 fdb LB2F4 ; handler address for relational comparison |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2244 LB1CE cmpa ,x ; is last done operation higher (or same) precedence? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2245 bhs LB203 ; brif so - go process it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2246 bra LB1A7 ; go push things on the stack and process this operation otherwise |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2247 LB1D4 ldd 1,x ; get address of operatorroutine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2248 pshs d ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2249 bsr LB1E2 ; push FPA0 onto the stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2250 ldb TRELFL ; get back relational operator flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2251 lbra LB15A ; go evaluate another operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2252 LB1DF jmp LB277 ; raise a syntax error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2253 LB1E2 ldb FP0SGN ; get sign of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2254 lda ,x ; get precedence of this operation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2255 LB1E6 puls y ; get back original caller |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2256 pshs b ; save sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2257 LB1EA ldb FP0EXP ; get exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2258 ldx FPA0 ; get mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2259 ldu FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2260 pshs u,x,b ; stow FPA0 sign and mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2261 jmp ,y ; return to caller |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2262 LB1F4 ldx ZERO ; point to dummy value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2263 lda ,s+ ; get precedence of previous operation (and set flags) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2264 beq LB220 ; brif end of expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2265 LB1FA cmpa #0x64 ; relational operation? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2266 beq LB201 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2267 jsr LB143 ; type mismatch if string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2268 LB201 stx RELPTR ; save pointer to operator routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2269 LB203 puls b ; get relational flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2270 cmpa #0x5a ; NOT operation? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2271 beq LB222 ; brif so (it was unary) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2272 cmpa #0x7d ; unary negation? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2273 beq LB222 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2274 lsrb ; shift value type flag out of relational flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2275 stb RELFLG ; save relational operator flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2276 puls a,x,u ; get FP value back |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2277 sta FP1EXP ; set exponent and mantissa in FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2278 stx FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2279 stu FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2280 puls b ; and the sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2281 stb FP1SGN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2282 eorb FP0SGN ; set RESSGN if the two operand signs differ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2283 stb RESSGN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2284 LB220 ldb FP0EXP ; get exponent of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2285 LB222 rts ; return or transfer control to operator handler routine |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2286 LB223 jsr RVEC15 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2287 clr VALTYP ; set type to numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2288 jsr GETNCH ; get first character in the term |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2289 bcc LB22F ; brif not numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2290 LB22C jmp LBD12 ; parse a number (and return) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2291 LB22F jsr LB3A2 ; set carry if not alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2292 bcc LB284 ; brif alpha character (variable) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2293 cmpa #'. ; decimal point? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2294 beq LB22C ; brif so - evaluate number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2295 cmpa #0xac ; minus? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2296 beq LB27C ; brif so - process unary negation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2297 cmpa #0xab ; plus? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2298 beq LB223 ; brif so - ignore unary "posation" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2299 cmpa #'" ; string delimiter? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2300 bne LB24E ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2301 LB244 ldx CHARAD ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2302 jsr LB518 ; go parse the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2303 LB249 ldx COEFPT ; get address of end of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2304 stx CHARAD ; move input pointer past string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2305 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2306 LB24E cmpa #0xa8 ; NOT? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2307 bne LB25F ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2308 lda #0x5a ; precedence of unary NOT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2309 jsr LB15A ; process the operand of NOT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2310 jsr INTCNV ; convert to integer in D |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2311 coma ; do a bitwise complement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2312 comb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2313 jmp GIVABF ; resturn the result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2314 LB25F inca ; is it a function token? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2315 beq LB290 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2316 LB262 bsr LB26A ; only other legal thing must be a (expr) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2317 jsr LB156 ; evaluate parentheticized expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2318 LB267 ldb #') ; force a ) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2319 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2320 LB26A ldb #'( ; force a ( |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2321 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2322 LB26D ldb #', ; force a , |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2323 LB26F cmpb [CHARAD] ; does character match? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2324 bne LB277 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2325 jmp GETNCH ; each the character and return the next |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2326 LB277 ldb #2*1 ; raise syntax error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2327 jmp LAC46 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2328 LB27C lda #0x7d ; unary negation precedence |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2329 jsr LB15A ; evaluate argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2330 jmp LBEE9 ; flip sign of FPA0 and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2331 LB284 jsr LB357 ; evaluate variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2332 LB287 stx FPA0+2 ; save descriptor address in FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2333 lda VALTYP ; test variable type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2334 bne LB222 ; brif string - we're done |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2335 jmp LBC14 ; copy FP number from (X) into FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2336 LB290 jsr GETNCH ; get the actual token number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2337 tfr a,b ; save it (for offsetting X) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2338 lslb ; two bytes per jump table entry (and lose high bit) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2339 jsr GETNCH ; eat the token byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2340 cmpb #2*19 ; is it a valid token for Color Basic? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2341 bls LB29F ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2342 jmp [COMVEC+18] ; transfer control to Extended Basic if not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2343 LB29F pshs b ; save jump table offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2344 cmpb #2*14 ; does it expect a numeric argument? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2345 blo LB2C7 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2346 cmpb #2*18 ; does it need no arguments? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2347 bhs LB2C9 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2348 bsr LB26A ; force a ( |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2349 lda ,s ; get token value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2350 cmpa #2*17 ; is it POINT? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2351 bhs LB2C9 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2352 jsr LB156 ; evaluate first argument string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2353 bsr LB26D ; force a comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2354 jsr LB146 ; TM error if string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2355 puls a ; get token value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2356 ldu FPA0+2 ; get string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2357 pshs u,a ; now we save the first string argument and the token value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2358 jsr LB70B ; evaluate first numeric argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2359 puls a ; get back token value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2360 pshs b,a ; save second argument and token value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2361 fcb 0x8e ; opcode of LDX immediate (skips two bytes) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2362 LB2C7 bsr LB262 ; force a ( |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2363 LB2C9 puls b ; get offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2364 ldx COMVEC+8 ; get jump table pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2365 abx ; add offset into table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2366 jsr [,x] ; go process function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2367 jmp LB143 ; make sure result is numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2368 ; operator OR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2369 LB2D4 skip1lda ; set flag to nonzero to signal OR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2370 ; operator AND |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2371 LB2D5 clra ; set flag to zero to signal AND |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2372 sta TMPLOC ; save AND/OR flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2373 jsr INTCNV ; convert second argument to intenger |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2374 std CHARAC ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2375 jsr LBC4A ; move first argument to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2376 jsr INTCNV ; convert first argument to integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2377 tst TMPLOC ; is it AND or OR? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2378 bne LB2ED ; brif OR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2379 anda CHARAC ; do the bitwise AND |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2380 andb ENDCHR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2381 bra LB2F1 ; finish up |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2382 LB2ED ora CHARAC ; do the bitwise OR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2383 orb ENDCHR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2384 LB2F1 jmp GIVABF ; return integer result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2385 ; relational comparision operators |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2386 LB2F4 jsr LB148 ; TM error if type mismatch |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2387 BNE LB309 ; brif we have a string comparison |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2388 lda FP1SGN ; pack FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2389 ora #0x7f |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2390 anda FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2391 sta FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2392 ldx #FP1EXP ; point to packed FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2393 jsr LBC96 ; compare FPA0 to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2394 bra LB33F ; handle truth comparison |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2395 LB309 clr VALTYP ; the result of a comparison is always a number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2396 dec TRELFL ; remove the string flag from the comparison data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2397 jsr LB657 ; get string details for second argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2398 stb STRDES ; save them in the temporary string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2399 stx STRDES+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2400 ldx FPA1+2 ; get pointer to first argument descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2401 jsr LB659 ; get string details for second argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2402 lda STRDES ; get length of second argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2403 pshs b ; save length of first argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2404 suba ,s+ ; now A is the difference in string lengths |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2405 beq LB328 ; brif string lengths are equal |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2406 lda #1 ; flag for second argument is longer than first |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2407 bcc LB328 ; brif second string is longer than first |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2408 ldb STRDES ; get length of second string (shorter) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2409 nega ; invert default comparison result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2410 LB328 sta FP0SGN ; save default truth flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2411 ldu STRDES+2 ; get pointer to start of second string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2412 incb ; compensate for DECB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2413 LB32D decb ; have we compared everything? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2414 bne LB334 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2415 ldb FP0SGN ; get default truth value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2416 bra LB33F ; decide comparison truth |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2417 LB334 lda ,x+ ; get byte from first argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2418 cmpa ,u+ ; compare with second argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2419 beq LB32D ; brif equal - keep comparing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2420 ldb #0xff ; negative if first string is > second |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2421 bcc LB33F ; brif string A > string B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2422 negb ; invert result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2423 LB33F addb #1 ; convert to 0,1,2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2424 rolb ; shift left - now it's 4,2,1 for <, =, > |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2425 andb RELFLG ; keep only the truth we care about |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2426 beq LB348 ; brif no matching bits - it's false |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2427 ldb #0xff ; set true |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2428 LB348 jmp LBC7C ; convert result to FP and return it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2429 ; DIM command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2430 LB34B jsr LB26D ; make sure there's a comma between variables |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2431 DIM ldb #1 ; flag that we're dimensioning |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2432 bsr LB35A ; go allocate the variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2433 jsr GETCCH ; are we done? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2434 bne LB34B ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2435 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2436 ; This routine parses a variable. For scalars, it will return a NULL string or 0 value number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2437 ; if it is called from "evaluate term". Otherwise, it allocates the variable. For arrays, it will |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2438 ; allocate a default sized array if dimensioning is not underway and then attempt to look up |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2439 ; the requested coordinates in that array. Otherwise, it will allocate an array based on the |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2440 ; specified dimension values. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2441 LB357 clrb ; flag that we're not setting up an array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2442 jsr GETCCH |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2443 LB35A stb DIMFLG ; save dimensioning flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2444 sta VARNAM ; save first character of variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2445 jsr GETCCH ; get input character (why? we already have it) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2446 bsr LB3A2 ; set carry if not alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2447 lbcs LB277 ; brif our variable doesn't start with a letter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2448 clrb ; default second variable character to NUL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2449 stb VALTYP ; set value type to numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2450 jsr GETNCH ; get second character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2451 bcs LB371 ; brif numeric - numbers are allowed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2452 bsr LB3A2 ; set carry if not alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2453 bcs LB37B ; brif not alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2454 LB371 tfr a,b ; save set second character of variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2455 LB373 jsr GETNCH ; get an input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2456 bcs LB373 ; brif numeric - still in variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2457 bsr LB3A2 ; set carry if not alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2458 bcc LB373 ; brif alpha - still in variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2459 LB37B cmpa #'$ ; do we have the string sigil? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2460 bne LB385 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2461 com VALTYP ; set value type to string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2462 addb #0x80 ; set bit 7 of second variable character to indicate string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2463 jsr GETNCH ; eat the sigil |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2464 LB385 stb VARNAM+1 ; save second variable name character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2465 ora ARYDIS ; merge array disable flag (will set bit 7 of input character if no arrays) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2466 suba #'( ; do we have a subscript? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2467 lbeq LB404 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2468 clr ARYDIS ; disable the array disable flag - it's single use |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2469 ldx VARTAB ; point to the start of the variable table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2470 ldd VARNAM ; get variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2471 LB395 cmpx ARYTAB ; are we at the top of the variable table? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2472 beq LB3AB ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2473 cmpd ,x++ ; does the variable name match (and move pointer to variable data) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2474 beq LB3DC ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2475 leax 5,x ; move to next table entry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2476 bra LB395 ; see if we have a match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2477 ; Set carry if not upper case alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2478 LB3A2 cmpa #'A ; set C if less than A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2479 bcs LB3AA ; brif less than A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2480 suba #'Z+1 ; set C if greater than Z |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2481 suba #-('Z+1) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2482 LB3AA rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2483 LB3AB ldx #ZERO ; point to empty location (NULL/0 value) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2484 ldu ,s ; get caller address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2485 cmpu #LB287 ; coming from "evaluate term"? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2486 beq LB3DE ; brif so - don't allocate |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2487 ldd ARYEND ; get end of arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2488 std V43 ; save as top of source block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2489 addd #7 ; 7 bytes per scalar entry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2490 std V41 ; save as top of destination block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2491 ldx ARYTAB ; get bottom of arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2492 stx V47 ; save as bottom of source block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2493 jsr LAC1E ; move the arrays up to make a hole |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2494 ldx V41 ; get new top of arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2495 stx ARYEND ; set new end of arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2496 ldx V45 ; get bottom of destination block |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2497 stx ARYTAB ; set as new start of arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2498 ldx V47 ; get old end of variables |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2499 ldd VARNAM ; get name of variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2500 std ,x++ ; set variable name and advance X to the value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2501 clra ; zero out the variable value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2502 clrb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2503 std ,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2504 std 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2505 sta 4,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2506 LB3DC stx VARPTR ; save descriptor address of return value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2507 LB3DE rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2508 ; Various integer conversion routines |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2509 LB3DF fcb 0x90,0x80,0x00,0x00,0x00 ; FP constant -32768 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2510 LB3E4 jsr GETNCH ; fetch input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2511 LB3E6 jsr LB141 ; evaluate numeric expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2512 LB3E9 lda FP0SGN ; get sign of value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2513 bmi LB44A ; brif negative (raise FC error) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2514 INTCNV jsr LB143 ; TM error if string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2515 lda FP0EXP ; get exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2516 cmpa #0x90 ; is it within the range for a 16 bit integer? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2517 blo LB3FE ; brif smaller than 32768 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2518 ldx #LB3DF ; point to -32678 constant |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2519 jsr LBC96 ; is FPA0 equal to -32768? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2520 bne LB44A ; brif not - magnitude is too far negative |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2521 LB3FE jsr LBCC8 ; move binary point to the right of FPA0 and correct sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2522 ldd FPA0+2 ; get the resulting integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2523 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2524 LB404 ldd DIMFLG ; get dimensioning flag and variable type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2525 pshs b,a ; save them (to avoid issues while evaluating dimension values) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2526 nop ; dead space caused by 1.2 revision |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2527 clrb ; reset dimension counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2528 LB40A ldx VARNAM ; get variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2529 pshs x,b ; save dimension counter and variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2530 bsr LB3E4 ; evaluate a dimension value (and skip either ( or ,) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2531 puls b,x,y ; get variable name, dimension counter, and dimensioning/type flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2532 stx VARNAM ; restore variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2533 ldu FPA0+2 ; get dimension size/index |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2534 pshs u,y ; save dimension size and dimensioning/type flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2535 incb ; bump dimension counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2536 jsr GETCCH ; get what's after the dimension count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2537 cmpa #', ; do we have another dimension? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2538 beq LB40A ; brif so - parse it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2539 stb TMPLOC ; save dimension counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2540 jsr LB267 ; make sure we have a ) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2541 puls a,b ; get back variable type and dimensioning flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2542 std DIMFLG ; restore variable type and dimensioning flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2543 ldx ARYTAB ; get start of arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2544 LB42A cmpx ARYEND ; are we at the end of the array table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2545 beq LB44F ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2546 ldd VARNAM ; get variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2547 cmpd ,x ; does it match? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2548 beq LB43B ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2549 ldd 2,x ; get length of this array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2550 leax d,x ; move to next array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2551 bra LB42A ; go check another entry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2552 LB43B ldb #2*9 ; code for redimensioned array error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2553 lda DIMFLG ; are we dimensioning? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2554 bne LB44C ; brif so - raise error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2555 ldb TMPLOC ; get number of dimensions given |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2556 cmpb 4,x ; does it match? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2557 beq LB4A0 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2558 LB447 ldb #8*2 ; raise "bad subscript" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2559 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2560 LB44A ldb #4*2 ; raise "illegal function call" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2561 LB44C jmp LAC46 ; raise error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2562 LB44F ldd #5 ; 5 bytes per array entry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2563 std COEFPT ; initialize array size to entry size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2564 ldd VARNAM ; get variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2565 std ,x ; set array name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2566 ldb TMPLOC ; get dimension count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2567 stb 4,x ; set dimension count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2568 jsr LAC33 ; make sure we haven't overflowed memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2569 stx V41 ; save array descriptor address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2570 LB461 ldb #11 ; default dimension value (zero-based, gives max index of 10) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2571 clra ; zero extend (??? why not LDD above?) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2572 tst DIMFLG ; are we dimensioning? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2573 beq LB46D ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2574 puls a,b ; get dimension size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2575 addd #1 ; account for zero based indexing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2576 LB46D std 5,x ; save dimension size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2577 bsr LB4CE ; multiply by accumulated array size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2578 std COEFPT ; save new array size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2579 leax 2,x ; move to next dimension |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2580 dec TMPLOC ; have we done all dimensions? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2581 bne LB461 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2582 stx TEMPTR ; save end of array descriptor (minus 5) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2583 addd TEMPTR ; add total size of array to address of descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2584 lbcs LAC44 ; brif it overflows memory |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2585 tfr d,x ; save end of array for later |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2586 jsr LAC37 ; does array fit in memory? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2587 subd #STKBUF-5 ; subtract out the "stack fudge factor" but add 5 to the result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2588 std ARYEND ; save new end of arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2589 clra ; set up for clearing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2590 LB48C leax -1,x ; move back one |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2591 sta 5,x ; blank out a byte in the array data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2592 cmpx TEMPTR ; have we reached the array header? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2593 bne LB48C ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2594 ldx V41 ; get address of start of descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2595 lda ARYEND ; get MSB of end of array back (B still has LSB) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2596 subd V41 ; subtract start of descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2597 std 2,x ; save length of array in array header |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2598 lda DIMFLG ; are we dimensioning? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2599 bne LB4CD ; brif so - we're done |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2600 LB4A0 ldb 4,x ; get number of dimensions |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2601 stb TMPLOC ; initialize counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2602 clra ; initialize accumulated offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2603 clrb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2604 LB4A6 std COEFPT ; save accumulated offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2605 puls a,b ; get desired index |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2606 std FPA0+2 ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2607 cmpd 5,x ; is it in range for this dimension? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2608 bhs LB4EB ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2609 ldu COEFPT ; get accumulated offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2610 beq LB4B9 ; brif first dimension |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2611 bsr LB4CE ; multiply accumulated offset by dimension length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2612 addd FPA0+2 ; add in offset into this dimension |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2613 LB4B9 leax 2,x ; move to next dimension in header |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2614 dec TMPLOC ; done all dimensions? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2615 bne LB4A6 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2616 std ,--s ; save D for multiply by 5 (should be pshs d) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2617 aslb ; times 2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2618 rola |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2619 aslb ; times 4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2620 rola |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2621 addd ,s++ ; times 5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2622 leax d,x ; add in offset from start of array data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2623 leax 5,x ; offset to end of header |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2624 stx VARPTR ; save pointer to element data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2625 LB4CD rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2626 ; multiply 16 bit number at 5,x by the 16 bit number in COEFPT; return result in D; BS error if carry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2627 LB4CE lda #16 ; 16 shifts to do a multiply |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2628 sta V45 ; save shift counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2629 ldd 5,x ; get multiplier |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2630 std BOTSTK ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2631 clra ; zero out product |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2632 clrb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2633 LB4D8 aslb ; shift product left |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2634 rola |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2635 bcs LB4EB ; brif we have a carry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2636 asl COEFPT+1 ; shift other factor left |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2637 rol COEFPT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2638 bcc LB4E6 ; brif no carry - this bit position is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2639 addd BOTSTK ; add in multiplier at this bit position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2640 bcs LB4EB ; brif carry - do an error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2641 LB4E6 dec V45 ; have we done all 16 bits? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2642 bne LB4D8 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2643 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2644 LB4EB jmp LB447 ; raise a BS error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2645 ; MEM function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2646 ; BUG: this doesn't account for the STKBUF fudge factor used for memory availability checks |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2647 MEM tfr s,d ; get stack pointer where we can do math |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2648 subd ARYEND ; calculate number of bytes between the stack and the top of arrays |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2649 skip1 ; return result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2650 ; Convert unsigned value in B to FP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2651 LB4F3 clra ; zero extend |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2652 ; Convert signed value in D to FP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2653 GIVABF clr VALTYP ; set value type to numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2654 std FPA0 ; save value in FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2655 ldb #0x90 ; exponent for top two bytes to be an integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2656 jmp LBC82 ; finish conversion to integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2657 ; STR$ function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2658 STR jsr LB143 ; make sure we have a number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2659 ldu #STRBUF+2 ; convert FP number to string in temporary string buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2660 jsr LBDDC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2661 leas 2,s ; don't return to the function evaluator (which will do a numeric type check) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2662 ldx #STRBUF+1 ; point to number string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2663 bra LB518 ; to stash the string in string space and return to the "evaluate term" caller |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2664 ; Reserve B bytes of string space. Return start in X and FRESPC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2665 LB50D stx V4D ; save X somewhere in case the caller needs it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2666 LB50F bsr LB56D ; allocate string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2667 LB511 stx STRDES+2 ; save pointer to allocated space in the temporary descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2668 stb STRDES ; save length in the temporary descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2669 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2670 LB516 leax -1,x ; move pointer back one (to compensate for the increment below) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2671 ; Scan from X until either NUL or one of the string terminators is found |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2672 LB518 lda #'" ; set terminator to be string delimiter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2673 LB51A sta CHARAC ; set both delimiters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2674 sta ENDCHR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2675 LB51E leax 1,x ; move to next character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2676 stx RESSGN ; save start of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2677 stx STRDES+2 ; save start of string in the temporary string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2678 ldb #-1 ; initialize length counter to -1 (compensate for initial INCB) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2679 LB526 incb ; bump string length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2680 lda ,x+ ; get character from string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2681 beq LB537 ; brif end of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2682 cmpa CHARAC ; is it delimiter #1? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2683 beq LB533 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2684 cmpa ENDCHR ; is it delimiter #2? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2685 bne LB526 ; brif not - keep scanning |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2686 LB533 cmpa #'" ; string delimiter? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2687 beq LB539 ; brif so - don't move pointer back |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2688 LB537 leax -1,x ; move pointer back (so we don't consume the delimiter) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2689 LB539 stx COEFPT ; save end of string address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2690 stb STRDES ; save string length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2691 ldu RESSGN ; get start of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2692 cmpu #STRBUF+2 ; is it at the start of the string buffer? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2693 bhi LB54C ; brif so - don't copy it to string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2694 bsr LB50D ; allocate string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2695 ldx RESSGN ; point to beginning of the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2696 jsr LB645 ; copy string data (B bytes) from (X) to (FRESPC) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2697 ; Put temporary string descriptor on the string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2698 LB54C ldx TEMPPT ; get top of string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2699 cmpx #CFNBUF ; is the string stack full? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2700 bne LB558 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2701 ldb #15*2 ; code for "string formula too complex" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2702 LB555 jmp LAC46 ; raise error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2703 LB558 lda STRDES ; get string length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2704 sta 0,x ; save it in the string stack descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2705 ldd STRDES+2 ; get string data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2706 std 2,x ; save in string stack descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2707 lda #0xff ; set value type to string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2708 sta VALTYP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2709 stx LASTPT ; set pointer to last used entry on the string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2710 stx FPA0+2 ; set pointer to descriptor in the current evaluation value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2711 leax 5,x ; advance string stack pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2712 stx TEMPPT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2713 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2714 ; Reserve B bytes in string space. If there isn't enough space, try compacting string space and |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2715 ; then try the allocation again. If it still fails, raise OS error. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2716 LB56D clr GARBFL ; flag that compaction not yet done |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2717 LB56F clra ; zero extend the length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2718 pshs d ; save requested string length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2719 ldd STRTAB ; get current bottom of strings |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2720 subd ,s+ ; calculate new bottom of strings and remove zero extension |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2721 cmpd FRETOP ; does the string fit? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2722 blo LB585 ; brif not - try compaction |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2723 std STRTAB ; save new bottom of strings |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2724 ldx STRTAB ; get bottom of strings |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2725 leax 1,x ; now X points to the real start of the allocated space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2726 stx FRESPC ; save the string pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2727 puls b,pc ; restore length and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2728 LB585 ldb #2*13 ; code for out of string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2729 com GARBFL ; have we compacted string space yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2730 beq LB555 ; brif so - raise error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2731 bsr LB591 ; compact string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2732 puls b ; get back string length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2733 bra LB56F ; go try allocation again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2734 ; Compact string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2735 ; This is an O(n^2) algorithm. It first searches all extant strings for the highest address data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2736 ; that hasn't already been moved into the freshly compacted string space. If then moves that string data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2737 ; up to the highest address it can go to. It repeats this process over and over until it finds no string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2738 ; that isn't already in the compacted space. While doing this, it has to search all strings on the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2739 ; stack (this is why the string stack is needed - so we can track anonymous strings), all scalar string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2740 ; variables, and *every* entry in every string array. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2741 LB591 ldx MEMSIZ ; get to of string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2742 LB593 stx STRTAB ; save top of uncompacted stringspace |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2743 clra ; zero out D and reset pointer to discovered variable to NULL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2744 clrb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2745 std V4B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2746 ldx FRETOP ; point to bottom of string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2747 stx V47 ; save as lowest match address (match will be higher) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2748 ldx #STRSTK ; point to start of string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2749 LB5A0 cmpx TEMPPT ; are we at the top of the string stack? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2750 beq LB5A8 ; brif so - done with the string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2751 bsr LB5D8 ; check for string in uncompacted space (and advance pointer) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2752 bra LB5A0 ; check another on the string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2753 LB5A8 ldx VARTAB ; point to start of scalar variables |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2754 LB5AA cmpx ARYTAB ; end of scalars? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2755 beq LB5B2 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2756 bsr LB5D2 ; check for string in uncompacted space and advance pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2757 bra LB5AA ; check another variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2758 LB5B2 stx V41 ; save address of end of variables (address of first array) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2759 LB5B4 ldx V41 ; get start of the next array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2760 LB5B6 cmpx ARYEND ; end of arrays? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2761 beq LB5EF ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2762 ldd 2,x ; get length of array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2763 addd V41 ; add to start of array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2764 std V41 ; save address of next array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2765 lda 1,x ; get second character of variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2766 bpl LB5B4 ; brif numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2767 ldb 4,x ; get number of dimensions |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2768 aslb ; two bytes per dimension size |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2769 addb #5 ; add in fixed overhead for array descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2770 abx ; now X points to first array element |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2771 LB5CA cmpx V41 ; at the start of the next array? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2772 beq LB5B6 ; brif so - go handle another array |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2773 bsr LB5D8 ; check for string in uncompacted space (and advance pointer) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2774 bra LB5CA ; process next array element |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2775 LB5D2 lda 1,x ; get second character of variable name |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2776 leax 2,x ; move to variable data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2777 bpl LB5EC ; brif numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2778 LB5D8 ldb ,x ; get length of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2779 beq LB5EC ; brif NULL - don't need to check data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2780 ldd 2,x ; get data pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2781 cmpd STRTAB ; is it in compacted string space? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2782 bhi LB5EC ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2783 cmpd V47 ; is it better match than previous best? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2784 bls LB5EC ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2785 stx V4B ; save descriptor address of best match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2786 std V47 ; save new best data pointer match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2787 LB5EC leax 5,x ; move to next descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2788 LB5EE rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2789 LB5EF ldx V4B ; get descriptor address of the matched string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2790 beq LB5EE ; brif we didn't find one - we're done |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2791 clra ; zero extend length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2792 ldb ,x ; get string length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2793 decb ; subtract one (we won't have a NULL string here) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2794 addd V47 ; now D points to the address of the end of the string data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2795 std V43 ; save as top address of move |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2796 ldx STRTAB ; set top of uncompacted space as destination |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2797 stx V41 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2798 jsr LAC20 ; move string to top of uncompactedspace |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2799 ldx V4B ; point to string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2800 ldd V45 ; get new data pointer address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2801 std 2,x ; update descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2802 ldx V45 ; get bottom of copy destination |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2803 leax -1,x ; move back below it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2804 jmp LB593 ; go search for another string to move (and set new bottom of string space) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2805 ; Concatenate two strings. We come here directly from the operator handler rather than via a JSR. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2806 LB60F ldd FPA0+2 ; get string descriptor for the first string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2807 pshs d ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2808 jsr LB223 ; evaluate a second string (concatenation is left associative) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2809 jsr LB146 ; make sure we have a string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2810 puls x ; get back first string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2811 stx RESSGN ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2812 ldb ,x ; get length of first string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2813 ldx FPA0+2 ; get pointer to second string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2814 addb ,x ; add length of second string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2815 bcc LB62A ; brif combined length is OK |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2816 ldb #2*14 ; raise string too long error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2817 jmp LAC46 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2818 LB62A jsr LB50D ; reserve room for new string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2819 ldx RESSGN ; get descriptor address of the first string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2820 ldb ,x ; get length of first string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2821 bsr LB643 ; copy it to string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2822 ldx V4D ; get descriptor address of second string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2823 bsr LB659 ; get string details for second string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2824 bsr LB645 ; copy second string into new string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2825 ldx RESSGN ; get pointer to first string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2826 bsr LB659 ; remove it from the string stack if possible |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2827 jsr LB54C ; put new string on the string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2828 jmp LB168 ; return to expression evaluator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2829 ; Copy B bytes to space pointed to by FRESPC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2830 LB643 ldx 2,x ; get source address from string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2831 LB645 ldu FRESPC ; get destination address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2832 incb ; compensate for decb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2833 bra LB64E ; do the copy |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2834 LB64A lda ,x+ ; copy a byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2835 sta ,u+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2836 LB64E decb ; done yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2837 bne LB64A ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2838 stu FRESPC ; save destination pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2839 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2840 ; Fetch details of string in FPA0+2 and remove from the string stack if possible |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2841 LB654 jsr LB146 ; make sure we have a string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2842 LB657 ldx FPA0+2 ; get descriptor pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2843 LB659 ldb ,x ; get length of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2844 bsr LB675 ; see if it's at the top of the string stack and remove it if so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2845 bne LB672 ; brif not removed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2846 ldx 5+2,x ; get start address of string just removed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2847 leax -1,x ; move pointer down 1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2848 cmpx STRTAB ; is it at the bottom of string space? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2849 bne LB66F ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2850 pshs b ; save length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2851 addd STRTAB ; add length to start of strings (A was cleared previously) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2852 std STRTAB ; save new string space start (deallocated space for this string) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2853 puls b ; get back string length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2854 LB66F leax 1,x ; restore pointer to pointing at the actual string data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2855 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2856 LB672 ldx 2,x ; get data pointer for the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2857 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2858 ; Remove string pointed to by X from the string stack if it is at the top of the stack; return with |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2859 ; A clear and Z set if string removed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2860 LB675 cmpx LASTPT ; is it at the top of the string stack? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2861 bne LB680 ; brif not - do nothing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2862 stx TEMPPT ; save new top of stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2863 leax -5,x ; move the "last" pointer back as well |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2864 stx LASTPT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2865 clra ; flag string removed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2866 LB680 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2867 ; LEN function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2868 LEN bsr LB686 ; get string details |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2869 LB683 jmp LB4F3 ; return unsigned length in B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2870 LB686 bsr LB654 ; get string details and remove from string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2871 clr VALTYP ; set value type to numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2872 tstb ; set flags according to length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2873 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2874 ; CHR$ function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2875 CHR jsr LB70E ; get 8 bit unsigned integer to B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2876 LB68F ldb #1 ; allocate a one byte string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2877 jsr LB56D |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2878 lda FPA0+3 ; get character code |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2879 jsr LB511 ; save reserved string details in temp descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2880 sta ,x ; put character in string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2881 LB69B leas 2,s ; don't go back to function handler - avoid numeric type check |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2882 LB69D jmp LB54C ; return temporary string on string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2883 ; ASC function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2884 ASC bsr LB6A4 ; get first character of argument |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2885 bra LB683 ; return unsigned code in B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2886 LB6A4 bsr LB686 ; fetch string details |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2887 beq LB706 ; brif NULL string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2888 ldb ,x ; get character at start of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2889 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2890 ; LEFT$ function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2891 LEFT bsr LB6F5 ; get arguments from the stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2892 LB6AD clra ; clear pointer offset (set to start of string) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2893 LB6AE cmpb ,x ; are we asking for more characters than there are in the string? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2894 bls LB6B5 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2895 ldb ,x ; only return the number that are in the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2896 clra ; force starting offset to be the start of the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2897 LB6B5 pshs b,a ; save offset and length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2898 jsr LB50F ; reserve space in string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2899 ldx V4D ; point to original string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2900 bsr LB659 ; get string details |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2901 puls b ; get string offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2902 abx ; now X points to the start of the data to copy |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2903 puls b ; get length of copy |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2904 jsr LB645 ; copy the data to the allocated space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2905 bra LB69D ; return temp string on string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2906 ; RIGHT$ function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2907 RIGHT bsr LB6F5 ; get arguments from stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2908 suba ,x ; subtract length of original string from desired length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2909 nega ; now A is offset into old string where we start copying |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2910 bra LB6AE ; go handle everything else |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2911 ; MID$ function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2912 MID ldb #255 ; default length is the whole string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2913 stb FPA0+3 ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2914 jsr GETCCH ; see what we have after offset |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2915 cmpa #') ; end of function? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2916 beq LB6DE ; brif so - no length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2917 jsr LB26D ; force a comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2918 bsr LB70B ; get length parameter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2919 LB6DE bsr LB6F5 ; get string and offset parameters from the stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2920 beq LB706 ; brif we have a 0 offset requested (string offsets are 1-based) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2921 clrb ; clear length counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2922 deca ; subtract one from position parameter (we work on 0-based, param is 1-based) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2923 cmpa ,x ; is start greater than length of string? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2924 bhs LB6B5 ; brif so - return NULL string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2925 tfr a,b ; save absolute position parameter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2926 subb ,x ; now B is postition less length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2927 negb ; now B is amount of string to copy |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2928 cmpb FPA0+3 ; is it less than the length requested? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2929 bls LB6B5 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2930 ldb FPA0+3 ; set length to the requested length |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2931 bra LB6B5 ; go finish up copying the substring |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2932 ; Common routine for LEFT$, RIGHT$, MID$ - check for ) and fetch string data and first parameter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2933 ; from the stack. These were evaluated in the function evaluation handler. (It's not clear that doing |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2934 ; it that way is actually beneficial. However, this is what the ROM designers did, so here we are.) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2935 LB6F5 jsr LB267 ; make sure we have ) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2936 ldu ,s ; get return address - we're going to mess with the stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2937 ldx 5,s ; get address of string descriptor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2938 stx V4D ; save descriptor adddress |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2939 lda 4,s ; get first numeric parameter in both A and B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2940 ldb 4,s |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2941 leas 7,s ; clean up stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2942 tfr u,pc ; return to original caller |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2943 LB706 jmp LB44A ; raise FC error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2944 ; Evaluate an unsigned 8 bit expression to B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2945 LB709 jsr GETNCH ; move to next character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2946 LB70B jsr LB141 ; evaluate a numeric expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2947 LB70E jsr LB3E9 ; convert to integer in D |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2948 tsta ; are we negative or > 255? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2949 bne LB706 ; brif so - FC error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2950 jmp GETCCH ; fetch current input character and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2951 ; VAL function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2952 VAL jsr LB686 ; get string details |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2953 lbeq LBA39 ; brif NULL string - return 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2954 ldu CHARAD ; get input pointer so we can replace it later |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2955 stx CHARAD ; point interpreter at string data |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2956 abx ; calculate end address of the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2957 lda ,x ; get byte after the end of the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2958 pshs u,x,a ; save end of string address, input pointer, and character after end of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2959 clr ,x ; put a NUL after the string (stops the number interpreter) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2960 jsr GETCCH ; get input character at start of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2961 jsr LBD12 ; evaluate numeric expression in string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2962 puls a,x,u ; get back saved character and pointers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2963 sta ,x ; restore byte after string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2964 stu CHARAD ; restore interpeter's input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2965 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2966 ; Evaluate unsigned expression to BINVAL, then evaluate an unsigned expression to B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2967 LB734 bsr LB73D ; evaluate expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2968 stx BINVAL ; save result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2969 LB738 jsr LB26D ; make sure there's a comma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2970 bra LB70B ; evaluate unsigned expression to B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2971 ; Evaluate unsigned expression in X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2972 LB73D jsr LB141 ; evaluate numeric expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2973 LB740 lda FP0SGN ; is it negative? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2974 bmi LB706 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2975 lda FP0EXP ; get exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2976 cmpa #0x90 ; largest possible exponent for 16 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2977 bhi LB706 ; brif too large |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2978 jsr LBCC8 ; move binary point to right of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2979 ldx FPA0+2 ; get resulting unsigned value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2980 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2981 ; PEEK function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2982 PEEK bsr LB740 ; get address to X |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2983 ldb ,x ; get the value at that address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2984 jmp LB4F3 ; return B as unsigned value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2985 ; POKE function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2986 POKE bsr LB734 ; evaluate address and byte value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2987 ldx BINVAL ; get address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2988 stb ,x ; put value there |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2989 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2990 ; LLIST command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2991 LLIST ldb #-2 ; set output device to printer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2992 stb DEVNUM |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2993 jsr GETCCH ; reset flags for input character and fall through to LIST |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2994 ; LIST command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2995 LIST pshs cc ; save zero flag (end of statement) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2996 jsr LAF67 ; parse line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2997 jsr LAD01 ; find address of that line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2998 stx LSTTXT ; save that address as the start of the list |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
2999 puls cc ; get back ent of statement flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3000 beq LB784 ; brif end of line - list whole program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3001 jsr GETCCH ; are we at the end of the line (one number)? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3002 beq LB789 ; brif end of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3003 cmpa #0xac ; is it "-"? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3004 bne LB783 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3005 jsr GETNCH ; eat the "-" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3006 beq LB784 ; brif no second number - list to end of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3007 jsr LAF67 ; evaluate the second number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3008 beq LB789 ; brif illegal number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3009 LB783 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3010 LB784 ldu #0xffff ; this will cause listing to do the entire program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3011 stu BINVAL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3012 LB789 leas 2,s ; don't return to the caller - we'll jump back to the main loop |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3013 ldx LSTTXT ; get address of line to list |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3014 LB78D jsr LB95C ; do a newline if needed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3015 jsr LA549 ; do a break check |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3016 ldd ,x ; get address of next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3017 bne LB79F ; brif not end of program |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3018 LB797 jsr LA42D ; close output file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3019 clr DEVNUM ; reset device to screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3020 jmp LAC73 ; go back to immediate mode |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3021 LB79F stx LSTTXT ; save new line address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3022 ldd 2,x ; get line number of this line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3023 cmpd BINVAL ; is it above the end line? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3024 bhi LB797 ; brif so - return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3025 jsr LBDCC ; display line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3026 jsr LB9AC ; put a space after it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3027 ldx LSTTXT ; get line address |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3028 bsr LB7C2 ; detokenize the line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3029 ldx [LSTTXT] ; get pointer to next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3030 ldu #LINBUF+1 ; point to start of detokenized line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3031 LB7B9 lda ,u+ ; get byte from detokenized line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3032 beq LB78D ; brif end of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3033 jsr LB9B1 ; output character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3034 bra LB7B9 ; handle next character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3035 ; Detokenize a line from (X) to the line input buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3036 LB7C2 jsr RVEC24 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3037 leax 4,x ; move past next line pointer and line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3038 ldy #LINBUF+1 ; point to line input buffer (destination) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3039 LB7CB lda ,x+ ; get character from tokenized line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3040 beq LB820 ; brif end of input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3041 bmi LB7E6 ; brif it's a token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3042 cmpa #': ; colon? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3043 bne LB7E2 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3044 ldb ,x ; get what's after the colon |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3045 cmpb #0x84 ; ELSE? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3046 beq LB7CB ; brif so - suppress the colon |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3047 cmpb #0x83 ; '? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3048 beq LB7CB ; brif so - suppress the colon |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3049 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3050 LB7E0 lda #'! ; placeholder for unknown token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3051 LB7E2 bsr LB814 ; stow output character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3052 bra LB7CB ; go process another input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3053 LB7E6 ldu #COMVEC-10 ; point to command interptation table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3054 cmpa #0xff ; is it a function? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3055 bne LB7F1 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3056 lda ,x+ ; get function token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3057 leau 5,u ; shift to the function half of the interpretation tables |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3058 LB7F1 anda #0x7f ; remove token bias |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3059 LB7F3 leau 10,u ; move to next command/function table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3060 tst ,u ; is this table active? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3061 beq LB7E0 ; brif not - use place holder |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3062 suba ,u ; subtract number of tokens handled by this table entry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3063 bpl LB7F3 ; brif this token isn't handled here |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3064 adda ,u ; undo extra subtraction |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3065 ldu 1,u ; get reserved word list for this table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3066 LB801 deca ; are we at the right entry? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3067 bmi LB80A ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3068 LB804 tst ,u+ ; end of entry? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3069 bpl LB804 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3070 bra LB801 ; see if we're there yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3071 LB80A lda ,u ; get character from wordlist |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3072 bsr LB814 ; put character in the buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3073 tst ,u+ ; end of word? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3074 bpl LB80A ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3075 bra LB7CB ; go handle another input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3076 LB814 cmpy #LINBUF+LBUFMX ; is there room? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3077 bhs LB820 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3078 anda #0x7f ; lose bit 7 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3079 sta ,y+ ; save character in output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3080 clr ,y ; make sure there's always a NUL terminator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3081 LB820 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3082 ; Tokenize the line that the input pointer is pointing to; put result in the line input buffer; return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3083 ; length in D |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3084 LB821 jsr RVEC23 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3085 ldx CHARAD ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3086 ldu #LINBUF ; set destination pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3087 LB829 clr V43 ; clear alpha string flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3088 clr V44 ; clear DATA flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3089 LB82D lda ,x+ ; get input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3090 beq LB852 ; brif end of input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3091 tst V43 ; are we handling an alphanumeric string? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3092 beq LB844 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3093 jsr LB3A2 ; set carry if not alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3094 bcc LB852 ; brif alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3095 cmpa #'0 ; is it below the digits? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3096 blo LB842 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3097 cmpa #'9 ; is it within the digits? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3098 bls LB852 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3099 LB842 clr V43 ; flag that we're past the alphanumeric string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3100 LB844 cmpa #0x20 ; space? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3101 beq LB852 ; brif so - keep it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3102 sta V42 ; save scan delimiter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3103 cmpa #'" ; string delimiter? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3104 beq LB886 ; brif so - copy until another " |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3105 tst V44 ; doing "DATA"? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3106 beq LB86B ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3107 LB852 sta ,u+ ; put character in output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3108 beq LB85C ; brif end of input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3109 cmpa #': ; colon? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3110 beq LB829 ; brif so - reset DATA and alpha string flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3111 LB85A bra LB82D ; go process another input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3112 LB85C clr ,u+ ; put a double NUL at the end |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3113 clr ,u+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3114 tfr u,d ; calculate length of result (includes double NUL and an extra two bytes) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3115 subd #LINHDR |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3116 ldx #LINBUF-1 ; point to one before the output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3117 stx CHARAD ; set input pointer there |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3118 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3119 LB86B cmpa #'? ; print abbreviation? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3120 bne LB873 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3121 lda #0x87 ; token for PRINT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3122 bra LB852 ; go stash it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3123 LB873 cmpa #'' ; REM abbreviation? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3124 bne LB88A ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3125 ldd #0x3a83 ; colon plus ' token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3126 std ,u++ ; put it in the output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3127 LB87C clr V42 ; set delimiter to NUL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3128 LB87E lda ,x+ ; get input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3129 beq LB852 ; brif end of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3130 cmpa V42 ; at the delimiter? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3131 beq LB852 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3132 LB886 sta ,u+ ; save in output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3133 bra LB87E ; keep scanning for delimiter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3134 LB88A cmpa #'0 ; is it below digits? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3135 blo LB892 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3136 cmpa #';+1 ; is it digit, colon, or semicolon? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3137 blo LB852 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3138 LB892 leax -1,x ; move input pointer back one (to point at this input character) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3139 pshs u,x ; save input and output pointers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3140 clr V41 ; set token type to 0 (command) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3141 ldu #COMVEC-10 ; point to command interpretation table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3142 LB89B clr V42 ; set token counter to 0 (0x80) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3143 LB89D leau 10,u ; |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3144 lda ,u ; get number of reserved words |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3145 beq LB8D4 ; brif this table isn't active |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3146 ldy 1,u ; point to reserved words list |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3147 LB8A6 ldx ,s ; get input pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3148 LB8A8 ldb ,y+ ; get character from reserved word table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3149 subb ,x+ ; compare with input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3150 beq LB8A8 ; brif exact match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3151 cmpb #0x80 ; brif it was the last character in word and exact match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3152 bne LB8EA ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3153 leas 2,s ; remove original input pointer from stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3154 puls u ; get back output pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3155 orb V42 ; create token value (B has 0x80 from above) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3156 lda V41 ; get token type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3157 bne LB8C2 ; brif function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3158 cmpb #0x84 ; is it ELSE? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3159 bne LB8C6 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3160 lda #': ; silently add a colon before ELSE |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3161 LB8C2 std ,u++ ; put two byte token into output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3162 bra LB85A ; go handle more input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3163 LB8C6 stb ,u+ ; save single byte token |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3164 cmpb #0x86 ; DATA? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3165 bne LB8CE ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3166 inc V44 ; set DATA flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3167 LB8CE cmpb #0x82 ; REM? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3168 beq LB87C ; brif so - skip over rest of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3169 LB8D2 bra LB85A ; go handle more input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3170 LB8D4 ldu #COMVEC-5 ; point to interpretation table, function style |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3171 LB8D7 com V41 ; invert token flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3172 bne LB89B ; brif we haven't already done functions |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3173 puls x,u ; restore input and output pointers |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3174 lda ,x+ ; copy first character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3175 sta ,u+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3176 jsr LB3A2 ; set C if not alpha |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3177 bcs LB8D2 ; brif not alpha - it isn't a variable |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3178 com V43 ; set alphanumeric string flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3179 bra LB8D2 ; process more input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3180 LB8EA inc V42 ; bump token number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3181 deca ; checked all in this table? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3182 beq LB89D ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3183 leay -1,y ; unconsume last compared character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3184 LB8F1 ldb ,y+ ; end of entry? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3185 bpl LB8F1 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3186 bra LB8A6 ; check next reserved word |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3187 ; PRINT command |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3188 PRINT beq LB958 ; brif no argument - do a newline |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3189 bsr LB8FE ; process print options |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3190 clr DEVNUM ; reset output to screen |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3191 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3192 LB8FE cmpa #'@ ; is it PRINT @? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3193 bne LB907 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3194 jsr LA554 ; move cursor to correct location |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3195 bra LB911 ; handle some more |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3196 LB907 cmpa #'# ; device number specified? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3197 bne LB918 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3198 jsr LA5A5 ; parse device number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3199 jsr LA406 ; check for valid output file |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3200 LB911 jsr GETCCH ; get input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3201 beq LB958 ; brif nothing - do newline |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3202 jsr LB26D ; need comma after @ or # |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3203 LB918 jsr RVEC9 ; do the RAM hook boogaloo |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3204 LB91B beq LB965 ; brif end of input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3205 LB91D cmpa #0xa4 ; TAB(? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3206 beq LB97E ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3207 cmpa #', ; comma (next tab field)? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3208 beq LB966 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3209 cmpa #'; ; semicolon (do not advance print position) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3210 beq LB997 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3211 jsr LB156 ; evaluate expression |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3212 lda VALTYP ; get type of value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3213 pshs a ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3214 bne LB938 ; brif string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3215 jsr LBDD9 ; convert FP number to string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3216 jsr LB516 ; parse a string and put on string stack |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3217 LB938 bsr LB99F ; print string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3218 puls b ; get back variable type |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3219 jsr LA35F ; set up print parameters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3220 tst PRTDEV ; is it a display device? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3221 beq LB949 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3222 bsr LB958 ; do a newline |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3223 jsr GETCCH ; get input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3224 bra LB91B ; process more print stuff |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3225 LB949 tstb ; set flags on print position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3226 bne LB954 ; brif not at start of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3227 jsr GETCCH ; get current input |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3228 cmpa #', ; comma? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3229 beq LB966 ; skip to next tab field if so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3230 bsr LB9AC ; send a space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3231 LB954 jsr GETCCH ; get input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3232 bne LB91D ; brif not end of statement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3233 LB958 lda #0x0d ; carriage return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3234 bra LB9B1 ; send it to output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3235 LB95C jsr LA35F ; set up print parameters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3236 LB95F beq LB958 ; brif width is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3237 lda DEVPOS ; get line position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3238 bne LB958 ; brif not at start of line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3239 LB965 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3240 LB966 jsr LA35F ; set up print parameters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3241 beq LB975 ; brif line width is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3242 ldb DEVPOS ; get line position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3243 cmpb DEVLCF ; at or past last comma field? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3244 blo LB977 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3245 bsr LB958 ; move to next line |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3246 bra LB997 ; handle more stuff |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3247 LB975 ldb DEVPOS ; get line position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3248 LB977 subb DEVCFW ; subtract a comma field width |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3249 bhs LB977 ; brif we don't have a remainder yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3250 negb ; now B is number of of spaces needed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3251 bra LB98E ; go advance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3252 LB97E jsr LB709 ; evaluate TAB distance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3253 cmpa #') ; closing )? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3254 lbne LB277 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3255 jsr LA35F ; set up print parameters |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3256 subb DEVPOS ; subtract print position from desired position |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3257 bls LB997 ; brif we're already past it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3258 LB98E tst PRTDEV ; is it a display device? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3259 bne LB997 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3260 LB992 bsr LB9AC ; output a space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3261 decb ; done enough? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3262 bne LB992 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3263 LB997 jsr GETNCH ; get input character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3264 jmp LB91B ; process more items |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3265 ; cpoy string from (X-1) to output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3266 LB99C jsr LB518 ; parse the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3267 LB99F jsr LB657 ; get string details |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3268 LB9A2 incb ; compensate for decb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3269 LB9A3 decb ; done all of the string? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3270 beq LB965 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3271 lda ,x+ ; get character from string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3272 bsr LB9B1 ; send to output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3273 bra LB9A3 ; go do another character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3274 LB9AC lda #0x20 ; space character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3275 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3276 LB9AF lda #'? ; question mark character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3277 LB9B1 jmp PUTCHR ; output character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3278 ; The floating point math package and related functions and operations follow from here |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3279 ; to the end of the Color Basic ROM area |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3280 LB9B4 ldx #LBEC0 ; point to FP constant 0.5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3281 bra LB9C2 ; add 0.5 to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3282 LB9B9 jsr LBB2F ; unpack FP data from (X) to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3283 ; subtraction operator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3284 LB9BC com FP0SGN ; invert sign of FPA0 (subtracting is adding the negative) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3285 com RESSGN ; that also inverts the sign differential |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3286 bra LB9C5 ; go add the negative of FPA0 to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3287 LB9C2 jsr LBB2F ; unpack FP data from (X) to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3288 ; addition operator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3289 LB9C5 tstb ; check exponent of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3290 lbeq LBC4A ; copy FPA1 to FPA0 if FPA0 is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3291 ldx #FP1EXP ; point X to FPA1 (first operand) as the operand to denormalize |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3292 LB9CD tfr a,b ; put exponent of FPA1 into B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3293 tstb ; is FPA1 0? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3294 beq LBA3E ; brif exponent is 0 - no-op; adding 0 to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3295 subb FP0EXP ; get difference in exponents - number of bits to shift the smaller mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3296 beq LBA3F ; brif exponents are equal - no need to denormalize |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3297 blo LB9E2 ; brif FPA0 > FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3298 sta FP0EXP ; replace result exponent with FPA1's (FPA1 is bigger) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3299 lda FP1SGN ; also copy sign over |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3300 sta FP0SGN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3301 ldx #FP0EXP ; point to FPA0 (we need to denormalize the smaller number) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3302 negb ; invert the difference - this is the number of bits to shift the mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3303 LB9E2 cmpb #-8 ; do we have to shift by a whole byte? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3304 ble LBA3F ; brif so start by shifting whole bytes to the right |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3305 clra ; clear overflow byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3306 lsr 1,x ; shift high bit of mantissa right (LSR will force a zero into the high bit) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3307 jsr LBABA ; shift remainder of mantissa right -B times |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3308 LB9EC ldb RESSGN ; get the sign flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3309 bpl LB9FB ; brif signs are the same (we add the mantissas then) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3310 com 1,x ; complement the mantissa and extra precision bytes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3311 com 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3312 com 3,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3313 com 4,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3314 coma |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3315 adca #0 ; add one to A (COM sets C); this may cause a carry to enter the ADD below |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3316 LB9FB sta FPSBYT ; save extra precision byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3317 lda FPA0+3 ; add the main mantissa bytes (and propage carry from above) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3318 adca FPA1+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3319 sta FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3320 lda FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3321 adca FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3322 sta FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3323 lda FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3324 adca FPA1+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3325 sta FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3326 lda FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3327 adca FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3328 sta FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3329 tstb ; were signs the same? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3330 bpl LBA5C ; brif so - number may have gotten bigger so normalize if needed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3331 LBA18 bcs LBA1C ; brif we had a carry - result is positive?) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3332 bsr LBA79 ; do a proper negation of FPA0 mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3333 LBA1C clrb ; clear temporary exponent accumulator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3334 LBA1D lda FPA0 ; test high byte of mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3335 bne LBA4F ; brif not 0 - we need to do bit shifting |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3336 lda FPA0+1 ; shift left 8 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3337 sta FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3338 lda FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3339 sta FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3340 lda FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3341 sta FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3342 lda FPSBYT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3343 sta FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3344 clr FPSBYT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3345 addb #8 ; account for 8 bits shifted |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3346 cmpb #5*8 ; shifted 5 bytes worth? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3347 blt LBA1D ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3348 LBA39 clra ; zero out exponent and sign - result is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3349 LBA3A sta FP0EXP ; set exponent and sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3350 sta FP0SGN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3351 LBA3E rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3352 LBA3F bsr LBAAE ; shift FPA0 mantissa to the right |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3353 clrb ; clear carry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3354 bra LB9EC ; get on with adding |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3355 LBA44 incb ; account for one bit shift |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3356 asl FPSBYT ; shift mantissa and extra precision left |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3357 rol FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3358 rol FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3359 rol FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3360 rol FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3361 LBA4F bpl LBA44 ; brif we haven't got a 1 in bit 7 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3362 lda FP0EXP ; get exponent of result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3363 pshs b ; subtract shift count from exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3364 suba ,s+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3365 sta FP0EXP ; save adjusted exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3366 bls LBA39 ; brif we underflowed - set result to 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3367 skip2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3368 LBA5C bcs LBA66 ; brif mantissa overflowed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3369 asl FPSBYT ; get bit 7 of expra precision to C (used for round off) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3370 lda #0 ; set to 0 without affecting C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3371 sta FPSBYT ; clear out extra precision bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3372 bra LBA72 ; go round off result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3373 LBA66 inc FP0EXP ; bump exponent (for a right shift to bring carry in) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3374 beq LBA92 ; brif we overflowed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3375 ror FPA0 ; shift carry into mantissa, shift right |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3376 ror FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3377 ror FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3378 ror FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3379 LBA72 bcc LBA78 ; brif no round-off needed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3380 bsr LBA83 ; add one to mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3381 beq LBA66 ; brif carry - need to shift right again |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3382 LBA78 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3383 LBA79 com FP0SGN ; invert sign of value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3384 LBA7B com FPA0 ; first do a one's copmlement |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3385 com FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3386 com FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3387 com FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3388 LBA83 ldx FPA0+2 ; add one to mantissa (after one's complement gives two's complement) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3389 leax 1,x ; bump low word |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3390 stx FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3391 bne LBA91 ; brif no carry from low word |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3392 ldx FPA0 ; bump high word |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3393 leax 1,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3394 stx FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3395 LBA91 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3396 LBA92 ldb #2*5 ; code for overflow |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3397 jmp LAC46 ; raise error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3398 LBA97 ldx #FPA2-1 ; point to FPA2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3399 LBA9A lda 4,x ; shift mantissa right by 8 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3400 sta FPSBYT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3401 lda 3,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3402 sta 4,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3403 lda 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3404 sta 3,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3405 lda 1,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3406 sta 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3407 lda FPCARY ; and handle extra precision on the left |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3408 sta 1,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3409 LBAAE addb #8 ; account for 8 bits shifted |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3410 ble LBA9A ; brif more shifts needed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3411 lda FPSBYT ; get sub byte (extra precision) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3412 subb #8 ; undo the 8 added above |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3413 beq LBAC4 ; brif difference is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3414 LBAB8 asr 1,x ; shift mantissa and sub byte one bit (keep mantissa high bit set) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3415 LBABA ror 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3416 ror 3,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3417 ror 4,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3418 rora |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3419 incb ; account for one shift |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3420 bne LBAB8 ; brif not enought shifts yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3421 LBAC4 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3422 LBAC5 fcb 0x81,0x00,0x00,0x00,0x00 ; packed FP 1.0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3423 LBACA bsr LBB2F ; unpack FP value from (X) to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3424 ; multiplication operator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3425 LBACC beq LBB2E ; brif exponent of FPA0 is 0 (result is 0) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3426 bsr LBB48 ; calculate exponent of product |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3427 LBAD0 lda #0 ; zero out mantissa of FPA2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3428 sta FPA2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3429 sta FPA2+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3430 sta FPA2+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3431 sta FPA2+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3432 ldb FPA0+3 ; multiply FPA1 by LSB of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3433 bsr LBB00 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3434 ldb FPSBYT ; save extra precision byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3435 stb VAE |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3436 ldb FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3437 bsr LBB00 ; again for next byte of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3438 ldb FPSBYT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3439 stb VAD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3440 ldb FPA0+1 ; again for next byte of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3441 bsr LBB00 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3442 ldb FPSBYT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3443 stb VAC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3444 ldb FPA0 ; and finally for the high byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3445 bsr LBB02 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3446 ldb FPSBYT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3447 stb VAB |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3448 jsr LBC0B ; copy mantissa from FPA2 to FPA0 (result) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3449 jmp LBA1C ; normalize |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3450 LBB00 beq LBA97 ; brif multiplier is 0 - just shift, don't multiply |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3451 LBB02 coma ; set carry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3452 LBB03 lda FPA2 ; get FPA2 MS byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3453 rorb ; data bit to carry; will be 0 when all shifts done |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3454 beq LBB2E ; brif 8 shifts done |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3455 bcc LBB20 ; brif data bit is 0 - no addition |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3456 lda FPA2+3 ; add mantissa of FPA1 and FPA2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3457 adda FPA1+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3458 sta FPA2+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3459 lda FPA2+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3460 adca FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3461 sta FPA2+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3462 lda FPA2+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3463 adca FPA1+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3464 sta FPA2+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3465 lda FPA2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3466 adca FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3467 LBB20 rora ; shift carry into FPA2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3468 sta FPA2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3469 ror FPA2+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3470 ror FPA2+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3471 ror FPA2+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3472 ror FPSBYT |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3473 clra ; clear carry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3474 bra LBB03 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3475 LBB2E rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3476 ; Unpack FP value from (X) to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3477 LBB2F ldd 1,x ; copy mantissa (and sign) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3478 sta FP1SGN ; save sign bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3479 ora #0x80 ; make sure mantissa has bit 7 set |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3480 std FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3481 ldb FP1SGN ; get sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3482 eorb FP0SGN ; set if FPA0 sign differs |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3483 stb RESSGN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3484 ldd 3,x ; copy remainder of mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3485 std FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3486 lda ,x ; and exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3487 sta FP1EXP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3488 ldb FP0EXP ; fetch FPA0 exponent and set flags |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3489 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3490 ; Calculate eponent for product of FPA0 and FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3491 LBB48 tsta ; is FPA1 zero? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3492 beq LBB61 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3493 adda FP0EXP ; add to exponent of FPA0 (this is how scientific notation works) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3494 rora ; set V if we *don't* have an overflow |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3495 rola |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3496 bvc LBB61 ; brif exponent too larger or small |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3497 adda #0x80 ; restore the bias |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3498 sta FP0EXP ; set result exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3499 beq LBB63 ; brif 0 - clear FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3500 lda RESSGN ; the result sign (negative if signs differ) is the result sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3501 sta FP0SGN ; so set it as such |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3502 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3503 LBB5C lda FP0SGN ; get sign of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3504 coma ; invert sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3505 bra LBB63 ; zero sign and exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3506 LBB61 leas 2,s ; don't go back to caller (mul/div) - return to previous caller |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3507 LBB63 lbpl LBA39 ; brif we underflowed - go zero things out |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3508 LBB67 jmp LBA92 ; raise overflow error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3509 ; fast multiply by 10 - leave result in FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3510 LBB6A jsr LBC5F ; copy FPA0 to FPA1 (for addition later) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3511 beq LBB7C ; brif exponent is 0 - it's a no-op then |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3512 adda #2 ; this gives "times 4" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3513 bcs LBB67 ; raise overflow if required |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3514 clr RESSGN ; set result sign to "signs the same" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3515 jsr LB9CD ; add FPA1 to FPA0 "times 5" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3516 inc FP0EXP ; times 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3517 beq LBB67 ; brif overflow |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3518 LBB7C rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3519 LBB7D fcb 0x84,0x20,0x00,0x00,0x00 ; packed FP constant 10.0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3520 ; Divide by 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3521 LBB82 jsr LBC5F ; move FPA0 to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3522 ldx #LBB7D ; point to constant 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3523 clrb ; zero sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3524 LBB89 stb RESSGN ; result will be positive or zero |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3525 jsr LBC14 ; unpack constant 10 to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3526 skip2 ; fall through to division (divide FPA1 by 10) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3527 LBB8F bsr LBB2F ; unpack FP number from (X) to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3528 ; division operator |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3529 LBB91 beq LBC06 ; brif FPA0 is 0 - division by zero |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3530 neg FP0EXP ; get exponent of reciprocal of the divisor |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3531 bsr LBB48 ; calculate exponent of quotient |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3532 inc FP0EXP ; bump exponent (due to division algorithm below) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3533 beq LBB67 ; brif overflow |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3534 ldx #FPA2 ; point to temporary storage location |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3535 ldb #4 ; do 5 bytes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3536 stb TMPLOC ; save counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3537 ldb #1 ; shift counter and quotient byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3538 LBBA4 lda FPA0 ; compare mantissa of FPA0 to FPA1, set C if FPA1 less |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3539 cmpa FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3540 bne LBBBD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3541 lda FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3542 cmpa FPA1+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3543 bne LBBBD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3544 lda FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3545 cmpa FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3546 bne LBBBD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3547 lda FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3548 cmpa FPA1+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3549 bne LBBBD |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3550 coma ; set C if FPA0 = FPA1 (it "goes") |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3551 LBBBD tfr cc,a ; save "it goes" status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3552 rolb ; rotate carry into quotient |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3553 bcc LBBCC ; brif carry clear - haven't done 8 shifts yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3554 stb ,x+ ; save quotient byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3555 dec TMPLOC ; done enough bytes? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3556 bmi LBBFC ; brif done all 5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3557 beq LBBF8 ; brif last byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3558 ldb #1 ; reset shift counter and quotient byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3559 LBBCC tfr a,cc ; get back carry status |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3560 bcs LBBDE ; brif it "went" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3561 LBBD0 asl FPA1+3 ; shift mantissa (dividend) left |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3562 rol FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3563 rol FPA1+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3564 rol FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3565 bcs LBBBD ; brif carry - it "goes" so we have to bump quotient |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3566 bmi LBBA4 ; brif high order bit is set - compare mantissas |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3567 bra LBBBD ; otherwise, count a 0 bit and try next bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3568 LBBDE lda FPA1+3 ; subtract mantissa of FPA0 from mantissa of FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3569 suba FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3570 sta FPA1+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3571 lda FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3572 sbca FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3573 sta FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3574 lda FPA1+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3575 sbca FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3576 sta FPA1+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3577 lda FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3578 sbca FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3579 sta FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3580 bra LBBD0 ; go check for another go |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3581 LBBF8 ldb #0x40 ; only two bits in last byte (for rounding) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3582 bra LBBCC ; go do the last byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3583 LBBFC rorb ; get low bits to bits 7,6 and C to bit 5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3584 rorb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3585 rorb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3586 stb FPSBYT ; save result extra precision |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3587 bsr LBC0B ; move FPA2 mantissa to FPA0 (result) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3588 jmp LBA1C ; go normalize the result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3589 LBC06 ldb #2*10 ; division by zero |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3590 jmp LAC46 ; raise error |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3591 ; Copy mantissa of FPA2 to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3592 LBC0B ldx FPA2 ; copy high word |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3593 stx FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3594 ldx FPA2+2 ; copy low word |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3595 stx FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3596 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3597 ; unpack FP number at (X) to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3598 LBC14 pshs a ; save register |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3599 ldd 1,x ; get mantissa high word and sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3600 sta FP0SGN ; set sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3601 ora #0x80 ; make sure mantissa always has bit 7 set |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3602 std FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3603 clr FPSBYT ; clear extra precision |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3604 ldb ,x ; get exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3605 ldx 3,x ; copy mantissa low word |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3606 stx FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3607 stb FP0EXP ; save exponent (and set flags) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3608 puls a,pc ; restore register and return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3609 LBC2A ldx #V45 ; point to FPA4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3610 bra LBC35 ; pack FPA0 there |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3611 LBC2F ldx #V40 ; point to FPA3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3612 skip2 ; fall through to pack FPA0 there |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3613 LBC33 ldx VARDES ; get variable descriptor pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3614 ; Pack FPA0 to (X) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3615 LBC35 lda FP0EXP ; get exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3616 sta ,x ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3617 lda FP0SGN ; get sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3618 ora #0x7f ; force set low bits - only keep sign in high bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3619 anda FPA0 ; merge in bits 6-0 of high byte of mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3620 sta 1,x ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3621 lda FPA0+1 ; copy next highest byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3622 sta 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3623 ldu FPA0+2 ; and the low word of the mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3624 stu 3,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3625 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3626 ; Copy FPA1 to FPA0; return with sign in A |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3627 LBC4A lda FP1SGN ; copy sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3628 LBC4C sta FP0SGN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3629 ldx FP1EXP ; copy exponent, mantissa high byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3630 stx FP0EXP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3631 clr FPSBYT ; clear extra precision |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3632 lda FPA1+1 ; copy mantissa second highest byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3633 sta FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3634 lda FP0SGN ; set sign for return |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3635 ldx FPA1+2 ; copy low word of mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3636 stx FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3637 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3638 ; Copy FPA0 to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3639 LBC5F ldd FP0EXP ; copy exponent and high byte of mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3640 std FP1EXP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3641 ldx FPA0+1 ; copy middle bytes of mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3642 stx FPA1+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3643 ldx FPA0+3 ; copy low byte of mantissa and sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3644 stx FPA1+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3645 tsta ; set flags on exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3646 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3647 ; check FPA0: return B = 0, if FPA0 is 0, 0xff if negative, and 0x01 if positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3648 LBC6D ldb FP0EXP ; get exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3649 beq LBC79 ; brif 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3650 LBC71 ldb FP0SGN ; get sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3651 LBC73 rolb ; get sign to C |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3652 ldb #0xff ; set for negative result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3653 bcs LBC79 ; brif negative |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3654 negb ; set to 1 for positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3655 LBC79 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3656 ; SGN function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3657 SGN bsr LBC6D ; get sign of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3658 LBC7C stb FPA0 ; save result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3659 clr FPA0+1 ; clear next lower 8 bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3660 ldb #0x88 ; exponent if mantissa is 8 bit integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3661 LBC82 lda FPA0 ; get high bits of mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3662 suba #0x80 ; set C if mantissa was positive (will cause a negation if it was negative) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3663 LBC86 stb FP0EXP ; set exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3664 ldd ZERO ; clear out low word |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3665 std FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3666 sta FPSBYT ; clear extra precision |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3667 sta FP0SGN ; set sign to positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3668 jmp LBA18 ; normalize the result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3669 ; ABS function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3670 ABS clr FP0SGN ; force FPA0 to be positive (yes, it's that simple) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3671 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3672 ; Compare packed FP number at (X) to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3673 ; Return with B = -1, 0, 1 for FPA0 <, =, > (X) and flags set based on that |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3674 LBC96 ldb ,x ; get exponent of (X) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3675 beq LBC6D ; brif (X) is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3676 ldb 1,x ; get MS byte of mantissa of (X) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3677 eorb FP0SGN ; set bit 7 if signs of (X) and FPA0 differ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3678 bmi LBC71 ; brif signs differ - no need to compare the magnitude |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3679 LBCA0 ldb FP0EXP ; compare exponents and brif different |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3680 cmpb ,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3681 bne LBCC3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3682 ldb 1,x ; compare mantissa (but we have to pack the FPA0 bits first |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3683 orb #0x7f ; keep only sign bit (note: signs are the same) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3684 andb FPA0 ; merge in the mantissa bits from FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3685 cmpb 1,x ; do the packed versions match? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3686 bne LBCC3 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3687 ldb FPA0+1 ; compare second byte of mantissas |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3688 cmpb 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3689 bne LBCC3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3690 ldb FPA0+2 ; compare third byte of mantissas |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3691 cmpb 3,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3692 bne LBCC3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3693 ldb FPA0+3 ; compare low byte of mantissas, but use subtraction so B = 0 on match |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3694 subb 4,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3695 bne LBCC3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3696 rts ; return B = 0 if (X) = FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3697 LBCC3 rorb ; shift carry to bit 7 (C set if FPA0 < (X)) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3698 eorb FP0SGN ; invert the comparision sense if the signs are negative |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3699 bra LBC73 ; interpret comparison result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3700 ; Shift mantissa of FPA0 until the binary point is immediately to the right of the mantissa and set up the |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3701 ; result as a two's complement value. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3702 LBCC8 ldb FP0EXP ; get exponent of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3703 beq LBD09 ; brif FPA0 is zero - we don't have to do anything, just blank it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3704 subb #0xa0 ; calculate number of shifts to get to the correct exponent (binary point to the right) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3705 lda FP0SGN ; do we have a positive number? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3706 bpl LBCD7 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3707 com FPCARY ; negate the mantissa and set extra inbound precision to the correct sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3708 jsr LBA7B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3709 LBCD7 ldx #FP0EXP ; point to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3710 cmpb #-8 ; moving by whole bytes? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3711 bgt LBCE4 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3712 jsr LBAAE ; do bit shifting |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3713 clr FPCARY ; clear carry in byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3714 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3715 LBCE4 clr FPCARY ; clear the extra carry in precision |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3716 lda FP0SGN ; get sign of value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3717 rola ; get sign to carry (so rotate repeats the sign) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3718 ror FPA0 ; shift the first bit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3719 jmp LBABA ; do the shifting dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3720 ; INT function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3721 INT ldb FP0EXP ; get exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3722 cmpb #0xa0 ; is the number big enough that there can be no fractional part? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3723 bhs LBD11 ; brif so - we don't have to do anything |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3724 bsr LBCC8 ; go shift binary point to the right of the mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3725 stb FPSBYT ; save extra precision bits |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3726 lda FP0SGN ; get original sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3727 stb FP0SGN ; force result to be positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3728 suba #0x80 ; set C if we had a positive result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3729 lda #0xa0 ; set exponent to match denormalized result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3730 sta FP0EXP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3731 lda FPA0+3 ; save low byte |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3732 sta CHARAC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3733 jmp LBA18 ; go normalize (this will correct for the two's complement representation of negatives) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3734 LBD09 stb FPA0 ; replace mantissa of FPA0 with contents of B |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3735 stb FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3736 stb FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3737 stb FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3738 LBD11 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3739 ; Convert ASCII string to FP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3740 ; BUG: no overflow is checked on the decimal exponent in exponential notation. |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3741 LBD12 ldx ZERO ; zero out FPA0 and temporaries |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3742 stx FP0SGN |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3743 stx FP0EXP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3744 stx FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3745 stx FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3746 stx V47 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3747 stx V45 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3748 bcs LBD86 ; brif input character is numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3749 jsr RVEC19 ; do the RAM hook dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3750 cmpa #'- ; regular negative sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3751 bne LBD2D ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3752 com COEFCT ; invert sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3753 bra LBD31 ; process stuff after the sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3754 LBD2D cmpa #'+ ; regular plus? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3755 bne LBD35 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3756 LBD31 jsr GETNCH ; get character after sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3757 bcs LBD86 ; brif numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3758 LBD35 cmpa #'. ; decimal point? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3759 beq LBD61 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3760 cmpa #'E ; scientific notation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3761 bne LBD65 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3762 jsr GETNCH ; eat the "E" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3763 bcs LBDA5 ; brif numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3764 cmpa #0xac ; negative sign (token)? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3765 beq LBD53 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3766 cmpa #'- ; regular negative? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3767 beq LBD53 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3768 cmpa #0xab ; plus sign (token)? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3769 beq LBD55 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3770 cmpa #'+ ; regular plus? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3771 beq LBD55 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3772 bra LBD59 ; brif no sign found |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3773 LBD53 com V48 ; set exponent sign to negative |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3774 LBD55 jsr GETNCH ; eat the sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3775 bcs LBDA5 ; brif numeric |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3776 LBD59 tst V48 ; is the exponent sign negatvie? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3777 beq LBD65 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3778 neg V47 ; negate base 10 exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3779 bra LBD65 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3780 LBD61 com V46 ; toggle decimal point flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3781 bne LBD31 ; brif we haven't seen two decimal points |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3782 LBD65 lda V47 ; get base 10 exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3783 suba V45 ; subtract number of places to the right |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3784 sta V47 ; we now have a complete decimal exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3785 beq LBD7F ; brif we have no base 10 shifting required |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3786 bpl LBD78 ; brif positive exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3787 LBD6F jsr LBB82 ; divide FPA0 by 10 (shift decimal point left) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3788 inc V47 ; bump exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3789 bne LBD6F ; brif we haven't reached 0 yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3790 bra LBD7F ; return result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3791 LBD78 jsr LBB6A ; multiply by 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3792 dec V47 ; downshift the exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3793 bne LBD78 ; brif not at 0 yet |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3794 LBD7F lda COEFCT ; get desired sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3795 bpl LBD11 ; brif it will be positive - no need to do anything |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3796 jmp LBEE9 ; flip the sign of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3797 LBD86 ldb V45 ; get the decimal count |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3798 subb V46 ; (if decimal seen, will add one; otherwise it does nothing) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3799 stb V45 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3800 pshs a ; save new digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3801 jsr LBB6A ; multiply partial result by 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3802 puls b ; get back digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3803 subb #'0 ; remove ASCII bias |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3804 bsr LBD99 ; add B to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3805 bra LBD31 ; go process another digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3806 LBD99 jsr LBC2F ; save FPA0 to FPA3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3807 jsr LBC7C ; convert B to FP number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3808 ldx #V40 ; point to FPA3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3809 jmp LB9C2 ; add FPA3 and FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3810 LBDA5 ldb V47 ; get exponent value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3811 aslb ; times 2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3812 aslb ; times 4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3813 addb V47 ; times 5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3814 aslb ; times 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3815 suba #'0 ; remove ASCII bias |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3816 pshs b ; save acculated result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3817 adda ,s+ ; add new digit to accumulated result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3818 sta V47 ; save new accumulated decimal exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3819 bra LBD55 ; interpret another exponent character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3820 LBDB6 fcb 0x9b,0x3e,0xbc,0x1f,0xfd ; packed FP: 99999999.9 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3821 LBDBB fcb 0x9e,0x6e,0x6b,0x27,0xfd ; packed FP: 999999999 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3822 LBDC0 fcb 0x9e,0x6e,0x6b,0x28,0x00 ; pakced FP: 1E9 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3823 LBDC5 ldx #LABE8-1 ; point to "IN" message |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3824 bsr LBDD6 ; output the string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3825 ldd CURLIN ; get basic line number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3826 LBDCC std FPA0 ; save 16 bit unsigned integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3827 ldb #0x90 ; exponent for upper 16 bits of FPA0 to be an integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3828 coma ; set C (force normalization to treat as positive) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3829 jsr LBC86 ; zero bottom half, save exponent, and normalize |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3830 bsr LBDD9 ; convert FP number to ASCII string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3831 LBDD6 jmp LB99C ; output string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3832 ; Convert FP number to ASCII string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3833 LBDD9 ldu #STRBUF+3 ; point to buffer address that will not cause string to go to string space |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3834 LBDDC lda #0x20 ; default sign is a space character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3835 ldb FP0SGN ; get sign of value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3836 bpl LBDE4 ; brif positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3837 lda #'- ; use negative sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3838 LBDE4 sta ,u+ ; save sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3839 stu COEFPT ; save output buffer pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3840 sta FP0SGN ; save sign character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3841 lda #'0 ; result is 0 if exponent is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3842 ldb FP0EXP ; get exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3843 lbeq LBEB8 ; brif FPA0 is 0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3844 clra ; base 10 exponent is 0 for > 1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3845 cmpb #0x80 ; is number > 1? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3846 bhi LBDFF ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3847 ldx #LBDC0 ; point to 1E+09 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3848 jsr LBACA ; shift decimal to the right by 9 spaces |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3849 lda #-9 ; account for shift |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3850 LBDFF sta V45 ; save base 10 exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3851 LBE01 ldx #LBDBB ; point to 999999999 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3852 jsr LBCA0 ; are we above that? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3853 bgt LBE18 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3854 LBE09 ldx #LBDB6 ; point to 99999999.9 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3855 jsr LBCA0 ; are we above that? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3856 bgt LBE1F ; brif in range |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3857 jsr LBB6A ; multiply by 10 (we were small) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3858 dec V45 ; account for shift |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3859 bra LBE09 ; see if we've come into range |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3860 LBE18 jsr LBB82 ; divide by 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3861 inc V45 ; account for shift |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3862 bra LBE01 ; see if we've come into range |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3863 LBE1F jsr LB9B4 ; add 0.5 to FPA0 (rounding) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3864 jsr LBCC8 ; do the integer dance |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3865 ldb #1 ; default decimal flag (force immediate decimal) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3866 lda V45 ; get base 10 exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3867 adda #10 ; account for "unormalized" number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3868 bmi LBE36 ; brif number < 1.0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3869 cmpa #11 ; do we have more than 9 places? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3870 bhs LBE36 ; brif so - do scientific notation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3871 deca |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3872 tfr a,b |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3873 lda #2 ; force no scientific notation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3874 LBE36 deca ; subtract wo without affecting carry |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3875 deca |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3876 sta V47 ; save exponent - 0 is do not display in scientific notation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3877 stb V45 ; save number of places to left of decimal |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3878 bgt LBE4B ; brif >= 1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3879 ldu COEFPT ; point to string buffer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3880 lda #'. ; put decimal |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3881 sta ,u+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3882 tstb ; is there anything to left of decimal? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3883 beq LBE4B ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3884 lda #'0 ; store a zero |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3885 sta ,u+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3886 LBE4B ldx #LBEC5 ; point to powers of 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3887 ldb #0x80 ; set digit counter to 0x80 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3888 LBE50 lda FPA0+3 ; add mantissa to power of 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3889 adda 3,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3890 sta FPA0+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3891 lda FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3892 adca 2,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3893 sta FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3894 lda FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3895 adca 1,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3896 sta FPA0+1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3897 lda FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3898 adca ,x |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3899 sta FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3900 incb ; add one to digit counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3901 rorb ; put carry into bit 7 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3902 rolb ; set V if carry and sign differ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3903 bvc LBE50 ; brif positive mantissa or carry is 0 and negative mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3904 bcc LBE72 ; brif negative mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3905 subb #10+1 ; take 9's complement if adding mantissa |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3906 negb |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3907 LBE72 addb #'0-1 ; add ASCII bias |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3908 leax 4,x ; move to next power of 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3909 tfr b,a ; save digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3910 anda #0x7f ; remove add/subtract flag |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3911 sta ,u+ ; put in output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3912 dec V45 ; do we need a decimal yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3913 bne LBE84 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3914 lda #'. ; put decimal |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3915 sta ,u+ |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3916 LBE84 comb ; toggle bit 7 (add/sub flag) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3917 andb #0x80 ; only keep bit 7 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3918 cmpx #LBEC5+9*4 ; done all places? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3919 bne LBE50 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3920 LBE8C lda ,-u ; get last character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3921 cmpa #'0 ; was it 0? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3922 beq LBE8C ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3923 cmpa #'. ; decimal? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3924 bne LBE98 ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3925 leau -1,u ; move past decimal if it isn't needed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3926 LBE98 lda #'+ ; plus sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3927 ldb V47 ; get scientific notation exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3928 beq LBEBA ; brif not scientific notation |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3929 bpl LBEA3 ; brif positive exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3930 lda #'- ; negative sign for base 10 exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3931 negb ; switch to positive exponent |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3932 LBEA3 sta 2,u ; put sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3933 lda #'E ; put "E" |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3934 sta 1,u |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3935 lda #'0-1 ; init to ASCII 0 (compensate for INC) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3936 LBEAB inca ; bump digit |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3937 subb #10 ; have we hit the correct one yet? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3938 bcc LBEAB ; brif not |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3939 addb #'9+1 ; convert units digit to ASCII |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3940 std 3,u ; put exponent in output |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3941 clr 5,u ; put trailing NUL |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3942 bra LBEBC ; go reset pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3943 LBEB8 sta ,u ; store last character |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3944 LBEBA clr 1,u ; put NUL at the end |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3945 LBEBC ldx #STRBUF+3 ; point to start of string |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3946 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3947 LBEC0 fcb 0x80,0x00,0x00,0x00,0x00 ; packed FP 0.5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3948 LBEC5 fqb -100000000 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3949 fqb 10000000 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3950 fqb -1000000 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3951 fqb 100000 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3952 fqb -10000 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3953 fqb 1000 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3954 fqb -100 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3955 fqb 10 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3956 fqb -1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3957 LBEE9 lda FP0EXP ; get exponent of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3958 beq LBEEF ; brif 0 - don't flip sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3959 com FP0SGN ; flip sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3960 LBEEF rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3961 ; Expand a polynomial of the form |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3962 ; AQ+BQ^3+CQ^5+DQ^7..... where Q is FPA0 and X points to a table |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3963 LBEF0 stx COEFPT ; save coefficient table pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3964 jsr LBC2F ; copy FPA0 to FPA3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3965 bsr LBEFC ; multiply FPA3 by FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3966 bsr LBF01 ; expand polynomial |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3967 ldx #V40 ; point to FPA3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3968 LBEFC jmp LBACA ; multiply FPA0 by FPA3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3969 LBEFF stx COEFPT ; save coefficient table counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3970 LBF01 jsr LBC2A ; move FPA0 to FPA4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3971 ldx COEFPT ; get the current coefficient |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3972 ldb ,x+ ; get the number of entries |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3973 stb COEFCT ; save as counter |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3974 stx COEFPT ; save new pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3975 LBF0C bsr LBEFC ; multiply (X) and FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3976 ldx COEFPT ; get this coefficient |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3977 leax 5,x ; move to next one |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3978 stx COEFPT ; save new pointer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3979 jsr LB9C2 ; add (X) to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3980 ldx #V45 ; point X to FPA4 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3981 dec COEFCT ; done all coefficients? |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3982 bne LBF0C ; brif more left |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3983 rts |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3984 ; RND function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3985 RND jsr LBC6D ; set flags on FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3986 bmi LBF45 ; brif negative - set seed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3987 beq LBF3B ; brif 0 - do random between 0 and 1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3988 bsr LBF38 ; convert to integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3989 jsr LBC2F ; save range value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3990 bsr LBF3B ; get random number |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3991 ldx #V40 ; point to FPA3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3992 bsr LBEFC ; multply (X) by FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3993 ldx #LBAC5 ; point to FP 1.0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3994 jsr LB9C2 ; add 1 to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3995 LBF38 jmp INT ; return integer value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3996 LBF3B ldx RVSEED+1 ; move variable random number seed to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3997 stx FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3998 ldx RVSEED+3 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
3999 stx FPA0+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4000 LBF45 ldx RSEED ; move fixed seed to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4001 stx FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4002 ldx RSEED+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4003 stx FPA1+2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4004 jsr LBAD0 ; multiply them |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4005 ldd VAD ; get lowest order product bytes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4006 addd #0x658b ; add a constant |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4007 std RVSEED+3 ; save it as new seed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4008 std FPA0+2 ; save in result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4009 ldd VAB ; get high order extra product bytes |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4010 adcb #0xb0 ; add upper bytes of constant |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4011 adca #5 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4012 std RVSEED+1 ; save as new seed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4013 std FPA0 ; save as result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4014 clr FP0SGN ; set result to positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4015 lda #0x80 ; set exponent to 0 < FPA0 < 1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4016 sta FP0EXP |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4017 lda FPA2+2 ; get a byte from FPA2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4018 sta FPSBYT ; save as extra precision |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4019 jmp LBA1C ; go normalize FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4020 RSEED fqb 0x40e64dab ; constant random number generator seed |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4021 ; SIN function |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4022 SIN jsr LBC5F ; copy FPA0 to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4023 ldx #LBFBD ; point to 2*pi |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4024 ldb FP1SGN ; get sign of FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4025 jsr LBB89 ; divide FPA0 by 2*pi |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4026 jsr LBC5F ; copy FPA0 to FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4027 bsr LBF38 ; convert FPA0 to an integer |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4028 clr RESSGN ; set result to positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4029 lda FP1EXP ; get exponent of FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4030 ldb FP0EXP ; get exponent of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4031 jsr LB9BC ; subtract FPA0 from FPA1 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4032 ldx #LBFC2 ; point to FP 0.25 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4033 jsr LB9B9 ; subtract FPA0 from 0.25 (pi/2) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4034 lda FP0SGN ; get result sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4035 pshs a ; save it |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4036 bpl LBFA6 ; brif positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4037 jsr LB9B4 ; add 0.5 (pi) to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4038 lda FP0SGN ; get sign of result |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4039 bmi LBFA9 ; brif negative |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4040 com RELFLG ; if 3pi/2 >= arg >= pi/2 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4041 LBFA6 jsr LBEE9 ; flip sign of FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4042 LBFA9 ldx #LBFC2 ; point to 0.25 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4043 jsr LB9C2 ; add 0.25 (pi/2) to FPA0 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4044 puls a ; get original sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4045 tsta ; was it positive |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4046 bpl LBFB7 ; brif so |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4047 jsr LBEE9 ; flip result sign |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4048 LBFB7 ldx #LBFC7 ; point to series coefficients |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4049 jmp LBEF0 ; go calculate value |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4050 LBFBD fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4051 LBFC2 fcb 0x7f,0x00,0x00,0x00,0x00 ; 0.25 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4052 ; modified taylor series SIN coefficients |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4053 LBFC7 fcb 6-1 ; six coefficients |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4054 fcb 0x84,0xe6,0x1a,0x2d,0x1b ; -((2pi)^11)/11! |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4055 fcb 0x86,0x28,0x07,0xfb,0xf8 ; ((2pi)^9)/9! |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4056 fcb 0x87,0x99,0x68,0x89,0x01 ; -((2pi)^7)/7! |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4057 fcb 0x87,0x23,0x35,0xdf,0xe1 ; ((2pi)^5)/5! |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4058 fcb 0x86,0xa5,0x5d,0xe7,0x28 ; -(2pi)^3)/3! |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4059 fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4060 ; these 12 bytes are unused |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4061 fcb 0xa1,0x54,0x46,0x8f,0x13,0x8f,0x52,0x43 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4062 fcb 0x89,0xcd,0xa6,0x81 |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4063 ; these are the hardware interrupt vectors (coco1/2 only) |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4064 fdb SW3VEC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4065 fdb SW2VEC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4066 fdb FRQVEC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4067 fdb IRQVEC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4068 fdb SWIVEC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4069 fdb NMIVEC |
605ff82c4618
Initial check in with cleaned up sources
William Astle <lost@l-w.ca>
parents:
diff
changeset
|
4070 fdb RESVEC |