Mercurial > hg > index.cgi

annotate bas12.s @ 0:605ff82c4618

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial check in with cleaned up sources This is the initial check in the source code in a state where it builds byte accurate copies of all the various ROM versions included.
author William Astle <lost@l-w.ca>
date Sat, 08 Dec 2018 19:57:01 -0700
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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