6502/8bitworkshop
1
0
Fork 0
mirror of https://github.com/sehugg/8bitworkshop.git synced 2024-12-02 04:49:44 +00:00
Code Issues Projects Releases Wiki Activity
64f27879d7
8bitworkshop/res/altirra/kernel.lst
Steven Hugg ed7758d7e0 atari8: started on js platform
2022-08-30 19:37:30 -05:00

10525 lines
364 KiB
Plaintext
Raw Blame History

mads 2.1.0
Source: source/main.xasm
1 ; Altirra - Atari 800/800XL emulator
2 ; Kernel ROM replacement
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11
12 .if _KERNEL_XLXE
13 _KERNEL_PBI_SUPPORT = 1
14 _KERNEL_USE_BOOT_SCREEN = 1
15 .macro _KERNELSTR_BIOS_NAME_INTERNAL
16 .ifdef _KERNEL_816
17 dta d" for 65C816"
18 .else
19 dta d" for XL/XE/XEGS"
20 .endif
21 .endm
22 .else
23 = 0000 _KERNEL_PBI_SUPPORT = 0
24 = 0000 _KERNEL_USE_BOOT_SCREEN = 0
25 .endif
26
27 = 0001 _KERNEL_PRINTER_SUPPORT = 1
28
29 ;==========================================================================
30
31 icl 'version.inc'
Source: source/Shared/version.inc
1 ; Altirra - Atari 800/800XL emulator
2 ; Kernel ROM replacement - version info
3 ; Copyright (C) 2008-2020 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 .macro _KERNELSTR_VERSION
11 dta '3.26'
12 .endm
13
14 .macro _KERNELSTR_VERSION_INTERNAL
15 dta "3.26"
16 .endm
32 icl 'hardware.inc'
Source: source/Shared/hardware.inc
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Hardware register definitions
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 .ifndef f_HARDWARE_INC
11 .def f_HARDWARE_INC
12
13 ;==========================================================================
14 ; GTIA
15 ;
16 m0pf equ $d000
17 m1pf equ $d001
18 m2pf equ $d002
19 m3pf equ $d003
20 p0pf equ $d004
21 p1pf equ $d005
22 p2pf equ $d006
23 p3pf equ $d007
24 m0pl equ $d008
25 m1pl equ $d009
26 m2pl equ $d00a
27 m3pl equ $d00b
28 p0pl equ $d00c
29 p1pl equ $d00d
30 p2pl equ $d00e
31 p3pl equ $d00f
32
33 hposp0 equ $d000
34 hposp1 equ $d001
35 hposp2 equ $d002
36 hposp3 equ $d003
37 hposm0 equ $d004
38 hposm1 equ $d005
39 hposm2 equ $d006
40 hposm3 equ $d007
41 sizep0 equ $d008
42 sizep1 equ $d009
43 sizep2 equ $d00a
44 sizep3 equ $d00b
45 sizem equ $d00c
46 grafp0 equ $d00d
47 grafp1 equ $d00e
48 grafp2 equ $d00f
49 grafp3 equ $d010
50 grafm equ $d011
51 trig0 equ $d010
52 trig1 equ $d011
53 trig2 equ $d012
54 colpm0 equ $d012
55 trig3 equ $d013
56 colpm1 equ $d013
57 pal equ $d014
58 colpm2 equ $d014
59 colpm3 equ $d015
60 colpf0 equ $d016
61 colpf1 equ $d017
62 colpf2 equ $d018
63 colpf3 equ $d019
64 colbk equ $d01a
65 prior equ $d01b
66 vdelay equ $d01c
67 gractl equ $d01d
68 hitclr equ $d01e
69 consol equ $d01f
70
71 ;==========================================================================
72 ; POKEY
73 ;
74 pot0 equ $d200
75 audf1 equ $d200
76 pot1 equ $d201
77 audc1 equ $d201
78 pot2 equ $d202
79 audf2 equ $d202
80 pot3 equ $d203
81 audc2 equ $d203
82 pot4 equ $d204
83 audf3 equ $d204
84 pot5 equ $d205
85 audc3 equ $d205
86 pot6 equ $d206
87 audf4 equ $d206
88 pot7 equ $d207
89 audc4 equ $d207
90 audctl equ $d208
91 kbcode equ $d209
92 skres equ $d20a
93 potgo equ $d20b
94 serin equ $d20d
95 serout equ $d20d
96 irqen equ $d20e
97 irqst equ $d20e
98 skctl equ $d20f
99 skstat equ $d20f
100
101 ;==========================================================================
102 ; PIA
103 ;
104 porta equ $d300
105 portb equ $d301
106 pactl equ $d302
107 pbctl equ $d303
108
109 ;==========================================================================
110 ; ANTIC
111 ;
112 dmactl equ $d400
113 chactl equ $d401
114 dlistl equ $d402
115 dlisth equ $d403
116 hscrol equ $d404
117 vscrol equ $d405
118 pmbase equ $d407
119 chbase equ $d409
120 wsync equ $d40a
121 vcount equ $d40b
122 penh equ $d40c
123 penv equ $d40d
124 nmien equ $d40e
125 nmist equ $d40f
126 nmires equ $d40f
127
128 ;==========================================================================
129 ; 6502
130 ;
131 nmivec equ $fffa
132 resvec equ $fffc
133 irqvec equ $fffe
134
135 .endif
33 icl 'kerneldb.inc'
Source: source/Shared/kerneldb.inc
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Kernel Database Definitions
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 .ifndef f_KERNELDB_INC
11 .def f_KERNELDB_INC
12
13 casini = $0002 ;cassette initialization vector
14 ramlo = $0004 ;
15 tramsz = $0006 ;temporary ram size / cart A flag
16 tstdat = $0007 ;RAM test data register / cart B flag
17 ;(also CMCMD for T:)
18 warmst = $0008 ;warmstart flag
19 boot? = $0009 ;boot flag; 0 if none, 1 for disk, 2 for cassette
20 dosvec = $000a
21 dosini = $000c
22 appmhi = $000e
23 pokmsk = $0010
24 brkkey = $0011 ;set on [BREAK]
25 rtclok = $0012
26 bufadr = $0015 ;indirect buffer address pointer (temp for disk buffer)
27 ; $0016
28 iccomt = $0017 ;CIO: command byte
29 ziocb = $0020 ;zero-page IOCB
30 ichidz = $0020 ;Zero page IOCB: device index ($FF = not open)
31 icdnoz = $0021 ;Zero page IOCB: device number
32 iccomz = $0022 ;Zero page IOCB: command byte
33 icstaz = $0023 ;Zero page IOCB: status byte
34 icbalz = $0024 ;Zero page IOCB: address of device/filename spec lo
35 icbahz = $0025 ;Zero page IOCB: address of device/filename spec hi
36 icptlz = $0026 ;Zero page IOCB: put byte address lo (-1)
37 icpthz = $0027 ;Zero page IOCB: put byte address hi (-1)
38 icbllz = $0028 ;Zero page IOCB: buffer length/byte count lo (-1)
39 icblhz = $0029 ;Zero page IOCB: buffer length/byte count hi (-1)
40 icax1z = $002a ;Zero page IOCB: device-specific information 1
41 icax2z = $002b ;Zero page IOCB: device-specific information 2
42 icax3z = $002c ;Zero page IOCB: device-specific information 3
43 icax4z = $002d ;Zero page IOCB: device-specific information 4
44 icax5z = $002e ;Zero page IOCB: device-specific information 5
45 icidno = $002e ;CIO: call X register save/restore
46 icax6z = $002f ;Zero page IOCB: device-specific information 6
47 ciochr = $002f ;CIO: call A register save/restore
48 status = $0030 ;SIO: temporay status byte
49 chksum = $0031 ;SIO: temporary checksum byte (used by IRQ routines)
50 bufrlo = $0032 ;SIO: buffer pointer lo (incremented by IRQ routines)
51 bufrhi = $0033 ;SIO: buffer pointer hi (incremented by IRQ routines)
52 bfenlo = $0034 ;SIO: buffer end lo
53 bfenhi = $0035 ;SIO: buffer end hi
54 ltemp = $0036 ;Relocating loader: loader temp address (XL/XE)
55 ; $0037
56 bufrfl = $0038 ;SIO: buffer full flag
57 recvdn = $0039 ;SIO: receive completed flag
58 xmtdon = $003a ;SIO: transmit completed flag
59 chksnt = $003b ;SIO: checksum sent flag
60 nocksm = $003c ;SIO: no-checksum flag
61 bptr = $003d ;Cassette: Buffer pointer
62 ftype = $003e ;Cassette: Interrecord gap (IRG) type; bit7=1 means continuous mode
63 feof = $003f ;Cassette: EOF flag
64 soundr = $0041 ;SIO: noisy audio flag
65 critic = $0042 ;critical flag for vbi
66 zchain = $004a ;Peripheral Handler: zero-page chain address
67 ; $004b
68 atract = $004d ;screen attract counter
69 drkmsk = $004e ;screen attract mask
70 colrsh = $004f ;screen attract color shift
71 tmpchr = $0050 ;Screen Editor
72 hold1 = $0051 ;Display/Editor: temporary storage
73 lmargn = $0052 ;left margin column
74 rmargn = $0053 ;right margin column
75 rowcrs = $0054 ;cursor row
76 colcrs = $0055 ;cursor column
77 ; $0056
78 dindex = $0057 ;display mode index
79 savmsc = $0058 ;lowest address of screen region
80 oldrow = $005a ;
81 oldcol = $005b ;
82 oldchr = $005d ;cursor character save/restore
83 oldadr = $005e ;cursor memory address
84 ; $005f
85 palnts = $0062 ;PAL/NTSC flag
86 logcol = $0063 ;Display/Editor: Logical column (0-119)
87 adress = $0064 ;temporary storage (display code)
88 ; $0065
89 toadr = $0066 ;temporary storage (display code)
90 a1 = toadr
91 ; $0067
92 frmadr = $0068 ;temporary storage (display code)
93 ; $0069
94 ramtop = $006a ;ram size
95 bufcnt = $006b
96 bufstr = $006c ;row/column of start of logical line
97 bitmsk = $006e ;Screen Editor
98 shfamt = $006f ;Screen Editor
99 rowac = $0070 ;Screen Editor: line drawing
100 ; $0071 ;
101 colac = $0072 ;Screen Editor: line drawing
102 ; $0073 ;
103 endpt = $0074 ;Screen Editor: line drawing
104 ; $0075 ;
105 deltar = $0076 ;Screen Editor: delta row (line drawing)
106 deltac = $0077 ;Screen Editor: delta column (line drawing)
107 ; $0078 ;
108 keydef = $0079 ;XL/XE: Keyboard definition table
109 ; $007a
110 swpflg = $007b ;current display var state ($00 = main, $FF = split screen)
111 holdch = $007c ;temporary key hold area prior to shift/control lock logic
112 countr = $007e ;Screen Editor: line length
113 ; $007f
114 fr0 = $00d4 ;FP: Accumulator 0
115 _fr3 = $00da ;FP: Accumulator 3 (officially FRE)
116 fr1 = $00e0 ;FP: Accumulator 1
117 fr2 = $00e6 ;FP: Accumulator 2
118 _fpcocnt= $00ec ;FP: temporary storage - polynomial coefficient counter
119 _fptemp0= $00ed ;FP: temporary storage - transcendental temporary (officially EEXP)
120 _fptemp1= $00ee ;FP: temporary storage - transcendental temporary (officially NSIGN)
121 ;esign $00ef ;BASIC: Used in sqr() routine -- must not be touched by FP elementary functions
122 ;fchrflg $00f0 ;BASIC: Used in sin() routine -- must not be touched by any FP functions
123 cix = $00f2 ;FP: Character index
124 inbuff = $00f3 ;FP: ASCII conversion buffer
125 ; $00f4
126 ; $00f5 ;FP: temporary storage -- also temporarily used by BASIC power routine
127 ; $00f6 ;FP: temporary storage
128 ztemp4 = $00f7 ;FP: temporary storage -- also temporarily used by BASIC power routine
129 ; $00f8 ;FP: temporary storage
130 ; $00f9 ;FP: temporary storage
131 ; $00fa ;FP: temporary storage
132 degflg = $00fb ;FP: degree/radian flag (0=radians, 6=degrees)
133 flptr = $00fc ;FP: pointer for floating-point loads and stores
134 fptr2 = $00fe ;FP: pointer for polynomial evaluation
135
136 vdslst = $0200 ;display list interrupt vector
137 vprced = $0202 ;serial bus proceed interrupt vector
138 vinter = $0204 ;serial bus interrupt vector
139 vbreak = $0206 ;BRK instruction vector
140 vkeybd = $0208 ;keyboard interrupt vector
141 vserin = $020a ;serial input ready interrupt vector
142 vseror = $020c ;serial output ready interrupt vector
143 vseroc = $020e ;serial output completed interrupt vector
144 vtimr1 = $0210 ;pokey timer 1 interrupt vector
145 vtimr2 = $0212 ;pokey timer 2 interrupt vector
146 vtimr4 = $0214 ;pokey timer 4 interrupt vector
147 vimirq = $0216 ;immediate IRQ vector
148 cdtmv1 = $0218 ;countdown timer 1
149 cdtmv2 = $021a ;countdown timer 2
150 cdtmv3 = $021c ;countdown timer 3
151 cdtmv4 = $021e ;countdown timer 4
152 cdtmv5 = $0220 ;countdown timer 5
153 vvblki = $0222 ;vertical blank immediate vector
154 vvblkd = $0224 ;vertical blank deferred vector
155 cdtma1 = $0226 ;timer 1 vector
156 cdtma2 = $0228 ;timer 2 vector
157 cdtmf3 = $022a ;timer 3 flag
158 srtimr = $022b ;autorepeat timer
159 cdtmf4 = $022c ;timer 4 flag
160 intemp = $022d ;temp value used by SETVBV
161 cdtmf5 = $022e ;timer 5 flag
162 sdmctl = $022f ;shadow for DMACTL ($D400)
163 sdlstl = $0230 ;shadow for DLISTL ($D402)
164 sdlsth = $0231 ;shadow for DLISTH ($D403)
165 sskctl = $0232 ;shadow for SKCTL ($D20F)
166 lcount = $0233 ;Relocating loader: (XL/XE)
167 lpenh = $0234 ;light pen horizontal pos
168 lpenv = $0235 ;light pen vertical pos
169 brkky = $0236 ;break key interrupt vector (OS B+ only)
170 vpirq = $0238 ;PBI device interrupt vector (XL/XE)
171 ; $0239
172 cdevic = $023a ;SIO: command frame device ID
173 ccomnd = $023b ;SIO: command frame command ID
174 caux1 = $023c ;SIO: command aux byte 1
175 caux2 = $023d ;SIO: command aux byte 2
176 temp = $023e ;SIO: temp space
177 errflg = $023f ;SIO: error flag
178 dflags = $0240 ;disk boot flags
179 dbsect = $0241 ;disk boot sector count
180 bootad = $0242 ;disk boot address
181 coldst = $0244 ;cold start flag
182 reclen = $0245 ;Relocating loader: record length (XL/XE)
183 dsktim = $0246 ;Disk Handler: Disk operation timeout
184 pdvmsk = $0247 ;PBI device mask (XL/XE)
185 shpdvs = $0248 ;PBI device selection register shadow ($D1FF) (XL/XE)
186 pdmsk = $0249 ;PBI device interrupt mask (XL/XE)
187 reladr = $024a ;Relocating loader: temp address (XL/XE)
188 ; $024b
189
190 .if _KERNEL_816
191 vabte = $024f ;(816) Emulation ABORT vector
192 ; $0250
193 vcope = $0251 ;(816) Emulation COP vector
194 ; $0252
195 vabtn = $0253 ;(816) Native ABORT vector
196 ; $0254
197 ; $0255
198 vcopn = $0256 ;(816) Native COP vector
199 ; $0257
200 ; $0258
201 vnmin = $0259 ;(816) Native NMI vector
202 ; $025a
203 ; $025b
204 virqn = $025c ;(816) Native IRQ vector
205 ; $025d
206 ; $025e
207 vbrkn = $025f ;(816) Native BREAK vector
208 ; $0260
209 ; $0261
210 vcop0 = $0262 ;(816) Native COP #0 vector
211 ; $0263
212 ; $0264
213 vcopu = $0265 ;(816) Native COP #1-127 vector
214 ; $0266
215 ; $0267
216 vcopc = $0268 ;(816) Native COP #128-255 vector
217 ; $0269
218 ; $026a
219 .endif
220
221 fine = $026e ;fine scrolling flag (XL/XE)
222 gprior = $026f ;shadow for PRIOR ($D01B)
223 paddl0 = $0270 ;shadow for POT0 ($D200)
224 paddl1 = $0271 ;shadow for POT1 ($D201)
225 paddl2 = $0272 ;shadow for POT2 ($D202)
226 paddl3 = $0273 ;shadow for POT3 ($D203)
227 paddl4 = $0274 ;shadow for POT4 ($D204)
228 paddl5 = $0275 ;shadow for POT5 ($D205)
229 paddl6 = $0276 ;shadow for POT6 ($D206)
230 paddl7 = $0277 ;shadow for POT7 ($D207)
231 stick0 = $0278 ;shadow for PORTA lo ($D300)
232 stick1 = $0279 ;shadow for PORTA hi ($D300)
233 stick2 = $027A ;shadow for PORTB lo ($D302)
234 stick3 = $027B ;shadow for PORTB hih ($D302)
235 ptrig0 = $027c ;paddle trigger 0
236 ptrig1 = $027d ;paddle trigger 1
237 ptrig2 = $027e ;paddle trigger 2
238 ptrig3 = $027f ;paddle trigger 3
239 ptrig4 = $0280 ;paddle trigger 4
240 ptrig5 = $0281 ;paddle trigger 5
241 ptrig6 = $0282 ;paddle trigger 6
242 ptrig7 = $0283 ;paddle trigger 7
243 strig0 = $0284 ;shadow for TRIG0 ($D001)
244 strig1 = $0285 ;shadow for TRIG1 ($D002)
245 strig2 = $0286 ;shadow for TRIG2 ($D003)
246 strig3 = $0287 ;shadow for TRIG3 ($D004)
247 hibyte = $0288 ;Relocating loader (XL/XE)
248 wmode = $0289 ;Cassette: Write mode (00 = read, 80 = write)
249 blim = $028a ;Cassette: Buffer limit
250 jveck = $028c ;XL/XE: IRQ jump vector
251 newadr = $028e ;Relocating loader (XL/XE)
252 txtrow = $0290
253 txtcol = $0291
254 ; $0292
255 tindex = $0293 ;text mode index
256 txtmsc = $0294 ;text window pointer
257 ; $0295
258 cretry = $029c ;SIO: command retries (XL/XE)
259 hold3 = $029d ;Screen Editor
260 hold2 = $029f ;Screen Editor
261 dmask = $02a0 ;Display/Editor: Graphics merge mask
262 tmplbt = $02a1
263 escflg = $02a2 ;Display/Editor: Escape next character
264 tabmap = $02a3 ;Display/Editor: Bitfield indicating tabs (note reversed bit positions)
265 logmap = $02b2 ;Display/Editor: Logical line start map (4 bytes)
266 invflg = $02b6 ;Keyboard Handler: inverse flag ($00/$80)
267 tmprow = $02b8 ;Screen Editor
268 tmpcol = $02b9 ;Screen Editor
269 ; $02ba
270 scrflg = $02bb ;Display/Editor: Scroll counter
271 hold4 = $02bc ;Screen Editor
272 dretry = $02bd ;SIO: device retries (XL/XE)
273 shflok = $02be ;shift/control lock flags
274 botscr = $02bf ;number of text rows in text window
275 pcolr0 = $02c0 ;shadow for COLPM0 ($D012)
276 pcolr1 = $02c1 ;shadow for COLPM1 ($D013)
277 pcolr2 = $02c2 ;shadow for COLPM2 ($D014)
278 pcolr3 = $02c3 ;shadow for COLPM3 ($D015)
279 color0 = $02c4 ;shadow for COLPF0 ($D016)
280 color1 = $02c5 ;shadow for COLPF1 ($D017)
281 color2 = $02c6 ;shadow for COLPF2 ($D018)
282 color3 = $02c7 ;shadow for COLPF3 ($D019)
283 color4 = $02c8 ;shadow for COLBK ($D01A)
284 runadr = $02c9 ;Relocating loader: run address (XL/XE)
285 ; $02ca
286 hiused = $02cb ;Relocating loader: Next available memory location (out) (XL/XE)
287 ; $02cc
288 zhiuse = $02cd ;Relocating loader: Next available zero-page address (out) (XL/XE)
289 ; $02ce
290 gbytea = $02cf ;Relocating loader: GET BYTE address (XL/XE)
291 ; $02d0
292 loadad = $02d1 ;Relocating loader: Load address (XL/XE)
293 ; $02d2
294 zloada = $02d3 ;Relocating loader: Zero-page load address (XL/XE)
295 ; $02d4
296 dsctln = $02d5 ;Disk sector size (XL/XE)
297 krpdel = $02d9 ;Keyboard repeat delay (XL/XE)
298 keyrep = $02da ;Keyboard repeat rate (XL/XE)
299 helpfg = $02dc ;Help flag (XL/XE)
300 pbpnt = $02de ;Printer: Buffer index (XL/XE location)
301 pbufsz = $02df ;Printer: Record size (XL/XE location)
302 ramsiz = $02e4 ;ram size in pages
303 memtop = $02e5 ;highest location for programs and data
304 memlo = $02e7 ;base of application memory
305 hndlod = $02e9 ;CIO: Handler load flag (XL/XE)
306 dvstat = $02ea ;DISK: Status request buffer area (4 bytes)
307 ; $02eb
308 ; $02ec
309 ; $02ed
310 cbaudl = $02ee ;Cassette baud rate as POKEY divisor. Set to nominal ($05CC) by C: init.
311 cbaudh = $02ef ;
312 crsinh = $02f0 ;Display/Editor: cursor inhibit flag
313 keydel = $02f1 ;keyboard debounce delay (set to 3 vblanks per key)
314 ch1 = $02f2 ;last keyboard code read
315 chact = $02f3 ;shadow for CHACTL ($D401)
316 chbas = $02f4 ;shadow for CHBASE ($D409)
317 rowinc = $02f8 ;Screen Editor: row direction (XL/XE location)
318 colinc = $02f9 ;Screen Editor: col direction (XL/XE location)
319 atachr = $02fb ;Screen Editor
320 ch = $02fc ;keyboard FIFO byte
321 fildat = $02fd ;Screen Editor: fill color
322 dspflg = $02fe ;enable/disable of control codes by screen editor (E:)
323 ssflag = $02ff ;display/screen editor suspend flag
324 ddevic = $0300 ;serial bus ID
325 dunit = $0301 ;device number
326 dcomnd = $0302 ;command byte
327 dstats = $0303 ;status byte
328 dbuflo = $0304 ;buffer address lo
329 dbufhi = $0305 ;buffer address hi
330 dtimlo = $0306 ;disk timeout value
331 dbytlo = $0308 ;byte count lo
332 dbythi = $0309 ;byte count hi
333 daux1 = $030a ;sector number lo
334 daux2 = $030b ;sector number hi
335 timer1 = $030c ;SIO: baud rate determination - first timer value
336 addcor = $030e ;SIO: baud rate determination - correction value
337 casflg = $030f ;SIO: cassette I/O flag (0=normal, nonzero=cassette)
338 timer2 = $0310 ;SIO: baud rate determination - second timer value
339 temp1 = $0312 ;SIO: baud rate determination - temp
340 ; $0313
341 ptimot = $0314 ;Printer: Timeout (XL/XE location)
342 temp3 = $0315 ;SIO: baud rate determination - temp
343 timflg = $0317 ;SIO: operation timeout flag (set by countdown timer 1 IRQ)
344 stackp = $0318 ;SIO: stack pointer save
345 hatabs = $031a ;handler table
346 pupbt1 = $033d ;(XL/XE) Power-up boot flag #1 - $5C
347 pupbt2 = $033e ;(XL/XE) Power-up boot flag #2 - $93
348 pupbt3 = $033f ;(XL/XE) Power-up boot flag #3 - $25
349 ichid = $0340 ;IOCB #0 handler ID
350 icdno = $0341 ;IOCB #0 device number
351 iccmd = $0342 ;IOCB #0 command byte
352 icsta = $0343 ;IOCB #0 status
353 icbal = $0344 ;IOCB #0 buffer address lo
354 icbah = $0345 ;IOCB #0 buffer address hi
355 icptl = $0346 ;IOCB #0 PUT address lo
356 icpth = $0347 ;IOCB #0 PUT address hi
357 icbll = $0348 ;IOCB #0 buffer length/byte count lo
358 icblh = $0349 ;IOCB #0 buffer length/byte count hi
359 icax1 = $034a ;IOCB #0 auxiliary information lo
360 icax2 = $034b ;IOCB #0 auxiliary information hi
361 icax3 = $034c ;
362 icax4 = $034d ;
363 icax5 = $034e ;
364 icax6 = $034f ;
365 prnbuf = $03c0 ;printer buffer
366 ckey = $03e9 ;cassette boot key
367 basicf = $03f8 ;XL/XE: ROM BASIC flag. 0 = enabled
368 gintlk = $03fa ;XL/XE: Cartridge interlock (clone of TRIG3).
369 chlink = $03fb ;XL/XE: Relocated loader chain
370 casbuf = $03fd ;Cassette buffer (03FD-047F)
371 lbuff = $0580 ;
372 plyarg = $05e0 ;FP: Polynomial evaluation temp register
373 fpscr = $05e6 ;FP: Temp evaluation register (used by LOG/LOG10)
374
375 .endif
34
35 opt h-o+f+
36
37 .ifdef _KERNEL_816
38 opt c+
39 .endif
40
41 .if _KERNEL_XLXE
42 org $c000
43
44 ;==============================================================================
45 ; lower ROM identification block (XL/XE)
46 ;==============================================================================
47
48 dta a(0)
49 dta $01,$01,$13
50 dta $02
51 dta 'CX',$00,$00,$00
52 dta $00
53
54 _KERNEL_REPORT_MODULE_MARK
55
56 .ifdef _KERNEL_816
57 icl 'vbi816.s'
58 .else
59 icl 'vbi.s'
60 .endif
61
62 _KERNEL_REPORT_MODULE_SIZE 'VBI routines', 0
63
64 .ifdef _KERNEL_816
65 icl 'interrupt816.s'
66 .else
67 icl 'interrupt.s'
68 .endif
69
70 _KERNEL_REPORT_MODULE_SIZE 'Base interrupt routines', 0
71
72 .ifdef _KERNEL_816
73 icl 'irq816.s'
74 .else
75 icl 'irq.s'
76 .endif
77
78 _KERNEL_REPORT_MODULE_SIZE 'IRQ routines', 0
79
80 icl 'pbi.s'
81 _KERNEL_REPORT_MODULE_SIZE 'PBI routines', 0
82 icl 'phandler.s'
83 _KERNEL_REPORT_MODULE_SIZE 'Peripheral Handler routines', 0
84
85 .ifdef _KERNEL_816
86 icl 'syscall816.s'
87 icl 'sysdev816.s'
88 .endif
89
90 org $cc00
91 icl 'atariifont.inc'
92
93 org $d000
94 icl 'bootscreen.s'
95
96 opt f+
97 .endif
98
99 org $d800
100
101 icl 'mathpack.s'
Source: source/Shared/mathpack.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Decimal Floating-Point Math Pack
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 ;
12 ; Known problems:
13 ; Currently incompatible with BASIC XE due to it relying on $DE-DF not
14 ; being modified by FADD/FSUB.
15 ;
16 ;==========================================================================
17 ;
18 ; Notes
19 ;
20 ; AFP FMUL
21 ; |FASC.FDIV
22 ; |.IPF.|PLYEVL
23 ; |.|FPI|.EXP
24 ; |.|.FADD|REDRNG
25 ; |.|.|.|.|.LOG
26 ; vvvvvvvvvvv
27 ; $D4 FR0 M MMM.
28 ; $D5 | M MMM.
29 ; $D6 | M MMM.
30 ; $D7 | M MMM.
31 ; $D8 | M MMM.
32 ; $D9 v M MMM.
33 ; $DA FR2 {FRE} TTTTTTT.
34 ; $DB | TT TTTT.
35 ; $DC | TT TTTT.
36 ; $DD | TT TTTT.
37 ; $DE | T TTT. [1,2]
38 ; $DF v TTT. [1,2]
39 ; $E0 FR1 MM . [3]
40 ; $E1 | MM . [3]
41 ; $E2 | MM . [3]
42 ; $E3 | MM . [3]
43 ; $E4 | MM . [3]
44 ; $E5 v MM . [3]
45 ; $E6 FR3 {FR2} . .
46 ; $E7 . .
47 ; $E8 . .
48 ; $E9 . .
49 ; $EA . .
50 ; $EB . .
51 ; $EC {FRX} . .
52 ; $ED {EEXP} . .
53 ; $EE {NSIGN} . .
54 ; $EF {ESIGN} . .
55 ; $F0 {FCHRFLG} . .
56 ; $F1 {DIGRT} . .
57 ; $F2 CIX . .
58 ; $F3 INBUFF . .
59 ; $F4 v . .
60 ; $F5 {ZTEMP1} . .
61 ; $F6 v . .
62 ; $F7 {ZTEMP4} . .
63 ; $F8 v . .
64 ; $F9 {ZTEMP3} . .
65 ; $FA v . .
66 ; $FB DEGFLG/RADFLG . .
67 ; $FC FLPTR . .
68 ; $FD v . .
69 ; $FE FPTR2 . .
70 ; $FF v . .
71 ; $05E0 PLYARG T T
72 ; $05E1 | T T
73 ; $05E2 | T T
74 ; $05E3 | T T
75 ; $05E4 | T T
76 ; $05E5 v T T
77 ; $05E6 FPSCR TT
78 ; $05E7 | TT
79 ; $05E8 | TT
80 ; $05E9 | TT
81 ; $05EA | TT
82 ; $05EB v TT
83 ; $05EC FPSCR1
84 ; $05ED |
85 ; $05EE |
86 ; $05EF |
87 ; $05F0 |
88 ; $05F1 v
89 ;
90 ; Notes:
91 ; [1] BASIC XE relies on $DE/DF not being touched by FADD, or FOR/NEXT
92 ; breaks.
93 ; [2] MAC/65 relies on $DE/DF not being touched by IPF.
94 ; [3] DARG relies on FPI not touching FR1.
95 ; [4] ACTris 1.2 relies on FASC not touching lower parts of FR2.
96 ;
97
98 .macro ckaddr
99 .if * <> %%1
100 .error 'Incorrect address: ',*,' != ',%%1
101 .endif
102 .endm
103
104 .macro fixadr
105 .if * < %%1
106 .print (%%1-*),' bytes free before ',%%1
107 org %%1
108 .elif * > %%1
109 .error 'Out of space: ',*,' > ',%%1,' (',*-%%1,' bytes over)'
110 .endif
111 .endm
112
113 ;==========================================================================
114 ; AFP [D800] Convert ASCII string at INBUFF[CIX] to FR0
115 ;
116 org $d800
117 = D800 _afp = afp
118 .proc afp
119 = 00E6 dotflag = fr2
120 = 00E7 xinvert = fr2+1
121 = 00E8 cix0 = fr2+2
122 = 00E9 sign = fr2+3
123 = 00EA digit2 = fr2+4
124
125 ;skip initial spaces
126 D800 20 A1 DB jsr skpspc
127
128 ;init FR0 and one extra mantissa byte
129 D803 A9 7F lda #$7f
130 D805 85 D4 sta fr0
131 D807 85 EA sta digit2
132
133 D809 A2 D5 ldx #fr0+1
134 D80B 20 46 DA jsr zf1
135
136 ;clear decimal flag
137 D80E 85 E6 sta dotflag
138 D810 85 E9 sta sign
139
140 ;check for sign
141 D812 A4 F2 ldy cix
142 D814 B1 F3 lda (inbuff),y
143 D816 C9 2B cmp #'+'
144 D818 F0 06 beq isplus
145 D81A C9 2D cmp #'-'
146 D81C D0 03 bne postsign
147 D81E 66 E9 ror sign
148 D820 isplus:
149 D820 C8 iny
150 D821 postsign:
151 D821 84 E8 sty cix0
152
153 ;skip leading zeroes
154 D823 A9 30 lda #'0'
155 D825 20 A5 DB jsr fp_skipchar
156
157 ;check if next char is a dot, indicating mantissa <1
158 D828 B1 F3 lda (inbuff),y
159 D82A C9 2E cmp #'.'
160 D82C D0 10 bne not_tiny
161 D82E C8 iny
162
163 ;set dot flag
164 D82F 66 E6 ror dotflag
165
166 ;increment anchor so we don't count the dot as a digit for purposes
167 ;of seeing if we got any digits
168 D831 E6 E8 inc cix0
169
170 ;skip zeroes and adjust exponent
171 D833 A9 30 lda #'0'
172 D835 tiny_denorm_loop:
173 D835 D1 F3 cmp (inbuff),y
174 D837 D0 05 bne tiny_denorm_loop_exit
175 D839 C6 D4 dec fr0
176 D83B C8 iny
177 D83C D0 F7 bne tiny_denorm_loop
178 D83E tiny_denorm_loop_exit:
179
180 D83E not_tiny:
181
182 ;grab digits left of decimal point
183 D83E A2 01 ldx #1
184 D840 nextdigit:
185 D840 B1 F3 lda (inbuff),y
186 D842 C9 45 cmp #'E'
187 D844 F0 55 beq isexp
188 D846 C8 iny
189 D847 C9 2E cmp #'.'
190 D849 F0 28 beq isdot
191 D84B 49 30 eor #'0'
192 D84D C9 0A cmp #10
193 D84F B0 2A bcs termcheck
194
195 ;write digit if we haven't exceeded digit count
196 D851 E0 06 cpx #6
197 D853 B0 15 bcs afterwrite
198
199 D855 24 EA bit digit2
200 D857 10 09 bpl writehi
201
202 ;clear second digit flag
203 D859 C6 EA dec digit2
204
205 ;merge in low digit
206 D85B 15 D4 ora fr0,x
207 D85D 95 D4 sta fr0,x
208
209 ;advance to next byte
210 D85F E8 inx
211 D860 D0 08 bne afterwrite
212
213 D862 writehi:
214 ;set second digit flag
215 D862 E6 EA inc digit2
216
217 ;shift digit to high nibble and write
218 D864 0A asl
219 D865 0A asl
220 D866 0A asl
221 D867 0A asl
222 D868 95 D4 sta fr0,x
223
224 D86A afterwrite:
225 ;adjust digit exponent if we haven't seen a dot yet
226 D86A 24 E6 bit dotflag
227 D86C 30 02 E6 D4 smi:inc fr0
228
229 ;go back for more
230 D870 4C 40 D8 jmp nextdigit
231
232 D873 isdot:
233 D873 A5 E6 lda dotflag
234 D875 D0 04 bne termcheck
235
236 ;set the dot flag and loop back for more
237 D877 66 E6 ror dotflag
238 D879 D0 C5 bne nextdigit
239
240 D87B termcheck:
241 D87B 88 dey
242 D87C C4 E8 cpy cix0
243 D87E F0 1A beq err_carryset
244 D880 term:
245 ;stash offset
246 D880 84 F2 sty cix
247
248 D882 term_rollback_exp:
249 ;divide digit exponent by two and merge in sign
250 D882 26 E9 rol sign
251 D884 66 D4 ror fr0
252
253 ;check if we need a one digit shift
254 D886 B0 0F bcs nodigitshift
255
256 ;shift right one digit
257 D888 A2 04 ldx #4
258 D88A digitshift:
259 D88A 46 D5 lsr fr0+1
260 D88C 66 D6 ror fr0+2
261 D88E 66 D7 ror fr0+3
262 D890 66 D8 ror fr0+4
263 D892 66 D9 ror fr0+5
264 D894 CA dex
265 D895 D0 F3 bne digitshift
266
267 D897 nodigitshift:
268 D897 4C 00 DC jmp fp_normalize
269
270 D89A err_carryset:
271 D89A 60 rts
272
273 D89B isexp:
274 D89B C4 E8 cpy cix0
275 D89D F0 FB beq err_carryset
276
277 ;save off this point as a fallback in case we don't actually have
278 ;exponential notation
279 D89F 84 F2 sty cix
280
281 ;check for sign
282 D8A1 A2 00 ldx #0
283 D8A3 C8 iny
284 D8A4 B1 F3 lda (inbuff),y
285 D8A6 C9 2B cmp #'+'
286 D8A8 F0 05 beq isexpplus
287 D8AA C9 2D cmp #'-'
288 D8AC D0 02 bne postexpsign
289 D8AE CA dex ;x=$ff
290 D8AF isexpplus:
291 D8AF C8 iny
292 D8B0 postexpsign:
293 D8B0 86 E7 stx xinvert
294
295 ;pull up to two exponent digits -- check first digit
296 D8B2 20 B1 DB jsr fp_isdigit_y
297 D8B5 C8 iny
298 D8B6 B0 CA bcs term_rollback_exp
299
300 ;stash first digit
301 D8B8 AA tax
302
303 ;check for another digit
304 D8B9 20 B1 DB jsr fp_isdigit_y
305 D8BC B0 05 bcs notexpzero2
306 D8BE C8 iny
307
308 D8BF 7D 39 DA adc fp_mul10,x
309 D8C2 AA tax
310 D8C3 notexpzero2:
311 D8C3 8A txa
312
313 ;zero is not a valid exponent
314 D8C4 F0 BC beq term_rollback_exp
315
316 ;check if mantissa is zero -- if so, don't bias
317 ; ldx fr0+1
318 ; beq term
319
320 ;apply sign to exponent
321 D8C6 45 E7 eor xinvert
322 D8C8 26 E7 rol xinvert
323
324 ;bias digit exponent
325 D8CA 65 D4 adc fr0
326 D8CC 85 D4 sta fr0
327 D8CE expterm:
328 D8CE 4C 80 D8 jmp term
329
330 .endp
331
332 ;==========================================================================
333 D8D1 .proc fp_fmul_carryup
334 D8D1 round_loop:
335 D8D1 75 D4 adc fr0,x
336 D8D3 95 D4 sta fr0,x
337 D8D5 dec_entry:
338 D8D5 CA dex
339 D8D6 A9 00 lda #0
340 D8D8 B0 F7 bcs round_loop
341 D8DA 60 rts
342 .endp
343
344 ;==========================================================================
345 D8DB .proc fp_tab_lo_100
346 D8DB 00 64 C8 2C 90 F4 + :10 dta <[100*#]
347 .endp
348
349 ;==========================================================================
350 D8E5 fixadr $d8e6
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($D8E6-*),' bytes free before ',$D8E6
2 $0001 bytes free before $D8E6
3 D8E5 org $D8E6
Source: source/Shared/mathpack.s
351 = D8E6 _fasc = fasc
352 D8E6 .proc fasc
353 = 00F7 dotcntr = ztemp4
354 = 00F8 expval = ztemp4+1
355 = 00F9 trimbase = ztemp4+2
356 D8E6 20 51 DA jsr ldbufa
357 D8E9 A0 00 ldy #0
358
359 ;read exponent and check if number is zero
360 D8EB A5 D4 lda fr0
361 D8ED D0 05 bne notzero
362
363 D8EF A9 B0 lda #$b0
364 D8F1 91 F3 sta (inbuff),y
365 D8F3 60 rts
366
367 D8F4 notzero:
368 D8F4 84 F8 sty expval
369 D8F6 84 F9 sty trimbase
370
371 ;insert sixth mantissa byte
372 D8F8 84 D4 sty fr0
373
374 ;check if number is negative
375 D8FA 10 0A bpl ispos
376 D8FC A2 2D ldx #'-'
377 D8FE C6 F3 dec inbuff
378 D900 8E 7F 05 stx lbuff-1
379 D903 E6 F9 inc trimbase
380 D905 C8 iny
381 D906 ispos:
382
383 ;set up for 5 mantissa bytes
384 D906 A2 FB ldx #-5
385
386 ;compute digit offset to place dot
387 ; 0.001 (10.0E-04) = 3E 10 00 00 00 00 -> -1
388 ; 0.01 ( 1.0E-02) = 3F 01 00 00 00 00 -> 1
389 ; 0.1 (10.0E-02) = 3F 10 00 00 00 00 -> 1
390 ; 1.0 ( 1.0E+00) = 40 01 00 00 00 00 -> 3
391 ; 10.0 (10.0E+00) = 40 10 00 00 00 00 -> 3
392 ; 100.0 ( 1.0E+02) = 40 01 00 00 00 00 -> 5
393 ; 1000.0 (10.0E+02) = 40 10 00 00 00 00 -> 5
394
395 D908 0A asl
396 D909 38 sec
397 D90A E9 7D sbc #125
398
399 ;check if we should go to exponential form (exp >= 10 or <=-3)
400 D90C C9 0C cmp #12
401 D90E 90 0A bcc noexp
402
403 ;yes - compute and stash explicit exponent
404 D910 E9 02 sbc #2 ;!! - carry set from BCC fail
405 D912 85 F8 sta expval ;$0A <= expval < $FE
406
407 ;reset dot counter
408 D914 A9 02 lda #2
409
410 ;exclude first two digits from zero trim
411 D916 E6 F9 inc trimbase
412 D918 E6 F9 inc trimbase
413
414 D91A noexp:
415 ;check if number is less than 1.0 and init dot counter
416 D91A C9 02 cmp #2
417 D91C B0 03 bcs not_tiny
418
419 ;use sixth mantissa byte
420 D91E 69 02 adc #2
421 D920 CA dex
422 D921 not_tiny:
423 D921 85 F7 sta dotcntr ;$02 <= dotcntr < $0C
424
425 ;check if number begins with a leading zero
426 D923 B5 DA lda fr0+6,x
427 D925 C9 10 cmp #$10
428 D927 B0 0C bcs digitloop
429
430 D929 C6 F9 dec trimbase
431
432 ;yes - skip the high digit
433 D92B 46 F8 lsr expval
434 D92D 06 F8 asl expval
435 D92F D0 18 bne writelow
436 D931 C6 F7 dec dotcntr
437 D933 90 14 bcc writelow
438
439 ;write out mantissa digits
440 D935 digitloop:
441 D935 C6 F7 dec dotcntr
442 D937 D0 05 bne no_hidot
443 D939 A9 2E lda #'.'
444 D93B 91 F3 sta (inbuff),y
445 D93D C8 iny
446 D93E no_hidot:
447
448 ;write out high digit
449 D93E B5 DA lda fr0+6,x
450 D940 4A lsr
451 D941 4A lsr
452 D942 4A lsr
453 D943 4A lsr
454 D944 09 30 ora #$30
455 D946 91 F3 sta (inbuff),y
456 D948 C8 iny
457
458 D949 writelow:
459 ;write out low digit
460 D949 C6 F7 dec dotcntr
461 D94B D0 05 bne no_lodot
462 D94D A9 2E lda #'.'
463 D94F 91 F3 sta (inbuff),y
464 D951 C8 iny
465 D952 no_lodot:
466
467 D952 B5 DA lda fr0+6,x
468 D954 29 0F and #$0f
469 D956 09 30 ora #$30
470 D958 91 F3 sta (inbuff),y
471 D95A C8 iny
472
473 ;next digit
474 D95B E8 inx
475 D95C D0 D7 bne digitloop
476
477 ;skip trim if dot hasn't been written
478 D95E A5 F7 lda dotcntr
479 D960 10 11 bpl skip_zero_trim
480
481 ;trim off leading zeroes
482 D962 A9 30 lda #'0'
483 D964 lzloop:
484 D964 C4 F9 cpy trimbase
485 D966 F0 05 beq stop_zero_trim
486 D968 88 dey
487 D969 D1 F3 cmp (inbuff),y
488 D96B F0 F7 beq lzloop
489
490 ;trim off dot
491 D96D stop_zero_trim:
492 D96D B1 F3 lda (inbuff),y
493 D96F C9 2E cmp #'.'
494 D971 D0 03 bne no_trailing_dot
495
496 D973 skip_zero_trim:
497 D973 88 dey
498 D974 B1 F3 lda (inbuff),y
499 D976 no_trailing_dot:
500
501 ;check if we have an exponent to deal with
502 D976 A6 F8 ldx expval
503 D978 F0 26 beq noexp2
504
505 ;print an 'E'
506 D97A A9 45 lda #'E'
507 D97C C8 iny
508 D97D 91 F3 sta (inbuff),y
509
510 ;check for a negative exponent
511 D97F 8A txa
512 D980 10 07 bpl exppos
513 D982 49 FF eor #$ff
514 D984 AA tax
515 D985 E8 inx
516 D986 A9 2D lda #'-'
517 D988 2C dta {bit $0100}
518 D989 exppos:
519 D989 A9 2B lda #'+'
520 D98B expneg:
521 D98B C8 iny
522 D98C 91 F3 sta (inbuff),y
523
524 ;print tens digit, if any
525 D98E 8A txa
526 D98F 38 sec
527 D990 A2 2F ldx #$2f
528 D992 tensloop:
529 D992 E8 inx
530 D993 E9 0A sbc #10
531 D995 B0 FB bcs tensloop
532 D997 48 pha
533 D998 8A txa
534 D999 C8 iny
535 D99A 91 F3 sta (inbuff),y
536 D99C 68 pla
537 D99D 69 3A adc #$3a
538 D99F C8 iny
539 D9A0 noexp2:
540 ;set high bit on last char
541 D9A0 09 80 ora #$80
542 D9A2 91 F3 sta (inbuff),y
543 D9A4 60 rts
544 .endp
545
546 ;==========================================================================
547 ; IPF [D9AA] Convert 16-bit integer at FR0 to FP
548 ;
549 ; !NOTE! Cannot use FR2/FR3 -- MAC/65 requires that $DE-DF be preserved.
550 ;
551 D9A5 fixadr $d9aa
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($D9AA-*),' bytes free before ',$D9AA
2 $0005 bytes free before $D9AA
3 D9A5 org $D9AA
Source: source/Shared/mathpack.s
552 D9AA .proc ipf
553 D9AA F8 sed
554
555 D9AB A2 D6 ldx #fr0+2
556 D9AD A0 05 ldy #5
557 D9AF 20 48 DA jsr zfl
558
559 D9B2 A0 10 ldy #16
560 D9B4 byteloop:
561 ;shift out binary bit
562 D9B4 06 D4 asl fr0
563 D9B6 26 D5 rol fr0+1
564
565 ;shift in BCD bit
566 D9B8 A5 D8 lda fr0+4
567 D9BA 65 D8 adc fr0+4
568 D9BC 85 D8 sta fr0+4
569 D9BE A5 D7 lda fr0+3
570 D9C0 65 D7 adc fr0+3
571 D9C2 85 D7 sta fr0+3
572 D9C4 26 D6 rol fr0+2
573
574 D9C6 88 dey
575 D9C7 D0 EB bne byteloop
576
577 D9C9 A9 43 lda #$43
578 D9CB 85 D4 sta fr0
579
580 D9CD 4C FF DB jmp fp_normalize_cld
581 .endp
582
583 ;==========================================================================
584 ; FPI [D9D2] Convert FR0 to 16-bit integer at FR0 with rounding
585 ;
586 ; This cannot overwrite FR1. Darg relies on being able to stash a value
587 ; there across a call to FPI in its startup.
588 ;
589 D9D0 fixadr $d9d2
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($D9D2-*),' bytes free before ',$D9D2
2 $0002 bytes free before $D9D2
3 D9D0 org $D9D2
Source: source/Shared/mathpack.s
590 D9D2 .nowarn .proc fpi
591 = 00E6 _acc0 = fr2
592 = 00E7 _acc1 = fr2+1
593
594 ;error out if it's guaranteed to be too big or negative (>999999)
595 D9D2 A5 D4 lda fr0
596 D9D4 C9 43 cmp #$43
597 D9D6 B0 60 bcs err
598
599 ;zero number if it's guaranteed to be too small (<0.01)
600 D9D8 E9 3E sbc #$3f-1 ;!!- carry is clear
601 D9DA 90 68 bcc zfr0
602
603 D9DC AA tax
604
605 ;clear temp accum and set up rounding
606 D9DD A9 00 lda #0
607 D9DF B4 D5 ldy fr0+1,x
608 D9E1 C0 50 cpy #$50
609 D9E3 2A rol ;!! - clears carry too
610 D9E4 85 D4 sta fr0
611 D9E6 A9 00 lda #0
612
613 ;check for [0.01, 1)
614 D9E8 CA dex
615 D9E9 30 4B bmi done
616
617 ;convert ones/tens digit pair to binary (one result byte: 0-100)
618 D9EB B5 D5 lda fr0+1,x
619 D9ED 20 CD DA jsr fp_dectobin
620 D9F0 65 D4 adc fr0
621 D9F2 79 F6 DF adc fp_dectobin_tab,y
622 D9F5 18 clc
623 D9F6 85 D4 sta fr0
624 D9F8 A9 00 lda #0
625
626 ;check if we're done
627 D9FA CA dex
628 D9FB 30 39 bmi done
629
630 ;convert hundreds/thousands digit pair to binary (two result bytes: 0-10000)
631 D9FD B5 D5 lda fr0+1,x
632 D9FF 20 CD DA jsr fp_dectobin
633 DA02 A5 D4 lda fr0
634 DA04 79 48 DF adc fp_tab_lo_1000,y
635 DA07 85 D4 sta fr0
636 DA09 B9 52 DF lda fp_tab_hi_1000,y
637 DA0C 69 00 adc #0
638 DA0E 48 pha
639 DA0F B5 D5 lda fr0+1,x
640 DA11 29 0F and #$0f
641 DA13 A8 tay
642 DA14 A5 D4 lda fr0
643 DA16 79 DB D8 adc fp_tab_lo_100,y
644 DA19 85 D4 sta fr0
645 DA1B 68 pla
646 DA1C 79 5C DF adc fp_tab_hi_100,y
647
648 ;check if we're done
649 DA1F CA dex
650 DA20 30 14 bmi done
651
652 ;convert ten thousands digit pair to binary (two result bytes: 0-100000, overflow possible)
653 DA22 B4 D5 ldy fr0+1,x
654 DA24 C0 07 cpy #$07
655 DA26 B0 10 bcs err
656 DA28 AA tax
657 DA29 98 tya
658 DA2A 0A asl
659 DA2B 0A asl
660 DA2C 0A asl
661 DA2D 0A asl
662 DA2E 65 D4 adc fr0
663 DA30 85 D4 sta fr0
664 DA32 8A txa
665 DA33 79 65 DF adc fp_tab_hi_10000-1,y
666
667 DA36 done:
668 ;move result back to FR0, with rounding
669 DA36 85 D5 sta fr0+1
670 DA38 err:
671 DA38 60 rts
672 .endp
673
674 ;==========================================================================
675 DA39 fp_mul10:
676 DA39 00 0A 14 1E 28 32 + dta 0,10,20,30,40,50,60,70,80,90
677
678 ;==========================================================================
679 ; ZFR0 [DA44] Zero FR0
680 ; ZF1 [DA46] Zero float at (X)
681 ; ZFL [DA48] Zero float at (X) with length Y (UNDOCUMENTED)
682 ;
683 DA43 fixadr $da44
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($DA44-*),' bytes free before ',$DA44
2 $0001 bytes free before $DA44
3 DA43 org $DA44
Source: source/Shared/mathpack.s
684 DA44 zfr0:
685 DA44 A2 D4 ldx #fr0
686 DA46 ckaddr $da46
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
687 DA46 zf1:
688 DA46 A0 06 ldy #6
689 DA48 ckaddr $da48
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
690 DA48 zfl:
691 DA48 A9 00 lda #0
692 DA4A zflloop:
693 DA4A 95 00 sta 0,x
694 DA4C E8 inx
695 DA4D 88 dey
696 DA4E D0 FA bne zflloop
697 DA50 60 rts
698
699 ;==========================================================================
700 ; LDBUFA [DA51] Set LBUFF to #INBUFF (UNDOCUMENTED)
701 ;
702 DA51 fixadr $da51
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
703 DA51 ldbufa:
704 DA51 A9 80 85 F3 A9 05 + mwa #lbuff inbuff
705 DA59 60 rts
706
707 ;==========================================================================
708 ; FPILL_SHL16 [DA5A] Shift left 16-bit word at $F7:F8 (UNDOCUMENTED)
709 ;
710 ; Illegal entry point used by MAC/65 when doing hex conversion.
711 ;
712 ; Yes, even the byte ordering is wrong.
713 ;
714 DA5A fixadr $da5a
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
715
716 DA5A .nowarn .proc fpill_shl16
717 DA5A 06 F8 asl $f8
718 DA5C 26 F7 rol $f7
719 DA5E 60 rts
720 .endp
721
722 ;** 1 byte free**
723
724 ;==========================================================================
725 ; FSUB [DA60] Subtract FR1 from FR0; FR1 is altered
726 ; FADD [DA66] Add FR1 to FR0; FR1 is altered
727 DA5F fixadr $da60
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($DA60-*),' bytes free before ',$DA60
2 $0001 bytes free before $DA60
3 DA5F org $DA60
Source: source/Shared/mathpack.s
728 = DA66 fadd = fsub._fadd
729 DA60 .proc fsub
730
731 = 00E0 _diffmode = fr1
732
733 ;toggle sign on FR1
734 DA60 A5 E0 lda fr1
735 DA62 49 80 eor #$80
736 DA64 85 E0 sta fr1
737
738 ;fall through to FADD
739
740 DA66 ckaddr $da66
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
741 DA66 _fadd:
742 ;if fr1 is zero, we're done
743 DA66 A5 E0 lda fr1
744 DA68 F0 4E beq sum_xit
745
746 ;if fr0 is zero, swap
747 DA6A A5 D4 lda fr0
748 DA6C F0 0E beq swap
749
750 ;compute difference in exponents, ignoring sign
751 DA6E A5 E0 lda fr1 ;load fr1 sign
752 DA70 45 D4 eor fr0 ;compute fr0 ^ fr1 signs
753 DA72 29 80 and #$80 ;mask to just sign
754 DA74 AA tax
755 DA75 45 E0 eor fr1 ;flip fr1 sign to match fr0
756 DA77 18 clc
757 DA78 E5 D4 sbc fr0 ;compute difference in exponents - 1
758 DA7A 90 05 bcc noswap
759
760 ;swap FR0 and FR1
761 DA7C swap:
762 DA7C 20 74 DD jsr fp_swap
763
764 ;loop back and retry
765 DA7F 30 E5 bmi _fadd
766
767 DA81 noswap:
768 ;A = FR1 - FR0 - 1
769 ;X = add/sub flag
770
771 ;compute positions for add/subtract
772 DA81 69 06 adc #6 ;A = (FR1) - (FR0) + 6 !! carry is clear coming in
773 DA83 A8 tay
774
775 ;check if FR1 is too small in magnitude to matter
776 DA84 30 32 bmi sum_xit
777
778 ;jump to decimal mode and prepare for add/sub loops
779 DA86 F8 sed
780
781 ;check if we are doing a sum or a difference
782 DA87 E0 80 cpx #$80
783 DA89 A2 05 ldx #5
784 DA8B B0 2E bcs do_subtract
785
786 ;set up rounding
787 DA8D A9 00 lda #0
788 DA8F C0 05 cpy #5
789 DA91 B0 03 bcs add_no_round
790 DA93 B9 E1 00 lda fr1+1,y
791 DA96 add_no_round:
792 DA96 C9 50 cmp #$50
793
794 ;add mantissas
795 DA98 98 tya
796 DA99 F0 0B beq post_add_loop
797 DA9B add_loop:
798 DA9B B9 E0 00 lda fr1,y
799 DA9E 75 D4 adc fr0,x
800 DAA0 95 D4 sta fr0,x
801 DAA2 CA dex
802 DAA3 88 dey
803 DAA4 D0 F5 bne add_loop
804 DAA6 post_add_loop:
805
806 ;check if we had a carry out
807 DAA6 90 10 bcc sum_xit
808
809 ;carry it up
810 DAA8 B0 08 bcs sum_carryloop_start
811 DAAA sum_carryloop:
812 DAAA B5 D5 lda fr0+1,x
813 DAAC 69 00 adc #0
814 DAAE 95 D5 sta fr0+1,x
815 DAB0 90 06 bcc sum_xit
816 DAB2 sum_carryloop_start:
817 DAB2 CA dex
818 DAB3 10 F5 bpl sum_carryloop
819
820 DAB5 20 6A DE jsr fp_carry_expup
821
822 DAB8 sum_xit:
823 ;exit decimal mode
824 ;normalize if necessary and exit (needed for borrow, as well to check over/underflow)
825 DAB8 4C FF DB jmp fp_normalize_cld
826
827 DABB do_subtract:
828 ;subtract FR0 and FR1 mantissas (!! carry is set coming in)
829 DABB 84 E0 sty fr1
830 DABD B0 08 bcs sub_loop_entry
831 DABF sub_loop:
832 DABF B5 D4 lda fr0,x
833 DAC1 F9 E1 00 sbc fr1+1,y
834 DAC4 95 D4 sta fr0,x
835 DAC6 CA dex
836 DAC7 sub_loop_entry:
837 DAC7 88 dey
838 DAC8 10 F5 bpl sub_loop
839 DACA 4C 5E DC jmp fp_fsub_cont
840 .endp
841
842 ;==========================================================================
843 ; Entry:
844 ; A = BCD value
845 ; P.D = clear
846 ;
847 ; Exit:
848 ; A = binary value
849 ; Y = modified
850 ;
851 DACD .proc fp_dectobin
852 DACD 48 pha
853 DACE 4A lsr
854 DACF 4A lsr
855 DAD0 4A lsr
856 DAD1 4A lsr
857 DAD2 A8 tay
858 DAD3 68 pla
859 = DAD4 .def :fp_exit_success
860 DAD4 18 clc
861 DAD5 60 rts
862 .endp
863
864 ;==========================================================================
865 ; FMUL [DADB]: Multiply FR0 * FR1 -> FR0
866 ;
867 DAD6 fixadr $dad6
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
868 DAD6 fp_fld1r_const_fmul:
869 DAD6 A0 DB ldy #>fpconst_ten
870 DAD8 fp_fld1r_fmul:
871 DAD8 20 98 DD jsr fld1r
872 DADB ckaddr $dadb
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
873 DADB .proc fmul
874
875 ;We use FR0:FR3 as a double-precision accumulator, and copy the
876 ;original multiplicand value in FR0 to FR1. The multiplier in
877 ;FR1 is converted to binary digit pairs into FR2.
878
879 = 00DF _offset = _fr3+5
880 = 00E6 _offset2 = fr2
881
882 ;if FR0 is zero, we're done
883 DADB A5 D4 lda fr0
884 DADD F0 F5 beq fp_exit_success
885
886 ;if FR1 is zero, zero FR0 and exit
887 DADF A5 E0 lda fr1
888 DAE1 18 clc
889 DAE2 F0 17 beq fp_exit_zero
890
891 ;move fr0 to fr2
892 DAE4 20 79 DE jsr fp_fmul_fr0_to_binfr2
893
894 ;compute new exponent and stash
895 DAE7 A5 E0 lda fr1
896 DAE9 18 clc
897 DAEA 20 03 DB jsr fp_adjust_exponent.fmul_entry
898
899 DAED 85 D4 sta fr0
900 DAEF E6 D4 inc fr0
901
902 ;clear accumulator through to exponent byte of fr1
903 DAF1 A2 D5 ldx #fr0+1
904 DAF3 A0 0C ldy #12
905 DAF5 F8 sed
906
907 DAF6 4C C3 DC jmp fp_fmul_innerloop
908 .endp
909
910 DAF9 underflow_overflow:
911 DAF9 68 pla
912 DAFA 68 pla
913 DAFB fp_exit_zero:
914 DAFB 4C 44 DA jmp zfr0
915
916 DAFE .proc fp_adjust_exponent
917 DAFE fdiv_entry:
918 DAFE A5 E0 lda fr1
919 DB00 49 7F eor #$7f
920 DB02 38 sec
921 DB03 fmul_entry:
922 ;stash modified exp1
923 DB03 AA tax
924
925 ;compute new sign
926 DB04 45 D4 eor fr0
927 DB06 29 80 and #$80
928 DB08 85 E0 sta fr1
929
930 ;merge exponents
931 DB0A 8A txa
932 DB0B 65 D4 adc fr0
933 DB0D AA tax
934 DB0E 45 E0 eor fr1
935
936 ;check for underflow/overflow
937 DB10 C9 4F cmp #128-49
938 DB12 90 E5 bcc underflow_overflow
939
940 DB14 C9 B1 cmp #128+49
941 DB16 B0 E1 bcs underflow_overflow
942
943 ;rebias exponent
944 DB18 8A txa
945 DB19 E9 3F sbc #$40-1 ;!! - C=0 from bcs fail
946 DB1B 60 rts
947 .endp
948
949 ;==========================================================================
950 DB1C .pages 1 ;optimized by fp_fld1r_const_fmul
951
952 DB1C fpconst_ten:
953 DB1C 40 10 00 00 00 00 .fl 10
954
955 DB22 fpconst_ln10:
956 DB22 40 02 30 25 85 09 .fl 2.3025850929940456840179914546844
957
958 DB28 .endpg
959 ;==========================================================================
960 ; FDIV [DB28] Divide FR0 / FR1 -> FR0
961 ;
962 ; Compatibility:
963 ; - It is important that FDIV rounds if FADD/FMUL do. Otherwise, some
964 ; forms of square root computation can have a slight error on integers,
965 ; which breaks TICKTOCK.BAS.
966 ;
967 DB28 fixadr $db28
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
968 DB28 .proc fdiv
969 = 00DB _digit = _fr3+1
970 = 00DC _index = _fr3+2
971 ;check if divisor is zero
972 DB28 A5 E0 lda fr1
973 DB2A F0 72 beq err
974
975 ;check if dividend is zero
976 DB2C A5 D4 lda fr0
977 DB2E F0 6C beq ok
978
979 ;compute new exponent
980 DB30 20 FE DA jsr fp_adjust_exponent.fdiv_entry
981
982 DB33 20 2D DC jsr fp_fdiv_init
983
984 DB36 digitloop:
985 ;just keep going if we're accurate
986 DB36 A5 D4 lda fr0
987 DB38 05 D5 ora fr0+1
988 DB3A F0 3D beq nextdigit
989
990 ;check if we should either divide or add based on current sign (stored in carry)
991 DB3C 90 05 bcc incloop
992
993 DB3E 20 B9 DB jsr fp_fdiv_decloop
994 DB41 90 36 bcc nextdigit
995
996 DB43 incloop:
997 ;decrement quotient mantissa byte
998 DB43 A9 00 lda #0
999 DB45 E5 DB sbc _digit
1000 DB47 A6 DC ldx _index
1001 DB49 downloop:
1002 DB49 75 ED adc fr2+7,x
1003 DB4B 95 ED sta fr2+7,x
1004 DB4D A9 99 lda #$99
1005 DB4F CA dex
1006 DB50 90 F7 bcc downloop
1007
1008 ;add mantissas
1009 DB52 18 clc
1010 .rept 6
1011 LDA FR0+(5-#)
1012 ADC FR1+(5-#)
1013 STA FR0+(5-#)
1014 .ENDR
1014 .endr
Source: REPT
1011 DB53 A5 D9 LDA FR0+(5-#)
1011 DB55 65 E5 ADC FR1+(5-#)
1011 DB57 85 D9 STA FR0+(5-#)
1011 DB59 A5 D8 LDA FR0+(5-#)
1011 DB5B 65 E4 ADC FR1+(5-#)
1011 DB5D 85 D8 STA FR0+(5-#)
1011 DB5F A5 D7 LDA FR0+(5-#)
1011 DB61 65 E3 ADC FR1+(5-#)
1011 DB63 85 D7 STA FR0+(5-#)
1011 DB65 A5 D6 LDA FR0+(5-#)
1011 DB67 65 E2 ADC FR1+(5-#)
1011 DB69 85 D6 STA FR0+(5-#)
1011 DB6B A5 D5 LDA FR0+(5-#)
1011 DB6D 65 E1 ADC FR1+(5-#)
1011 DB6F 85 D5 STA FR0+(5-#)
1011 DB71 A5 D4 LDA FR0+(5-#)
1011 DB73 65 E0 ADC FR1+(5-#)
1011 DB75 85 D4 STA FR0+(5-#)
Source: source/Shared/mathpack.s
1015
1016 ;keep going until we overflow
1017 DB77 90 CA bcc incloop
1018
1019 DB79 nextdigit:
1020 ;shift dividend (make sure to save carry state)
1021 DB79 08 php
1022 DB7A A2 04 ldx #4
1023 DB7C bitloop:
1024 DB7C 06 D9 asl fr0+5
1025 DB7E 26 D8 rol fr0+4
1026 DB80 26 D7 rol fr0+3
1027 DB82 26 D6 rol fr0+2
1028 DB84 26 D5 rol fr0+1
1029 DB86 26 D4 rol fr0
1030 DB88 CA dex
1031 DB89 D0 F1 bne bitloop
1032 DB8B 28 plp
1033
1034 ;next digit
1035 DB8C A5 DB lda _digit
1036 DB8E 49 09 eor #$09
1037 DB90 85 DB sta _digit
1038 DB92 F0 A2 beq digitloop
1039
1040 ;next quo byte
1041 DB94 E6 DC inc _index
1042 DB96 D0 9E bne digitloop
1043
1044 ;move back to fr0
1045 DB98 20 EE DB jsr fp_fdiv_complete
1046 DB9B D8 cld
1047 DB9C ok:
1048 DB9C 18 clc
1049 DB9D 60 rts
1050 DB9E err:
1051 DB9E 38 sec
1052 DB9F 60 rts
1053 .endp
1054
1055 ;==========================================================================
1056 ; SKPSPC [DBA1] Increment CIX while INBUFF[CIX] is a space
1057 DBA0 fixadr $dba1
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($DBA1-*),' bytes free before ',$DBA1
2 $0001 bytes free before $DBA1
3 DBA0 org $DBA1
Source: source/Shared/mathpack.s
1058 DBA1 skpspc:
1059 DBA1 A9 20 lda #' '
1060 DBA3 A4 F2 ldy cix
1061 DBA5 fp_skipchar:
1062 DBA5 skpspc_loop:
1063 DBA5 D1 F3 cmp (inbuff),y
1064 DBA7 D0 03 bne skpspc_xit
1065 DBA9 C8 iny
1066 DBAA D0 F9 bne skpspc_loop
1067 DBAC skpspc_xit:
1068 DBAC 84 F2 sty cix
1069 DBAE 60 rts
1070
1071 ;==========================================================================
1072 ; ISDIGT [DBAF] Check if INBUFF[CIX] is a digit (UNDOCUMENTED)
1073 DBAF fixadr $dbaf
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1074 = DBAF isdigt = _isdigt
1075 DBAF .proc _isdigt
1076 DBAF A4 F2 ldy cix
1077 = DBB1 .def :fp_isdigit_y = *
1078 DBB1 B1 F3 lda (inbuff),y
1079 DBB3 38 sec
1080 DBB4 E9 30 sbc #'0'
1081 DBB6 C9 0A cmp #10
1082 DBB8 60 rts
1083 .endp
1084
1085 ;==========================================================================
1086 DBB9 .proc fp_fdiv_decloop
1087 DBB9 decloop:
1088 ;increment quotient mantissa byte
1089 DBB9 A5 DB lda fdiv._digit
1090 DBBB A6 DC ldx fdiv._index
1091 DBBD uploop:
1092 DBBD 75 ED adc fr2+7,x
1093 DBBF 95 ED sta fr2+7,x
1094 DBC1 A9 00 lda #0
1095 DBC3 CA dex
1096 DBC4 B0 F7 bcs uploop
1097
1098 ;subtract mantissas
1099 DBC6 38 sec
1100 DBC7 A5 D9 lda fr0+5
1101 DBC9 E5 E5 sbc fr1+5
1102 DBCB 85 D9 sta fr0+5
1103 DBCD A5 D8 lda fr0+4
1104 DBCF E5 E4 sbc fr1+4
1105 DBD1 85 D8 sta fr0+4
1106 DBD3 A5 D7 lda fr0+3
1107 DBD5 E5 E3 sbc fr1+3
1108 DBD7 85 D7 sta fr0+3
1109 DBD9 A5 D6 lda fr0+2
1110 DBDB E5 E2 sbc fr1+2
1111 DBDD 85 D6 sta fr0+2
1112 DBDF A5 D5 lda fr0+1
1113 DBE1 E5 E1 sbc fr1+1
1114 DBE3 85 D5 sta fr0+1
1115 DBE5 A5 D4 lda fr0
1116 DBE7 E9 00 sbc #0
1117 DBE9 85 D4 sta fr0
1118
1119 ;keep going until we underflow
1120 DBEB B0 CC bcs decloop
1121 DBED 60 rts
1122 .endp
1123
1124 DBEE .proc fp_fdiv_complete
1125 DBEE A2 E5 ldx #fr2-1
1126 DBF0 A4 DA ldy _fr3
1127 DBF2 A5 E6 lda fr2
1128 DBF4 D0 02 bne no_normstep
1129 DBF6 E8 inx
1130 DBF7 88 dey
1131 DBF8 no_normstep:
1132 DBF8 94 00 sty 0,x
1133 DBFA 4C 87 DD jmp fld0r_zp
1134 .endp
1135
1136 ;==========================================================================
1137 ; NORMALIZE [DC00] Normalize FR0 (UNDOCUMENTED)
1138 DBFD fixadr $dc00-1
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($DC00-1-*),' bytes free before ',$DC00-1
2 $0002 bytes free before $DBFF
3 DBFD org $DC00-1
Source: source/Shared/mathpack.s
1139 DBFF fp_normalize_cld:
1140 DBFF D8 cld
1141 DC00 ckaddr $dc00
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1142 DC00 fp_normalize:
1143 DC00 .nowarn .proc normalize
1144 DC00 A0 05 ldy #5
1145 DC02 normloop:
1146 DC02 A5 D4 lda fr0
1147 DC04 29 7F and #$7f
1148 DC06 F0 21 beq underflow2
1149
1150 DC08 A6 D5 ldx fr0+1
1151 DC0A F0 07 beq need_norm
1152
1153 ;Okay, we're done normalizing... check if the exponent is in bounds.
1154 ;It needs to be within +/-48 to be valid. If the exponent is <-49,
1155 ;we set it to zero; otherwise, we mark overflow.
1156
1157 DC0C C9 0F cmp #64-49
1158 DC0E 90 1A bcc underflow
1159 DC10 C9 71 cmp #64+49
1160 DC12 60 rts
1161
1162 DC13 need_norm:
1163 DC13 C6 D4 dec fr0
1164 DC15 A2 FB ldx #-5
1165 DC17 normloop2:
1166 DC17 B5 DB 95 DA mva fr0+7,x fr0+6,x
1167 DC1B E8 inx
1168 DC1C D0 F9 bne normloop2
1169 DC1E 86 DA stx fr0+6
1170 DC20 88 dey
1171 DC21 D0 DF bne normloop
1172
1173 ;Hmm, we shifted out everything... must be zero; reset exponent. This
1174 ;is critical since Atari Basic depends on the exponent being zero for
1175 ;a zero result.
1176 DC23 84 D4 sty fr0
1177 DC25 84 D5 sty fr0+1
1178 DC27 xit:
1179 DC27 18 clc
1180 DC28 60 rts
1181
1182 DC29 underflow2:
1183 DC29 18 clc
1184 DC2A underflow:
1185 DC2A 4C 44 DA jmp zfr0
1186
1187 .endp
1188
1189 ;==========================================================================
1190 ; HELPER ROUTINES
1191 ;==========================================================================
1192
1193 DC2D .proc fp_fdiv_init
1194 DC2D 85 DA sta _fr3
1195
1196 DC2F A2 E6 ldx #fr2
1197 DC31 20 46 DA jsr zf1
1198 DC34 A9 50 lda #$50
1199 DC36 85 EC sta fr2+6
1200
1201 DC38 A2 00 ldx #0
1202 DC3A 86 D4 stx fr0
1203 DC3C 86 E0 stx fr1
1204
1205 ;check if dividend begins with a leading zero digit -- if so, shift it left 4
1206 ;and begin with the tens digit
1207 DC3E A5 E1 lda fr1+1
1208 DC40 C9 10 cmp #$10
1209 DC42 B0 11 bcs start_with_ones
1210
1211 DC44 A0 04 ldy #4
1212 DC46 bitloop:
1213 DC46 06 E5 asl fr1+5
1214 DC48 26 E4 rol fr1+4
1215 DC4A 26 E3 rol fr1+3
1216 DC4C 26 E2 rol fr1+2
1217 DC4E 26 E1 rol fr1+1
1218 DC50 88 dey
1219 DC51 D0 F3 bne bitloop
1220
1221 DC53 A2 09 ldx #$09
1222
1223 DC55 start_with_ones:
1224
1225 DC55 86 DB stx fdiv._digit
1226 DC57 F8 sed
1227
1228 DC58 A2 F9 ldx #0-7
1229 DC5A 86 DC stx fdiv._index
1230 DC5C 38 sec
1231 DC5D 60 rts
1232 .endp
1233
1234 ;--------------------------------------------------------------------------
1235 DC5E .proc fp_fsub_cont
1236 ;check if we had a borrow
1237 DC5E B0 1F bcs sub_xit
1238 DC60 90 08 bcc borrow_loop_start
1239
1240 ;propagate borrow up
1241 DC62 borrow_loop:
1242 DC62 B5 D5 lda fr0+1,x
1243 DC64 E9 00 sbc #0
1244 DC66 95 D5 sta fr0+1,x
1245 DC68 B0 15 bcs sub_xit
1246 DC6A borrow_loop_start:
1247 DC6A CA dex
1248 DC6B 10 F5 bpl borrow_loop
1249
1250 DC6D A2 05 ldx #5
1251 DC6F 38 sec
1252 DC70 diff_borrow:
1253 DC70 A9 00 lda #0
1254 DC72 F5 D4 sbc fr0,x
1255 DC74 95 D4 sta fr0,x
1256 DC76 CA dex
1257 DC77 D0 F7 bne diff_borrow
1258 DC79 A9 80 lda #$80
1259 DC7B 45 D4 eor fr0
1260 DC7D 85 D4 sta fr0
1261 DC7F sub_xit:
1262
1263 DC7F norm_loop:
1264 ;Check if the exponent is in bounds.
1265 ;It needs to be within +/-48 to be valid. If the exponent is <-49,
1266 ;we set it to zero. Overflow isn't possible as this is the mantissa
1267 ;subtraction path.
1268 DC7F A5 D4 lda fr0
1269 DC81 29 7F and #$7f
1270 DC83 C9 0F cmp #64-49
1271 DC85 90 1F bcc underflow
1272
1273 DC87 A6 D5 ldx fr0+1
1274 DC89 F0 0F beq need_norm
1275
1276 ;check if we need to round, i.e.:
1277 ; 2.00000000
1278 ;-0.000000005
1279 ;load rounding byte offset
1280 DC8B A6 E0 ldx fr1
1281 DC8D E0 04 cpx #4
1282 DC8F B0 06 bcs no_round
1283 DC91 B5 E2 lda fr1+2,x
1284 DC93 C9 50 cmp #$50
1285 DC95 B0 27 bcs round_up
1286 DC97 no_round:
1287
1288 DC97 18 clc
1289 DC98 D8 cld
1290 DC99 60 rts
1291
1292 DC9A need_norm:
1293 DC9A A2 FC ldx #-4
1294 DC9C scan_loop:
1295 DC9C C6 D4 dec fr0
1296 DC9E B4 DA ldy fr0+6,x
1297 DCA0 D0 08 bne found_pos
1298 DCA2 E8 inx
1299 DCA3 D0 F7 bne scan_loop
1300
1301 ;hmm... mantissa is all zero.
1302 DCA5 underflow2:
1303 DCA5 18 clc
1304 DCA6 underflow:
1305 DCA6 D8 cld
1306 DCA7 4C 44 DA jmp zfr0
1307
1308 DCAA found_pos:
1309 ;shift up mantissa
1310 DCAA A0 00 ldy #0
1311 DCAC shift_loop:
1312 DCAC B5 DA 99 D5 00 mva fr0+6,x fr0+1,y
1313 DCB1 C8 iny
1314 DCB2 E8 inx
1315 DCB3 D0 F7 bne shift_loop
1316
1317 ;clear remaining mantissa bytes
1318 DCB5 clear_loop:
1319 DCB5 96 D5 C8 stx fr0+1,y+
1320 DCB8 C0 06 cpy #6
1321 DCBA D0 F9 bne clear_loop
1322
1323 ;check if we need to round
1324
1325
1326 ;if not, loop back to check the exponent and exit
1327 ; bcc norm_loop
1328 DCBC F0 C1 beq norm_loop
1329
1330 DCBE round_up:
1331 ;jump back into fadd code to carry up and exit
1332 DCBE A2 05 ldx #5
1333 DCC0 4C AA DA jmp fsub.sum_carryloop
1334 .endp
1335
1336 ;--------------------------------------------------------------------------
1337 DCC3 .proc fp_fmul_innerloop
1338 = 00DF _offset = _fr3+5
1339 = 00E6 _offset2 = fr2
1340
1341 DCC3 20 48 DA jsr zfl
1342
1343 ;set up for 7 bits per digit pair (0-99 in 0-127)
1344 DCC6 A0 07 ldy #7
1345
1346 ;set rounding byte, assuming renormalize needed (fr0+2 through fr0+6)
1347 DCC8 A9 50 lda #$50
1348 DCCA 85 DB sta fr0+7
1349
1350 ;begin outer loop -- this is where we process one _bit_ out of each
1351 ;multiplier byte in FR2's mantissa (note that this is inverted in that
1352 ;it is bytes-in-bits instead of bits-in-bytes)
1353 DCCC offloop:
1354
1355 ;begin inner loop -- here we process the same bit in each multiplier
1356 ;byte, going from byte 5 down to byte 1
1357 DCCC A2 05 ldx #5
1358 DCCE offloop2:
1359 ;shift an inverted bit out of fr1 mantissa
1360 DCCE 56 E6 lsr fr2,x
1361 DCD0 B0 2D bcs noadd
1362
1363 ;add fr1 to fr0 at offset
1364 .rept 6
1365 LDA FR0+(5-#),X
1366 ADC FR1+(5-#)
1367 STA FR0+(5-#),X
1368 .ENDR
1368 .endr
Source: REPT
1365 DCD2 B5 D9 LDA FR0+(5-#),X
1365 DCD4 65 E5 ADC FR1+(5-#)
1365 DCD6 95 D9 STA FR0+(5-#),X
1365 DCD8 B5 D8 LDA FR0+(5-#),X
1365 DCDA 65 E4 ADC FR1+(5-#)
1365 DCDC 95 D8 STA FR0+(5-#),X
1365 DCDE B5 D7 LDA FR0+(5-#),X
1365 DCE0 65 E3 ADC FR1+(5-#)
1365 DCE2 95 D7 STA FR0+(5-#),X
1365 DCE4 B5 D6 LDA FR0+(5-#),X
1365 DCE6 65 E2 ADC FR1+(5-#)
1365 DCE8 95 D6 STA FR0+(5-#),X
1365 DCEA B5 D5 LDA FR0+(5-#),X
1365 DCEC 65 E1 ADC FR1+(5-#)
1365 DCEE 95 D5 STA FR0+(5-#),X
1365 DCF0 B5 D4 LDA FR0+(5-#),X
1365 DCF2 65 E0 ADC FR1+(5-#)
1365 DCF4 95 D4 STA FR0+(5-#),X
Source: source/Shared/mathpack.s
1369
1370 ;check if we have a carry out to the upper bytes
1371 DCF6 90 07 bcc no_carry
1372 DCF8 86 E6 stx _offset2
1373 DCFA 20 D5 D8 jsr fp_fmul_carryup.dec_entry
1374 DCFD A6 E6 ldx _offset2
1375 DCFF no_carry:
1376
1377 DCFF noadd:
1378 ;go back for next byte
1379 DCFF CA dex
1380 DD00 D0 CC bne offloop2
1381
1382 ;double fr1
1383 DD02 18 clc
1384 DD03 A5 E5 lda fr1+5
1385 DD05 65 E5 adc fr1+5
1386 DD07 85 E5 sta fr1+5
1387 DD09 A5 E4 lda fr1+4
1388 DD0B 65 E4 adc fr1+4
1389 DD0D 85 E4 sta fr1+4
1390 DD0F A5 E3 lda fr1+3
1391 DD11 65 E3 adc fr1+3
1392 DD13 85 E3 sta fr1+3
1393 DD15 A5 E2 lda fr1+2
1394 DD17 65 E2 adc fr1+2
1395 DD19 85 E2 sta fr1+2
1396 DD1B A5 E1 lda fr1+1
1397 DD1D 65 E1 adc fr1+1
1398 DD1F 85 E1 sta fr1+1
1399 DD21 A5 E0 lda fr1+0
1400 DD23 65 E0 adc fr1+0
1401 DD25 85 E0 sta fr1+0
1402
1403 ;loop back until all mantissa bytes finished
1404 DD27 88 dey
1405 DD28 D0 A2 bne offloop
1406
1407 ;check if no renormalize is needed, and if so, re-add new rounding
1408 DD2A A5 D5 lda fr0+1
1409 DD2C F0 07 beq renorm_needed
1410
1411 DD2E A9 50 lda #$50
1412 DD30 A2 06 ldx #6
1413 DD32 20 D1 D8 jsr fp_fmul_carryup
1414
1415 DD35 renorm_needed:
1416 ;all done
1417 DD35 4C FF DB jmp fp_normalize_cld
1418 .endp
1419
1420 ;==========================================================================
1421 ; PLYEVL [DD40] Eval polynomial at (X:Y) with A coefficients using FR0
1422 ;
1423 DD38 fixadr $dd3e
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($DD3E-*),' bytes free before ',$DD3E
2 $0006 bytes free before $DD3E
3 DD38 org $DD3E
Source: source/Shared/mathpack.s
1424 DD3E fp_plyevl_10:
1425 DD3E A9 0A lda #10
1426 DD40 .nowarn .proc plyevl
1427 ;stash arguments
1428 DD40 86 FE stx fptr2
1429 DD42 84 FF sty fptr2+1
1430 DD44 85 EC sta _fpcocnt
1431
1432 ;copy FR0 -> PLYARG
1433 DD46 A2 E0 ldx #<plyarg
1434 DD48 A0 05 ldy #>plyarg
1435 DD4A 20 A7 DD jsr fst0r
1436
1437 DD4D 20 44 DA jsr zfr0
1438
1439 DD50 loop:
1440 ;load next coefficient and increment coptr
1441 DD50 A5 FE lda fptr2
1442 DD52 AA tax
1443 DD53 18 clc
1444 DD54 69 06 adc #6
1445 DD56 85 FE sta fptr2
1446 DD58 A4 FF ldy fptr2+1
1447 DD5A 90 02 E6 FF scc:inc fptr2+1
1448 DD5E 20 98 DD jsr fld1r
1449
1450 ;add coefficient to acc
1451 DD61 20 66 DA jsr fadd
1452 DD64 B0 0D bcs xit
1453
1454 DD66 C6 EC dec _fpcocnt
1455 DD68 F0 09 beq xit
1456
1457 ;copy PLYARG -> FR1
1458 ;multiply accumulator by Z and continue
1459 DD6A A2 E0 ldx #<plyarg
1460 DD6C A0 05 ldy #>plyarg
1461 DD6E 20 D8 DA jsr fp_fld1r_fmul
1462 DD71 90 DD bcc loop
1463 DD73 xit:
1464 DD73 60 rts
1465 .endp
1466
1467 ;==========================================================================
1468 DD74 .proc fp_swap
1469 DD74 A2 05 ldx #5
1470 DD76 swaploop:
1471 DD76 B5 D4 lda fr0,x
1472 DD78 B4 E0 ldy fr1,x
1473 DD7A 95 E0 sta fr1,x
1474 DD7C 94 D4 sty fr0,x
1475 DD7E CA dex
1476 DD7F 10 F5 bpl swaploop
1477 DD81 60 rts
1478 .endp
1479
1480 ;==========================================================================
1481 ; FLD0R [DD89] Load FR0 from (X:Y)
1482 ; FLD0P [DD8D] Load FR0 from (FLPTR)
1483 ;
1484 DD82 fixadr $dd87
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($DD87-*),' bytes free before ',$DD87
2 $0005 bytes free before $DD87
3 DD82 org $DD87
Source: source/Shared/mathpack.s
1485 DD87 fld0r_zp:
1486 DD87 A0 00 ldy #0
1487 DD89 ckaddr $dd89
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1488 DD89 fld0r:
1489 DD89 86 FC stx flptr
1490 DD8B 84 FD sty flptr+1
1491 DD8D ckaddr $dd8d
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1492 DD8D fld0p:
1493 DD8D A0 05 ldy #5
1494 DD8F fld0ploop:
1495 DD8F B1 FC lda (flptr),y
1496 DD91 99 D4 00 sta fr0,y
1497 DD94 88 dey
1498 DD95 10 F8 bpl fld0ploop
1499 DD97 60 rts
1500
1501 ;==========================================================================
1502 ; FLD1R [DD98] Load FR1 from (X:Y)
1503 ; FLD1P [DD9C] Load FR1 from (FLPTR)
1504 ;
1505 DD98 fixadr $dd98
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1506 DD98 fld1r:
1507 DD98 86 FC stx flptr
1508 DD9A 84 FD sty flptr+1
1509 DD9C ckaddr $dd9c
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1510 DD9C fld1p:
1511 DD9C A0 05 ldy #5
1512 DD9E fld1ploop:
1513 DD9E B1 FC lda (flptr),y
1514 DDA0 99 E0 00 sta fr1,y
1515 DDA3 88 dey
1516 DDA4 10 F8 bpl fld1ploop
1517 DDA6 60 rts
1518
1519 ;==========================================================================
1520 ; FST0R [DDA7] Store FR0 to (X:Y)
1521 ; FST0P [DDAB] Store FR0 to (FLPTR)
1522 ;
1523 DDA7 fixadr $dda7
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1524 DDA7 fst0r:
1525 DDA7 86 FC stx flptr
1526 DDA9 84 FD sty flptr+1
1527 DDAB ckaddr $ddab
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1528 DDAB fst0p:
1529 DDAB A0 05 ldy #5
1530 DDAD fst0ploop:
1531 DDAD B9 D4 00 lda fr0,y
1532 DDB0 91 FC sta (flptr),y
1533 DDB2 88 dey
1534 DDB3 10 F8 bpl fst0ploop
1535 DDB5 60 rts
1536
1537 ;==========================================================================
1538 ; FMOVE [DDB6] Move FR0 to FR1
1539 ;
1540 DDB6 fixadr $ddb6
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1541 DDB6 fmove:
1542 DDB6 A2 05 ldx #5
1543 DDB8 fmoveloop:
1544 DDB8 B5 D4 lda fr0,x
1545 DDBA 95 E0 sta fr1,x
1546 DDBC CA dex
1547 DDBD 10 F9 bpl fmoveloop
1548 DDBF 60 rts
1549
1550 ;==========================================================================
1551 ; EXP [DDC0] Compute e^x
1552 ; EXP10 [DDCC] Compute 10^x
1553 ;
1554 DDC0 fixadr $ddc0
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1555 = DDCC exp10 = exp._exp10
1556 DDC0 .proc exp
1557 DDC0 A2 64 ldx #<fpconst_log10_e
1558 DDC2 A0 DE ldy #>fpconst_log10_e
1559 DDC4 20 98 DD jsr fld1r ;we could use fp_fld1r_fmul, but then we have a hole :(
1560 DDC7 20 DB DA jsr fmul
1561 DDCA B0 5B bcs err2
1562
1563 DDCC ckaddr $ddcc
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1564 DDCC _exp10:
1565 ;stash sign and compute abs
1566 DDCC A5 D4 lda fr0
1567 DDCE 85 EE sta _fptemp1
1568 DDD0 29 7F and #$7f
1569 DDD2 85 D4 sta fr0
1570
1571 DDD4 A0 00 ldy #0
1572
1573 ;check for |exp| >= 100 which would guarantee over/underflow
1574 DDD6 C9 40 cmp #$40
1575 DDD8 90 1E bcc abs_ok
1576 DDDA F0 08 beq abs_large
1577
1578 DDDC abs_too_big:
1579 ;okay, the |x| is too big... check if the original was negative.
1580 ;if so, zero and exit, otherwise error.
1581 DDDC A5 EE lda _fptemp1
1582 DDDE 10 47 bpl err2
1583 DDE0 18 clc
1584 DDE1 4C 44 DA jmp zfr0
1585
1586 DDE4 abs_large:
1587 ;|exp|>=1, so split it into integer/fraction
1588 DDE4 A5 D5 lda fr0+1
1589 DDE6 20 CD DA jsr fp_dectobin
1590 DDE9 79 F6 DF adc fp_dectobin_tab,y
1591 DDEC 48 pha
1592 DDED A9 00 lda #0
1593 DDEF 85 D5 sta fr0+1
1594 DDF1 85 DA sta fr0+6
1595 DDF3 20 00 DC jsr fp_normalize
1596 DDF6 68 pla
1597 DDF7 A8 tay
1598
1599 DDF8 abs_ok:
1600 ;stash integer portion of exponent
1601 DDF8 84 ED sty _fptemp0
1602
1603 ;compute approximation z = 10^y
1604 DDFA A2 28 ldx #<coeff
1605 DDFC A0 DE ldy #>coeff
1606 DDFE 20 3E DD jsr fp_plyevl_10
1607
1608 ;tweak exponent
1609 DE01 46 ED lsr _fptemp0
1610
1611 ;scale by 10 if necessary
1612 DE03 90 07 bcc even
1613 DE05 A2 1C ldx #<fpconst_ten
1614 DE07 20 D6 DA jsr fp_fld1r_const_fmul
1615 DE0A B0 D0 bcs abs_too_big
1616 DE0C even:
1617
1618 ;bias exponent
1619 DE0C A5 ED lda _fptemp0
1620 DE0E 65 D4 adc fr0
1621 DE10 C9 71 cmp #64+49
1622 DE12 B0 C8 bcs abs_too_big
1623 DE14 85 D4 sta fr0
1624
1625 ;check if we should invert
1626 DE16 26 EE rol _fptemp1
1627 DE18 90 0D bcc xit2
1628
1629 DE1A 20 B6 DD jsr fmove
1630 DE1D A2 EA ldx #<fp_one
1631 DE1F A0 DF ldy #>fp_one
1632 DE21 20 89 DD jsr fld0r
1633 DE24 4C 28 DB jmp fdiv
1634
1635 DE27 err2:
1636 DE27 xit2:
1637 DE27 60 rts
1638
1639 DE28 coeff: ;Minimax polynomial for 10^x over 0 <= x < 1
1640 DE28 3F 01 46 90 83 08 .fl 0.0146908308
1641 DE2E BE 20 05 33 11 71 .fl -0.002005331171
1642 DE34 3F 09 19 45 20 45 .fl 0.0919452045
1643 DE3A 3F 19 21 38 38 84 .fl 0.1921383884
1644 DE40 3F 54 47 32 51 97 .fl 0.5447325197
1645 DE46 40 01 17 01 82 49 .fl 1.17018250
1646 DE4C 40 02 03 47 85 80 .fl 2.03478581
1647 DE52 40 02 65 09 44 94 .fl 2.65094494
1648 DE58 40 02 30 25 85 11 .fl 2.30258512
1649 DE5E 40 01 00 00 00 00 .fl 1
1650 .endp
1651
1652 ;==========================================================================
1653 DE64 fpconst_log10_e:
1654 DE64 3F 43 42 94 48 18 .fl 0.43429448190325182765112891891661
1655
1656 DE6A .proc fp_carry_expup
1657 ;adjust exponent
1658 DE6A E6 D4 inc fr0
1659
1660 ;shift down FR0
1661 DE6C A2 04 ldx #4
1662 DE6E sum_shiftloop:
1663 DE6E B5 D4 lda fr0,x
1664 DE70 95 D5 sta fr0+1,x
1665 DE72 CA dex
1666 DE73 D0 F9 bne sum_shiftloop
1667
1668 ;add a $01 at the top
1669 DE75 E8 inx
1670 DE76 86 D5 stx fr0+1
1671 DE78 60 rts
1672 .endp
1673
1674 ;==========================================================================
1675 DE79 .proc fp_fmul_fr0_to_binfr2 ;$15 bytes
1676 DE79 A2 04 ldx #4
1677 DE7B loop:
1678 DE7B B5 D5 lda fr0+1,x
1679 DE7D 4A lsr
1680 DE7E 4A lsr
1681 DE7F 4A lsr
1682 DE80 4A lsr
1683 DE81 A8 tay
1684 DE82 18 clc
1685 DE83 B5 D5 lda fr0+1,x
1686 DE85 79 F6 DF adc fp_dectobin_tab,y
1687 DE88 49 FF eor #$ff
1688 DE8A 95 E7 sta fr2+1,x
1689 DE8C CA dex
1690 DE8D 10 EC bpl loop
1691 = DE8F .def :fp_rts1
1692 DE8F 60 rts
1693 .endp
1694
1695 ;==========================================================================
1696 ; REDRNG [DE95] Reduce range via y = (x-C)/(x+C) (undocumented)
1697 ;
1698 ; X:Y = pointer to C argument
1699 ;
1700 DE90 fixadr $de95
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($DE95-*),' bytes free before ',$DE95
2 $0005 bytes free before $DE95
3 DE90 org $DE95
Source: source/Shared/mathpack.s
1701 = DE95 redrng = _redrng
1702 DE95 .proc _redrng
1703 DE95 86 FE stx fptr2
1704 DE97 84 FF sty fptr2+1
1705 DE99 20 98 DD jsr fld1r
1706 DE9C A2 E6 ldx #<fpscr
1707 DE9E A0 05 ldy #>fpscr
1708 DEA0 20 A7 DD jsr fst0r
1709 DEA3 20 66 DA jsr fadd
1710 DEA6 B0 E7 bcs fail
1711 DEA8 A2 E0 ldx #<plyarg
1712 DEAA A0 05 ldy #>plyarg
1713 DEAC 20 A7 DD jsr fst0r
1714 DEAF A2 E6 ldx #<fpscr
1715 DEB1 A0 05 ldy #>fpscr
1716 DEB3 20 89 DD jsr fld0r
1717 DEB6 A6 FE ldx fptr2
1718 DEB8 A4 FF ldy fptr2+1
1719 DEBA 20 98 DD jsr fld1r
1720 DEBD 20 60 DA jsr fsub
1721 DEC0 B0 CD bcs fail
1722 DEC2 A2 E0 ldx #<plyarg
1723 DEC4 A0 05 ldy #>plyarg
1724 DEC6 20 98 DD jsr fld1r
1725 DEC9 4C 28 DB jmp fdiv
1726
1727 = DE8F fail = fp_rts1
1728 .endp
1729
1730 ;==========================================================================
1731 ; LOG [DECD] Compute ln x
1732 ; LOG10 [DED1] Compute log10 x
1733 ;
1734 DECC fixadr $decd
Macro: FIXADR [Source: source/Shared/mathpack.s]
2 .print ($DECD-*),' bytes free before ',$DECD
2 $0001 bytes free before $DECD
3 DECC org $DECD
Source: source/Shared/mathpack.s
1735 = DED1 log10 = log._log10
1736 DECD .proc log
1737 DECD 46 EE lsr _fptemp1
1738 DECF 10 03 bpl entry
1739 DED1 ckaddr $ded1
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1740 DED1 _log10:
1741 DED1 38 sec
1742 DED2 66 EE ror _fptemp1
1743 DED4 entry:
1744 ;throw error on negative number
1745 DED4 A5 D4 lda fr0
1746 DED6 30 6E bmi err
1747
1748 ;stash exponentx2 - 128
1749 DED8 0A asl
1750 DED9 49 80 eor #$80
1751 DEDB 85 ED sta _fptemp0
1752
1753 ;raise error if argument is zero
1754 DEDD A5 D5 lda fr0+1
1755 DEDF F0 65 beq err
1756
1757 ;reset exponent so we are in 1 <= z < 100
1758 DEE1 A2 40 ldx #$40
1759 DEE3 86 D4 stx fr0
1760
1761 ;split into three ranges based on mantissa:
1762 ; 1/sqrt(10) <= x < 1: [31, 99] divide by 100
1763 ; sqrt(10)/100 <= x < 1/sqrt(10): [ 3, 30] divide by 10
1764 ; 0 < x < sqrt(10)/100: [ 1, 2] leave as-is
1765
1766 DEE5 C9 03 cmp #$03
1767 DEE7 90 13 bcc post_range_adjust
1768 DEE9 C9 31 cmp #$31
1769 DEEB 90 04 bcc mid_range
1770
1771 ;increase result by 1 (equivalent to *10 input)
1772 DEED E6 ED inc _fptemp0
1773 DEEF D0 07 bne adjust_exponent
1774
1775 DEF1 mid_range:
1776 ;multiply by 10
1777 DEF1 A2 1C ldx #<fpconst_ten
1778 DEF3 20 D6 DA jsr fp_fld1r_const_fmul
1779 DEF6 B0 4F bcs err2
1780
1781 DEF8 adjust_exponent:
1782 ;increase result by 1 (equivalent to *10 input)
1783 DEF8 E6 ED inc _fptemp0
1784
1785 ;divide fraction by 100
1786 DEFA C6 D4 dec fr0
1787
1788 DEFC post_range_adjust:
1789 ;at this point, we have 0.30 <= z <= 3; apply y = (z-1)/(z+1) transform
1790 ;so we can use a faster converging series... this reduces y to
1791 ;0 <= y < 0.81
1792 DEFC A2 EA ldx #<fp_one
1793 DEFE A0 DF ldy #>fp_one
1794 DF00 20 95 DE jsr redrng
1795
1796 ;stash y so we can later multiply it back in
1797 DF03 A2 E6 ldx #<fpscr
1798 DF05 A0 05 ldy #>fpscr
1799 DF07 20 A7 DD jsr fst0r
1800
1801 ;square the value so we compute a series on y^2n
1802 DF0A 20 B6 DD jsr fmove
1803 DF0D 20 DB DA jsr fmul
1804
1805 ;do polynomial expansion
1806 DF10 A2 72 ldx #<fpconst_log10coeff
1807 DF12 A0 DF ldy #>fpconst_log10coeff
1808 DF14 20 3E DD jsr fp_plyevl_10
1809 DF17 B0 2E bcs err2
1810
1811 ;multiply back in so we have series on y^(2n+1)
1812 DF19 A2 E6 ldx #<fpscr
1813 DF1B A0 05 ldy #>fpscr
1814 DF1D 20 D8 DA jsr fp_fld1r_fmul
1815
1816 ;stash
1817 DF20 20 B6 DD jsr fmove
1818
1819 ;convert exponent adjustment back to float (signed)
1820 DF23 A9 00 lda #0
1821 DF25 85 D5 sta fr0+1
1822 DF27 A6 ED ldx _fptemp0
1823 DF29 10 04 bpl expadj_positive
1824 DF2B 38 sec
1825 DF2C E5 ED sbc _fptemp0
1826 DF2E AA tax
1827 DF2F expadj_positive:
1828 DF2F 86 D4 stx fr0
1829 DF31 20 AA D9 jsr ipf
1830
1831 ;merge (cannot fail)
1832 DF34 06 D4 asl fr0
1833 DF36 06 ED asl _fptemp0
1834 DF38 66 D4 ror fr0
1835 DF3A 20 66 DA jsr fadd
1836
1837 ;scale if doing log
1838 DF3D 24 EE bit _fptemp1
1839 DF3F 30 06 bmi xit2
1840
1841 DF41 A2 22 ldx #<fpconst_ln10
1842 DF43 4C D6 DA jmp fp_fld1r_const_fmul
1843
1844 DF46 err:
1845 DF46 38 sec
1846 DF47 xit2:
1847 DF47 err2:
1848 DF47 60 rts
1849 .endp
1850
1851 ;==========================================================================
1852 DF48 .proc fp_tab_lo_1000
1853 DF48 00 E8 D0 B8 A0 88 + :10 dta <[1000*#]
1854 .endp
1855
1856 DF52 .proc fp_tab_hi_1000
1857 DF52 00 03 07 0B 0F 13 + :10 dta >[1000*#]
1858 .endp
1859
1860 DF5C .proc fp_tab_hi_100
1861 DF5C 00 00 00 01 01 01 + :10 dta >[100*#]
1862 .endp
1863
1864 DF66 .proc fp_tab_hi_10000
1865 DF66 27 4E 75 9C C3 EA :6 dta >[10000*[#+1]]
1866 .endp
1867
1868 ;==========================================================================
1869 ; HALF (used by Atari BASIC)
1870 ;
1871 DF6C fixadr $df6c
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1872 DF6C fpconst_half:
1873 DF6C 3F 50 00 00 00 00 .fl 0.5
1874
1875 ;==========================================================================
1876 ; log10(x) coefficients
1877 ;
1878 ; LOG10 computes:
1879 ; -0.30 <= z <= 3.0
1880 ; y = (z-1)/(z+1) -0.54 <= y <= 0.5
1881 ; x = y^2 0 <= x <= 0.29
1882 ; log10(z) = f(x)*y
1883 ;
1884 ; Therefore:
1885 ; f(x) = log10((1+y)/(1-y))/y
1886 ;
1887 DF72 fpconst_log10coeff: ;Maclaurin series expansion for log10((z-1)/(z+1))
1888 DF72 3F 20 26 22 71 53 .fl 0.2026227154
1889 DF78 BF 07 32 04 49 21 .fl -0.0732044921
1890 DF7E 3F 10 60 98 35 64 .fl 0.1060983564
1891 DF84 3F 05 60 41 73 29 .fl 0.0560417329
1892 DF8A 3F 08 04 18 84 06 .fl 0.0804188407
1893 DF90 3F 09 63 91 60 14 .fl 0.0963916015
1894 DF96 3F 12 40 89 61 35 .fl 0.1240896135
1895 DF9C 3F 17 37 17 66 45 .fl 0.1737176646
1896 DFA2 3F 28 95 29 65 58 .fl 0.2895296558
1897 DFA8 3F 86 85 88 96 37 .fl 0.8685889638
1898
1899 ;==========================================================================
1900 ; Arctangent coefficients
1901 ;
1902 ; The 11 coefficients here form a power series approximation
1903 ; f(x^2) ~= atn(x)/x. This is not an official feature of the math pack but
1904 ; is relied upon by BASIC.
1905 ;
1906 ; We used to use the coefficients from Abramowitz & Stegun 4.4.49 here, but
1907 ; there seems to be an error there such that the result falls far short
1908 ; of the specified 2x10^-8 accuracy over 0<=x<=1 at x=1. Instead, we now
1909 ; use a custom minimax polynomial for f(y)=atn(sqrt(y))/sqrt(y) where y=x^2.
1910 ;
1911 DFAE fixadr $dfae
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1912 DFAE atncoef: ;coefficients for atn(x)/x ~= f(x^2)
1913 ;see Abramowitz & Stegun 4.4.49
1914
1915 DFAE 3E 11 12 07 58 81 .fl 0.001112075881 ;x**10*1.11207588057982e-3
1916 DFB4 BE 73 04 08 75 20 .fl -0.007304087520 ;x**9*-7.30408751951452e-3
1917 DFBA 3F 02 24 96 55 73 .fl 0.0224965573 ;x**8*2.24965572957342e-2
1918 DFC0 BF 04 46 18 51 71 .fl -0.0446185172 ;x**7*-4.46185172165888e-2
1919 DFC6 3F 06 73 46 32 44 .fl 0.0673463245 ;x**6*6.73463245104305e-2
1920 DFCC BF 08 80 69 06 64 .fl -0.0880690664 ;x**5*-8.80690663570546e-2
1921 DFD2 3F 11 05 66 74 99 .fl 0.1105667499 ;x**4*1.10566749879313e-1
1922 DFD8 BF 14 27 94 93 12 .fl -0.1427949312 ;x**3*-1.42794931245212e-1
1923 DFDE 3F 19 99 96 30 60 .fl 0.1999963060 ;x**2*1.99996306023439e-1
1924 DFE4 BF 33 33 33 24 72 .fl -0.3333332472 ;x**1*-3.33333247188074e-1
1925 ;x**0*9.99999999667198e-1
1926 DFEA fp_one:
1927 DFEA 40 01 00 00 00 00 .fl 1.0 ;also an arctan coeff
1928 DFF0 fixadr $dff0
Macro: FIXADR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
1929 DFF0 fp_pi4: ;pi/4 - needed by Atari Basic ATN()
1930 DFF0 3F 78 53 98 16 34 .fl 0.78539816339744830961566084581988
1931
1932 DFF6 fp_dectobin_tab:
1933 DFF6 00 FA F4 EE E8 E2 + :10 dta <[-6*#]
1934
1935 E000 ckaddr $e000
Macro: CKADDR [Source: source/Shared/mathpack.s]
Source: source/Shared/mathpack.s
102
103 E000 org $e000
104 E000 icl 'atarifont.inc'
Source: source/Shared/atarifont.inc
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Character Font
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 E000 00 00 00 00 00 00 + ins 'atarifont.bin',$0,$400
105
106 E400 org $e400
107 E400 E9 F9 editrv dta a(EditorOpen-1)
108 E402 C8 E4 dta a(EditorClose-1)
109 E404 F5 F9 dta a(EditorGetByte-1)
110 E406 A7 FA dta a(EditorPutByte-1)
111 E408 C8 E4 dta a(EditorGetStatus-1)
112 E40A CA E4 dta a(EditorSpecial-1)
113 E40C 4C CB E4 jmp EditorInit
114 E40F 00 dta $00
115
116 E410 F5 F3 screnv dta a(ScreenOpen-1)
117 E412 C8 E4 dta a(ScreenClose-1)
118 E414 9E F5 dta a(ScreenGetByte-1)
119 E416 DE F5 dta a(ScreenPutByte-1)
120 E418 C8 E4 dta a(ScreenGetStatus-1)
121 E41A C2 F6 dta a(ScreenSpecial-1)
122 E41C 20 91 F5 jsr ScreenInit
123 E41F 00 dta $00
124
125 E420 C8 E4 keybdv dta a(KeyboardOpen-1)
126 E422 C8 E4 dta a(KeyboardClose-1)
127 E424 65 FE dta a(KeyboardGetByte-1)
128 E426 CA E4 dta a(KeyboardPutByte-1)
129 E428 C8 E4 dta a(KeyboardGetStatus-1)
130 E42A CA E4 dta a(KeyboardSpecial-1)
131 E42C 4C 4B FE jmp KeyboardInit
132 E42F 00 dta $00
133
134 E430 C5 ED printv dta a(PrinterOpen-1)
135 E432 DA ED dta a(PrinterClose-1)
136 E434 CA E4 dta a(PrinterGetByte-1)
137 E436 E1 ED dta a(PrinterPutByte-1)
138 E438 2F EE dta a(PrinterGetStatus-1)
139 E43A CA E4 dta a(PrinterSpecial-1)
140 E43C 20 C0 ED jsr PrinterInit
141 E43F 00 dta $00
142
143 E440 5B EE casetv dta a(CassetteOpen-1)
144 E442 B0 EE dta a(CassetteClose-1)
145 E444 D1 EE dta a(CassetteGetByte-1)
146 E446 11 EF dta a(CassettePutByte-1)
147 E448 C8 E4 dta a(CassetteGetStatus-1)
148 E44A CA E4 dta a(CassetteSpecial-1)
149 E44C 4C 51 EE jmp CassetteInit
150 E44F 00 dta $00
151
152 ;vector table
153 E450 org $e450
154 E450 4C 60 ED diskiv jmp DiskInit ;$E450
155 E453 4C 61 ED dskinv jmp DiskHandler ;$E453
156 E456 4C FC E4 ciov jmp CIO ;$E456
157 E459 4C 50 E9 siov jmp SIO ;$E459
158 E45C 4C 69 E8 setvbv jmp VBISetVector ;$E45C
159 E45F 4C 1D E7 sysvbv jmp VBIStage1 ;$E45F
160 E462 4C 61 E7 xitvbv jmp VBIExit ;$E462
161 E465 4C 45 E9 sioinv jmp SIOInit ;$E465
162 E468 4C 99 EA sendev jmp SIOSendEnable ;$E468
163 E46B 4C 7F E8 intinv jmp IntInitInterrupts ;$E46B
164 E46E 4C EA E4 cioinv jmp CIOInit ;$E46E
165
166 .if _KERNEL_XLXE
167 blkbdv jmp SelfTestEntry ;$E471
168 .else
169 E471 4C 80 E4 blkbdv jmp Blackboard ;$E471
170 .endif
171
172 E474 4C 49 F0 warmsv jmp InitWarmStart ;$E474
173 E477 4C FD EF coldsv jmp InitColdStart ;$E477
174 E47A 4C 52 EF rblokv jmp CassetteReadBlock ;$E47A
175 E47D 4C 6F EE csopiv jmp CassetteOpenRead ;$E47D
176
177 .if _KERNEL_XLXE
178 pupdiv jmp SelfTestEntry ;$E480 XL/XE: power-up display
179 slftsv jmp $5000 ;$E483 XL/XE: self-test entry
180 pentv jmp PHAddHandler ;$E486 XL/XE: peripheral handler add
181 phunlv jmp PHRemoveHandler ;$E489 XL/XE: peripheral handler remove
182 phiniv jmp PHInitHandler ;$E48C XL/XE: peripheral handler init
183 gpdvv PBI_VECTOR_TABLE ;$E48F XL/XE: Generic device vector
184 .endif
185
186 .if _KERNEL_XLXE
187 icl 'selftestentry.s'
188 .else
189 E480 icl 'blackboard.s'
Source: source/Shared/blackboard.s
1 ; Altirra - Atari 800/800XL emulator
2 ; Kernel ROM replacement - Blackboard
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 E480 .proc Blackboard
11 ;print banner
12 E480 A9 A6 8D 44 03 mva #<blackboard_banner icbal
13 E485 A9 E4 8D 45 03 mva #>blackboard_banner icbah
14 E48A 8D 48 03 sta icbll
15 E48D A2 00 ldx #0
16 E48F 8E 49 03 stx icblh
17 E492 A9 09 lda #CIOCmdPutRecord
18 E494 echoloop:
19 E494 8D 42 03 sta iccmd
20 E497 20 56 E4 jsr ciov
21
22 E49A 8E 48 03 stx icbll
23 E49D A9 07 lda #CIOCmdGetChars
24 E49F D0 F3 bne echoloop
25 .endp
26
27 .if *>$e480 && *<$e4c0
28 ;anchor version for emulator purposes
29 E4A1 org $e4a6
30 .endif
31 E4A6 blackboard_banner:
32 E4A6 41 6C 74 69 72 72 + dta 'AltirraOS '
33 E4B0 _KERNELSTR_VERSION
Macro: _KERNELSTR_VERSION [Source: source/Shared/version.inc]
1 E4B0 33 2E 32 36 dta '3.26'
Source: source/Shared/blackboard.s
34 E4B4 20 6D 65 6D 6F 20 + dta ' memo pad',$9B
190 .endif
191
192 ;==============================================================================
193 ; $E4C0 Known RTS instruction
194 ;
195 ; The Atari 850 handler uses this as a "known RTS" instruction, as does
196 ; Altirra's internal R: handler emulation.
197 ;
198 E4BE org $e4c0
199
200 E4C0 .nowarn .proc KnownRTS
201 E4C0 60 rts
202 .endp
203
204 ;==============================================================================
205 ; Main modules.
206 ;
207 ; We report the sizes here as well as reference sizes. The reference sizes for
208 ; OS-B come from Mapping the Atari.
209 ;
210
211 .echo 'Module sizes:'
211 Module sizes:
212
213 .macro _KERNEL_REPORT_MODULE_MARK
214 .def ?@_kernel_lastpt = *
215 .endm
216
217 .macro _KERNEL_REPORT_MODULE_PAD_ADJUST
218 .def ?@_kernel_lastpt = ?@_kernel_lastpt + :1
219 .endm
220
221 .macro _KERNEL_REPORT_MODULE_SIZE
222 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', :2, ')', ' ', :1
223
224 .def ?@_kernel_lastpt = *
225 .endm
226
227 E4C1 icl 'misc.s'
Source: source/Shared/misc.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Miscellaneous data
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 ;Used by PBI and display/editor.
12 ;
13 E4C1 .proc ReversedBitMasks
14 E4C1 80 40 20 10 08 04 + dta $80,$40,$20,$10,$08,$04,$02,$01
15 .endp
16
17 ;==========================================================================
18 ;Used by CIO devices
19 E4C9 .proc CIOExitSuccess
20 E4C9 A0 01 ldy #1
21 E4CB exit_not_supported:
22 E4CB 60 rts
23 .endp
24
25 = E4CB CIOExitNotSupported = CIOExitSuccess.exit_not_supported
26
27 ;==========================================================================
28 ; Sound a bell using the console speaker.
29 ;
30 ; Entry:
31 ; Y = duration
32 ;
33 ; Modified:
34 ; X
35 ;
36 ; Preserved:
37 ; A
38 ;
39 E4CC .proc Bell
40 E4CC 48 pha
41 E4CD A9 08 lda #$08
42 E4CF soundloop:
43 E4CF A2 04 ldx #4
44 E4D1 48 pha
45 E4D2 delay:
46 E4D2 AD 0B D4 lda vcount
47 E4D5 CD 0B D4 F0 FB cmp:req vcount
48 E4DA CA dex
49 E4DB D0 F5 bne delay
50 E4DD 68 pla
51 E4DE 49 08 eor #$08
52 E4E0 8D 1F D0 sta consol
53 E4E3 D0 EA bne soundloop
54 E4E5 88 dey
55 E4E6 D0 E7 bne soundloop
56 E4E8 68 pla
57 E4E9 60 rts
58 .endp
228 E4EA _KERNEL_REPORT_MODULE_MARK
Macro: _KERNEL_REPORT_MODULE_MARK [Source: source/main.xasm]
1 = E4EA .def ?@_kernel_lastpt = *
Source: source/main.xasm
229
230 E4EA icl 'cio.inc'
Source: source/Shared/cio.inc
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Character Input/Output Definitions
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 .ifndef f_CIO_INC
11 .def f_CIO_INC
12
13 CIOStatBreak = $80 ;break key abort
14 CIOStatIOCBInUse = $81 ;IOCB in use
15 CIOStatUnkDevice = $82 ;unknown device
16 CIOStatWriteOnly = $83 ;opened for write only
17 CIOStatInvalidCmd = $84 ;invalid command
18 CIOStatNotOpen = $85 ;device or file not open
19 CIOStatInvalidIOCB = $86 ;invalid IOCB number
20 CIOStatReadOnly = $87 ;opened for read only
21 CIOStatEndOfFile = $88 ;end of file reached
22 CIOStatTruncRecord = $89 ;record truncated
23 CIOStatTimeout = $8A ;device timeout
24 CIOStatNAK = $8B ;device NAK
25 CIOStatSerFrameErr = $8C ;serial bus framing error
26 CIOStatCursorRange = $8D ;cursor out of range
27 CIOStatSerOverrun = $8E ;serial frame overrun error
28 CIOStatSerChecksum = $8F ;serial checksum error
29 CIOStatDeviceDone = $90 ;device done error
30 CIOStatBadScrnMode = $91 ;bad screen mode
31 CIOStatNotSupported = $92 ;function not supported by handler
32 CIOStatOutOfMemory = $93 ;not enough memory
33 CIOStatDriveNumErr = $A0 ;disk drive # error
34 CIOStatTooManyFiles = $A1 ;too many open disk files
35 CIOStatDiskFull = $A2 ;disk full
36 CIOStatFatalDiskIO = $A3 ;fatal disk I/O error
37 CIOStatFileNumDiff = $A4 ;internal file # mismatch
38 CIOStatFileNameErr = $A5 ;filename error
39 CIOStatPointDLen = $A6 ;point data length error
40 CIOStatFileLocked = $A7 ;file locked
41 CIOStatInvDiskCmd = $A8 ;invalid command for disk
42 CIOStatDirFull = $A9 ;directory full (64 files)
43 CIOStatFileNotFound = $AA ;file not found
44 CIOStatInvPoint = $AB ;invalid point
45
46 CIOCmdOpen = $03
47 CIOCmdGetRecord = $05
48 CIOCmdGetChars = $07
49 CIOCmdPutRecord = $09
50 ; $0A ;PUT CHARS alias (required by K-Razy Shoot Out)
51 CIOCmdPutChars = $0B
52 CIOCmdClose = $0C
53 CIOCmdGetStatus = $0D
54 CIOCmdSpecial = $0E ;$0E and up is escape
55
56 .endif
231
232 .ifdef _KERNEL_816
233 icl 'cio816.s'
234 .else
235 E4EA icl 'cio.s'
Source: source/Shared/cio.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Character Input/Output Facility
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 E4EA .proc CIOInit
11 E4EA 38 sec
12 E4EB A2 70 ldx #$70
13 E4ED iocb_loop:
14 E4ED A9 FF lda #$ff
15 E4EF 9D 40 03 sta ichid,x
16 E4F2 20 01 E7 jsr CIOSetPutByteClosed
17 E4F5 8A txa
18 E4F6 E9 10 sbc #$10
19 E4F8 AA tax
20 E4F9 10 F2 bpl iocb_loop
21 E4FB 60 rts
22 .endp
23
24 ;==============================================================================
25 ; Character I/O entry vector
26 ;
27 ; On entry:
28 ; X = IOCB offset (# x 16)
29 ;
30 ; Returns:
31 ; A = depends on operation
32 ; X = IOCB offset (# x 16)
33 ; Y = status (reflected in P)
34 ;
35 ; Notes:
36 ; BUFADR must not be touched from CIO. DOS XE relies on this for
37 ; temporary storage and breaks if it is modified.
38 ;
39 ; XL/XE mode notes:
40 ; HNDLOD is always set to $00 afterward, per Sweet 16 supplement 3.
41 ;
42 ; CIO can optionally attempt a provisional open by doing a type 4 poll
43 ; over the SIO bus. This happens unconditionally if HNDLOD is non-zero
44 ; and only after the device is not found in HATABS if HNDLOD is zero.
45 ; If this succeeds, the IOCB is provisionally opened. Type 4 polling
46 ; ONLY happens for direct opens -- it does not happen for a soft open.
47 ;
48 E4FC .proc CIO
49 ;stash IOCB offset (X) and acc (A)
50 E4FC 85 2F sta ciochr
51 E4FE 86 2E stx icidno
52 E500 20 0E E5 jsr process
53 E503 xit:
54 ;copy status back to IOCB
55 E503 A6 2E ldx icidno
56 E505 98 tya
57 E506 9D 43 03 sta icsta,x
58 E509 08 php
59
60 .if _KERNEL_XLXE
61 mva #0 hndlod
62 .endif
63
64 E50A A5 2F lda ciochr
65 E50C 28 plp
66 E50D 60 rts
67
68 E50E process:
69 ;validate IOCB offset
70 E50E 8A txa
71 E50F 29 8F and #$8f
72 E511 F0 06 beq validIOCB
73
74 ;return invalid IOCB error
75 E513 A0 86 ldy #CIOStatInvalidIOCB
76 E515 60 rts
77
78 E516 cmdInvalid:
79 ;invalid command <$03
80 E516 A0 84 ldy #CIOStatInvalidCmd
81 E518 60 rts
82
83 E519 validIOCB:
84 E519 20 D1 E6 jsr CIOLoadZIOCB
85
86 ;check if we're handling the OPEN command
87 E51C A5 22 lda iccomz
88 E51E C9 03 cmp #CIOCmdOpen
89 E520 F0 66 beq cmdOpen
90 E522 90 F2 bcc cmdInvalid
91
92 ;check if the IOCB is open
93 E524 A4 20 ldy ichidz
94
95 .if !_KERNEL_XLXE
96 E526 10 1C bpl isOpen
97 .else
98 bmi not_open
99
100 ;check for a provisionally open IOCB
101 iny
102 bpl isOpen
103
104 ;okay, it's provisionally open... check if it's a close
105 cmp #CIOCmdClose
106 sne:jmp cmdCloseProvisional
107
108 ;check if we're allowed to load a handler
109 lda hndlod
110 beq not_open
111
112 ;try to load the handler
113 jsr CIOLoadHandler
114 bpl isOpen
115 rts
116 .endif
117
118 E528 not_open:
119 ;IOCB isn't open - issue error
120 ;
121 ;Special cases;
122 ; - No error issued for close ($0C). This is needed so that extra CLOSE
123 ; commands from BASIC don't trip errors.
124 ; - Get status ($0D) and special ($0E+) do soft open and close if needed.
125 ; $0D case is required for Top Dos 1.5a to boot; $0E+ case is encountered
126 ; with R: device XIO commands.
127 ;
128 E528 A0 01 ldy #1
129 E52A A5 22 lda iccomz
130 E52C C9 0C cmp #CIOCmdClose
131 E52E F0 06 beq ignoreOpen
132 E530 C9 0D cmp #CIOCmdGetStatus
133 E532 B0 03 bcs preOpen ;closed IOCB is OK for get status and special
134 E534 not_open_handler:
135 E534 A0 85 ldy #CIOStatNotOpen
136 E536 ignoreOpen:
137 E536 60 rts
138
139 E537 preOpen:
140 ;If the device is not open when a SPECIAL command is issued, parse the path
141 ;and soft-open the device in the zero page IOCB.
142 E537 20 E0 E6 jsr CIOParsePath
143
144 ;check for special command
145 E53A A5 22 lda iccomz
146 E53C C9 0D cmp #CIOCmdGetStatus
147 E53E F0 40 beq cmdGetStatusSoftOpen
148 E540 C9 0E cmp #CIOCmdSpecial
149 E542 B0 3F bcs cmdSpecialSoftOpen
150
151 E544 isOpen:
152 E544 A6 22 ldx iccomz
153 E546 E0 0E cpx #CIOCmdSpecial
154 E548 90 02 A2 0E scc:ldx #$0e
155
156 ;do permissions check
157 E54C BD 8F E6 lda perm_check_table-4,x
158 E54F 30 04 bmi skip_perm_check
159 E551 24 2A bit icax1z
160 E553 F0 26 beq perm_check_fail
161 E555 skip_perm_check:
162
163 ;load command table vector
164 E555 BD B0 E6 lda command_table_hi-4,x
165 E558 48 pha
166 E559 BD A5 E6 lda command_table_lo-4,x
167 E55C 48 pha
168
169 ;preload dispatch vector and dispatch to command
170 E55D BC 9A E6 ldy vector_preload_table-4,x
171 E560 load_vector:
172 E560 A6 20 ldx ichidz
173 E562 BD 1B 03 85 2C BD + mwa hatabs+1,x icax3z
174 E56C B1 2C lda (icax3z),y
175 E56E AA tax
176 E56F 88 dey
177 E570 B1 2C lda (icax3z),y
178 E572 85 2C sta icax3z
179 E574 86 2D stx icax3z+1
180
181 ;many commands want to check length=0 on entry
182 E576 A5 28 lda icbllz
183 E578 05 29 ora icblhz
184 E57A 60 rts
185
186 E57B perm_check_fail:
187 ;at this point we have A=$04 if we failed a get perm check, and A=$08
188 ;if we failed a put perm check -- these need to be translated to Y=$83
189 ;and Y=$87.
190 E57B 18 clc
191 E57C 69 7F adc #$7f
192 E57E A8 tay
193 E57F 60 rts
194
195 ;--------------------------------------------------------------------------
196 E580 cmdGetStatusSoftOpen:
197 E580 A0 09 ldy #9
198 E582 2C dta {bit $0100}
199 E583 cmdSpecialSoftOpen:
200 E583 A0 0B ldy #11
201 E585 invoke_and_soft_close_xit:
202 E585 4C BF E6 jmp CIOInvoke
203
204 ;--------------------------------------------------------------------------
205 ; Open command ($03).
206 ;
207 E588 cmdOpen:
208 ;check if the IOCB is already open
209 E588 A4 20 ldy ichidz
210 E58A C8 iny
211 E58B F0 03 beq notAlreadyOpen
212
213 ;IOCB is already open - error
214 E58D A0 81 ldy #CIOStatIOCBInUse
215 E58F 60 rts
216
217 E590 notAlreadyOpen:
218 ;attempt to parse and open -- note that this will fail out directly
219 ;on an unknown device or provisional open
220 E590 20 E0 E6 jsr CIOParsePath
221
222 E593 open_entry:
223 ;request open
224 E593 A0 01 ldy #1
225 E595 20 BF E6 jsr CIOInvoke
226
227 ;move handler ID and device number to IOCB
228 E598 A6 2E ldx icidno
229 E59A A5 20 9D 40 03 mva ichidz ichid,x
230 E59F A5 21 9D 41 03 mva icdnoz icdno,x
231
232 E5A4 98 tya
233 E5A5 10 01 bpl openOK
234 E5A7 60 rts
235
236 E5A8 openOK:
237
238 ;copy PUT BYTE vector for Atari Basic
239 E5A8 A6 20 ldx ichidz
240 E5AA BD 1B 03 85 2C BD + mwa hatabs+1,x icax3z
241 E5B4 A0 06 ldy #6
242 E5B6 B1 2C lda (icax3z),y
243 E5B8 A6 2E ldx icidno
244 E5BA 9D 46 03 sta icptl,x
245 E5BD C8 iny
246 E5BE B1 2C lda (icax3z),y
247 E5C0 9D 47 03 sta icpth,x
248 E5C3 A0 01 ldy #1
249 E5C5 60 rts
250
251 = E6C2 cmdGetStatus = CIOInvoke.invoke_vector
252 E5C6 cmdSpecial:
253 E5C6 20 C2 E6 jsr CIOInvoke.invoke_vector
254
255 ;need to copy AUX1/2 back for R:
256 E5C9 A6 2E ldx icidno
257 E5CB A5 2A 9D 4A 03 mva icax1z icax1,x
258 E5D0 A5 2B 9D 4B 03 mva icax2z icax2,x
259 E5D5 60 rts
260
261 ;--------------------------------------------------------------------------
262 E5D6 cmdGetRecord:
263 ;check if buffer is full on entry
264 E5D6 F0 16 beq cmdGetRecordBufferFull
265 E5D8 cmdGetRecordLoop:
266 E5D8 cmdGetRecordGetByte:
267 ;fetch byte
268 E5D8 20 C2 E6 jsr CIOInvoke.invoke_vector
269 E5DB C0 00 cpy #0
270 E5DD 30 1C bmi cmdGetRecordXit
271
272 ;store byte (even if EOL)
273 E5DF A2 00 ldx #0
274 E5E1 81 24 sta (icbalz,x)
275
276 ;check for EOL
277 E5E3 49 9B eor #$9b
278 E5E5 C9 01 cmp #1
279
280 ;increment buffer pointer and decrement length
281 E5E7 20 72 E6 jsr advance_pointers
282
283 ;skip buffer full check if we had an EOL
284 E5EA 90 0F bcc cmdGetRecordXit
285
286 ;loop back for more bytes if buffer not full
287 E5EC D0 EA bne cmdGetRecordLoop
288
289 E5EE cmdGetRecordBufferFull:
290 ;read byte to discard
291 E5EE 20 C2 E6 jsr CIOInvoke.invoke_vector
292 E5F1 C0 00 cpy #0
293 E5F3 30 06 bmi cmdGetRecordXit
294
295 ;continue if not EOL
296 E5F5 C9 9B cmp #$9b
297 E5F7 D0 F5 bne cmdGetRecordBufferFull
298
299 ;return truncated record
300 E5F9 A0 89 ldy #CIOStatTruncRecord
301
302 E5FB cmdGetRecordXit:
303 E5FB cmdGetPutDone:
304 ;update byte count in IOCB
305 E5FB A6 2E ldx icidno
306 E5FD 38 sec
307 E5FE BD 48 03 lda icbll,x
308 E601 E5 28 sbc icbllz
309 E603 85 28 sta icbllz ;required by Lightspeed DOS
310 E605 9D 48 03 sta icbll,x
311 E608 BD 49 03 lda icblh,x
312 E60B E5 29 sbc icblhz
313 E60D 85 29 sta icblhz
314 E60F 9D 49 03 sta icblh,x
315
316 ;NOMAM 2013 BASIC Ten-Liners disk requires ICBALZ to be untouched :P
317 E612 BD 44 03 85 24 BD + mwa icbal,x icbalz
318
319 ;Pacem in Terris requires Y=1 exit.
320 ;DOS 3.0 with 128K/XE mode requires Y=3 for EOF imminent.
321 E61C 60 rts
322
323 ;--------------------------------------------------------------------------
324 E61D cmdGetChars:
325 E61D F0 15 beq cmdGetCharsSingle
326 E61F cmdGetCharsLoop:
327 E61F 20 C2 E6 jsr CIOInvoke.invoke_vector
328 E622 C0 00 cpy #0
329 E624 30 0B bmi cmdGetCharsError
330 E626 A2 00 ldx #0
331 E628 85 2F sta ciochr ;required by HOTEL title screen
332 E62A 81 24 sta (icbalz,x)
333 E62C 20 72 E6 jsr advance_pointers
334 E62F D0 EE bne cmdGetCharsLoop
335 E631 cmdGetCharsError:
336 E631 4C FB E5 jmp cmdGetPutDone
337
338 E634 cmdGetCharsSingle:
339 E634 20 C2 E6 jsr CIOInvoke.invoke_vector
340 E637 85 2F sta ciochr
341 E639 60 rts
342
343 ;--------------------------------------------------------------------------
344 ; PUT RECORD handler ($09)
345 ;
346 ; Exit:
347 ; ICBAL/ICBAH: Not changed
348 ; ICBLL/ICBLH: Number of bytes processed
349 ;
350 ; If the string does not contain an EOL character, one is printed at the
351 ; end. Also, in this case CIOCHR must reflect the last character in the
352 ; buffer and not the EOL. (Required by Atari DOS 2.5 RAMDISK banner)
353 ;
354 ; If length=0, the character in the A register is output without an EOL.
355 ; This behavior is required by the graphics library for Mad Pascal.
356 ;
357 E63A cmdPutRecord:
358 E63A F0 33 beq cmdPutCharsSingle
359 E63C cmdPutRecordLoop:
360 E63C A0 00 ldy #0
361 E63E B1 24 lda (icbalz),y
362 E640 20 C2 E6 jsr CIOInvoke.invoke_vector
363 E643 98 tya
364 E644 30 12 bmi cmdPutRecordError
365 E646 20 72 E6 jsr advance_pointers
366 E649 F0 08 beq cmdPutRecordEOL
367 E64B A9 9B lda #$9b
368 E64D C5 2F cmp ciochr
369 E64F F0 07 beq cmdPutRecordDone
370 E651 D0 E7 bne cmdPutRecord
371
372 E653 cmdPutRecordEOL:
373 E653 A9 9B lda #$9b
374 E655 20 C2 E6 jsr CIOInvoke.invoke_vector
375 E658 cmdPutRecordError:
376 E658 cmdPutRecordDone:
377 E658 4C FB E5 jmp cmdGetPutDone
378
379 ;--------------------------------------------------------------------------
380 E65B cmdPutChars:
381 E65B F0 12 beq cmdPutCharsSingle
382 E65D cmdPutCharsLoop:
383 E65D A0 00 ldy #0
384 E65F B1 24 lda (icbalz),y
385 E661 20 C2 E6 jsr CIOInvoke.invoke_vector
386 E664 98 tya
387 E665 30 F1 bmi cmdPutRecordError
388 E667 20 72 E6 jsr advance_pointers
389 E66A D0 F1 bne cmdPutCharsLoop
390 E66C 4C FB E5 jmp cmdGetPutDone
391 E66F cmdPutCharsSingle:
392 E66F 4C C4 E6 jmp CIOInvoke.invoke_vector_ciochr
393
394 ;--------------------------------------------------------------------------
395
396 E672 advance_pointers:
397 E672 E6 24 D0 02 E6 25 inw icbalz
398 E678 A5 28 D0 02 C6 29 + dew icbllz
399 E680 D0 02 A5 29 sne:lda icblhz
400 E684 60 rts
401
402 ;--------------------------------------------------------------------------
403 E685 cmdClose:
404 E685 20 C2 E6 jsr CIOInvoke.invoke_vector
405 E688 cmdCloseProvisional:
406 E688 A6 2E ldx icidno
407 E68A 20 01 E7 jsr CIOSetPutByteClosed
408 E68D A9 FF 9D 40 03 mva #$ff ichid,x
409 E692 60 rts
410
411 E693 perm_check_table:
412 E693 04 dta $04 ;$04 (get record)
413 E694 04 dta $04 ;$05 (get record)
414 E695 04 dta $04 ;$06 (get chars)
415 E696 04 dta $04 ;$07 (get chars)
416 E697 08 dta $08 ;$08 (put record)
417 E698 08 dta $08 ;$09 (put record)
418 E699 08 dta $08 ;$0A (put chars)
419 E69A 08 dta $08 ;$0B (put chars)
420 E69B FF dta $ff ;$0C (close)
421 E69C FF dta $ff ;$0D (get status)
422 E69D FF dta $ff ;$0E (special)
423
424 E69E vector_preload_table:
425 E69E 05 dta $05 ;$04 (get record)
426 E69F 05 dta $05 ;$05 (get record)
427 E6A0 05 dta $05 ;$06 (get chars)
428 E6A1 05 dta $05 ;$07 (get chars)
429 E6A2 07 dta $07 ;$08 (put record)
430 E6A3 07 dta $07 ;$09 (put record)
431 E6A4 07 dta $07 ;$0A (put chars)
432 E6A5 07 dta $07 ;$0B (put chars)
433 E6A6 03 dta $03 ;$0C (close)
434 E6A7 09 dta $09 ;$0D (get status)
435 E6A8 0B dta $0b ;$0E (special)
436
437 E6A9 command_table_lo:
438 E6A9 D5 dta <(cmdGetRecord-1) ;$04
439 E6AA D5 dta <(cmdGetRecord-1) ;$05
440 E6AB 1C dta <(cmdGetChars-1) ;$06
441 E6AC 1C dta <(cmdGetChars-1) ;$07
442 E6AD 39 dta <(cmdPutRecord-1) ;$08
443 E6AE 39 dta <(cmdPutRecord-1) ;$09
444 E6AF 5A dta <(cmdPutChars-1) ;$0A
445 E6B0 5A dta <(cmdPutChars-1) ;$0B
446 E6B1 84 dta <(cmdClose-1) ;$0C
447 E6B2 C1 dta <(cmdGetStatus-1) ;$0D
448 E6B3 C5 dta <(cmdSpecial-1) ;$0E
449
450 E6B4 command_table_hi:
451 E6B4 E5 dta >(cmdGetRecord-1) ;$04
452 E6B5 E5 dta >(cmdGetRecord-1) ;$05
453 E6B6 E6 dta >(cmdGetChars-1) ;$06
454 E6B7 E6 dta >(cmdGetChars-1) ;$07
455 E6B8 E6 dta >(cmdPutRecord-1) ;$08
456 E6B9 E6 dta >(cmdPutRecord-1) ;$09
457 E6BA E6 dta >(cmdPutChars-1) ;$0A
458 E6BB E6 dta >(cmdPutChars-1) ;$0B
459 E6BC E6 dta >(cmdClose-1) ;$0C
460 E6BD E6 dta >(cmdGetStatus-1) ;$0D
461 E6BE E5 dta >(cmdSpecial-1) ;$0E
462 .endp
463
464 ;==========================================================================
465 ; Invoke device vector.
466 ;
467 ; Entry (standard):
468 ; A, X = ignored
469 ; Y = offset to high vector byte in device table
470 ;
471 ; Entry (invoke_vector):
472 ; A = byte to pass to PUT CHAR vector
473 ; X, Y = ignored
474 ;
475 ; Exit:
476 ; A = byte returned from GET CHAR vector
477 ; Y = status
478 ;
479 E6BF .proc CIOInvoke
480 E6BF 20 60 E5 jsr CIO.load_vector
481 E6C2 invoke_vector:
482 E6C2 85 2F sta ciochr
483 E6C4 invoke_vector_ciochr:
484 E6C4 A5 2D lda icax3z+1
485 E6C6 48 pha
486 E6C7 A5 2C lda icax3z
487 E6C9 48 pha
488 E6CA A0 92 ldy #CIOStatNotSupported
489 E6CC A6 2E ldx icidno
490 E6CE A5 2F lda ciochr
491 E6D0 60 rts
492 .endp
493
494 ;==========================================================================
495 ; Copy IOCB to ZIOCB.
496 ;
497 ; Entry:
498 ; X = IOCB
499 ;
500 ; [OSManual p236] "Although both the outer level IOCB and the Zero-page
501 ; IOCB are defined to be 16 bytes in size, only the first 12 bytes are
502 ; moved by CIO."
503 ;
504 E6D1 .proc CIOLoadZIOCB
505 ;We used to do a trick here where we would count Y from $F4 to $00...
506 ;but we can't do that because the 65C816 doesn't wrap abs,Y within
507 ;bank 0 even in emulation mode. Argh!
508
509 E6D1 A0 00 ldy #0
510 E6D3 copyToZIOCB:
511 E6D3 BD 40 03 lda ichid,x
512 E6D6 99 20 00 sta ziocb,y
513 E6D9 E8 inx
514 E6DA C8 iny
515 E6DB C0 0C cpy #12
516 E6DD D0 F4 bne copyToZIOCB
517 E6DF 60 rts
518 .endp
519
520 ;==========================================================================
521 E6E0 .proc CIOParsePath
522 ;default to device #1
523 E6E0 A2 01 ldx #1
524
525 ;pull first character of filename and stash it
526 E6E2 A1 23 lda (icbalz-1,x)
527 E6E4 85 2D sta icax4z
528
529 ;Check for a device number.
530 ;
531 ; - D1:-D9: is supported. D0: also gives unit 1, and any digits beyond
532 ; the first are ignored.
533 ;
534 ; We don't validate the colon anymore -- Atari OS allows opening just "C" to get
535 ; to the cassette.
536 ;
537 E6E6 A0 01 ldy #1
538 E6E8 B1 24 lda (icbalz),y
539 E6EA 38 sec
540 E6EB E9 30 sbc #'0'
541 E6ED F0 06 beq nodevnum
542 E6EF C9 0A cmp #10
543 E6F1 B0 02 bcs nodevnum
544 E6F3 AA tax
545
546 E6F4 C8 iny
547
548 E6F5 nodevnum:
549 E6F5 86 21 stx icdnoz
550
551 .if _KERNEL_XLXE
552 ;check if we are doing a true open and if we should do a type 4 poll
553 lda iccomz
554 cmp #CIOCmdOpen
555 bne skip_poll
556
557 ;clear DVSTAT+0/+1 to indicate no poll
558 lda #0
559 sta dvstat
560 sta dvstat+1
561
562 ;check if we should do an unconditional poll (HNDLOD nonzero).
563 lda hndlod
564 bne unconditional_poll
565
566 ;search handler table
567 jsr CIOFindHandler
568 beq found
569
570 unconditional_poll:
571 ;do type 4 poll
572 jsr CIOPollForDevice
573 bmi unknown_device
574
575 ;mark provisionally open
576 ldx icidno
577 mva #$7f ichid,x
578 mva icax4z icax3,x
579 mva dvstat+2 icax4,x
580 mwa #CIOPutByteLoadHandler-1 icptl,x
581 mva icdnoz icdno,x
582
583 ;do direct exit, bypassing regular open path
584 pla
585 pla
586 ldy #1
587 rts
588
589 skip_poll:
590 .endif
591
592 ;search handler table
593 E6F7 20 0C E7 jsr CIOFindHandler
594 E6FA F0 04 beq found
595
596 E6FC unknown_device:
597 ;return unknown device error
598 E6FC A0 82 ldy #CIOStatUnkDevice
599 E6FE 68 pla
600 E6FF 68 pla
601 E700 found:
602 E700 60 rts
603 .endp
604
605 ;==========================================================================
606 E701 .proc CIOSetPutByteClosed
607 E701 A9 33 lda #<[CIO.not_open_handler-1]
608 E703 9D 46 03 sta icptl,x
609 E706 A9 E5 lda #>[CIO.not_open_handler-1]
610 E708 9D 47 03 sta icpth,x
611 E70B 60 rts
612 .endp
613
614 ;==========================================================================
615 ; Attempt to find a handler entry in HATABS.
616 ;
617 E70C .proc CIOFindHandler
618 ;search for handler
619 E70C A5 2D lda icax4z
620 E70E A2 21 ldx #11*3
621 E710 findHandler:
622 E710 DD 1A 03 cmp hatabs,x
623 E713 F0 05 beq foundHandler
624 E715 CA dex
625 E716 CA dex
626 E717 CA dex
627 E718 10 F6 bpl findHandler
628 E71A foundHandler:
629 ;store handler ID
630 E71A 86 20 stx ichidz
631 E71C 60 rts
632 .endp
633
634 ;==========================================================================
635 ; Poll SIO bus for CIO device
636 ;
637 ; Issues a type 4 poll ($4F/$40/devname/devnumber).
638 ;
639 .if _KERNEL_XLXE
640 .proc CIOPollForDevice
641 lda icax4z
642 sta daux1
643 lda icdnoz
644 sta daux2
645
646 ldx #9
647 mva:rpl cmd_tab,x ddevic,x-
648
649 jmp siov
650
651 cmd_tab:
652 dta $4f ;device
653 dta $01 ;unit
654 dta $40 ;command
655 dta $40 ;status (transfer flags)
656 dta <dvstat ;dbuflo
657 dta >dvstat ;dbufhi
658 dta $40 ;dtimlo
659 dta $00 ;unused
660 dta $04 ;dbytlo
661 dta $00 ;dbythi
662 .endp
663 .endif
664
665 ;==========================================================================
666 ; Load handler for a provisionally open IOCB.
667 ;
668 .if _KERNEL_XLXE
669 .proc CIOLoadHandler
670 ;load handler over SIO bus
671 mwa dvstat+2 loadad
672 ldx icidno
673 mva icax4,x ddevic
674 jsr PHLoadHandler
675 bcs fail
676
677 ;let's see if we can look up the handler now
678 ldx icidno
679 mva icax3,x icax4z
680 jsr CIOFindHandler
681 bne fail
682
683 ;follow through with open
684 jsr CIO.open_entry
685 bpl ok
686 fail:
687 ldy #CIOStatUnkDevice
688 ok:
689 rts
690 .endp
691 .endif
692
693 ;==========================================================================
694 ; PUT BYTE handler for provisionally open IOCBs.
695 ;
696 ; This handler is used when an IOCB has been provisionally opened pending
697 ; a handler load over the SIO bus. It is used when a direct call is made
698 ; through ICPTL/ICPTH. If HNDLOD=0, the call fails as handler loading is
699 ; not set up; if it is nonzero, the handler is loaded over the SIO bus and
700 ; then the PUT BYTE call continues if everything is good.
701 ;
702 .if _KERNEL_XLXE
703 .proc CIOPutByteLoadHandler
704 ;save off A/X
705 sta ciochr
706 stx icidno
707
708 ;check if we're allowed to load a handler and bail if not
709 lda hndlod
710 beq load_error
711
712 ;copy IOCB to ZIOCB
713 jsr CIOLoadZIOCB
714
715 ;try to load the handler
716 jsr CIOLoadHandler
717 bmi load_error
718
719 ;all good... let's invoke the standard handler
720 ldy #7
721 jsr CIOInvoke
722 jmp xit
723
724 load_error:
725 ldy #CIOStatUnkDevice
726 xit:
727 php
728 lda ciochr
729 ldx icidno
730 plp
731 rts
732 .endp
733 .endif
236 .endif
237
238 E71D _KERNEL_REPORT_MODULE_SIZE 'Central Input/Output (CIO)', $E6D5-$E4A6
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', $E6D5-$E4A6, ')', ' ', 'Central Input/Output (CIO)'
1 $E71D -> $0233($022F) Central Input/Output (CIO)
3 = E71D .def ?@_kernel_lastpt = *
Source: source/main.xasm
239
240 .if !_KERNEL_XLXE
241 E71D icl 'vbi.s'
Source: source/Shared/vbi.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Vertical Blank Interrupt Services
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 ; VBIExit - Vertical Blank Interrupt Exit Routine
12 ;
13 ; This is a drop-in replacement for XITVBV.
14 ;
15 = E761 VBIExit = VBIProcess.xit
16
17 ;==========================================================================
18 ; VBIProcess - Vertical Blank Processor
19 ;
20 = E71D VBIStage1 = VBIProcess.stage_1
21 = E772 VBIStage2 = VBIProcess.stage_2
22 E71D .proc VBIProcess
23 E71D stage_1:
24 ;increment real-time clock and do attract processing
25 E71D E6 14 inc rtclok+2
26 E71F D0 08 bne clock_done
27 E721 E6 4D inc atract
28 E723 E6 13 inc rtclok+1
29 E725 D0 02 bne clock_done
30 E727 E6 12 inc rtclok
31 E729 clock_done:
32
33 ;Pole Position depends on DRKMSK and COLRSH being reset from VBI as it
34 ;clears kernel vars after startup.
35 E729 A2 FE ldx #$fe ;default to no mask
36 E72B A9 00 lda #$00 ;default to no color alteration
37 E72D A4 4D ldy atract ;check attract counter
38 E72F 10 06 bpl attract_off ;skip if attract is off
39 E731 86 4D stx atract ;lock the attract counter
40 E733 A2 F6 ldx #$f6 ;set mask to dim colors
41 E735 A5 13 lda rtclok+1 ;use clock to randomize colors
42 E737 attract_off:
43 E737 86 4E stx drkmsk ;set color mask
44 E739 85 4F sta colrsh ;set color modifier
45
46 ;atract color 1 only
47 E73B 4D C5 02 eor color1
48 E73E 25 4E and drkmsk
49 E740 8D 17 D0 sta colpf1
50
51 ;decrement timer 1 and check for underflow
52 E743 AD 18 02 lda cdtmv1 ;check low byte
53 E746 D0 08 bne timer1_lobytezero ;if non-zero, decrement and check for fire
54 E748 AD 19 02 lda cdtmv1+1 ;check high byte
55 E74B F0 10 beq timer1_done ;if clear, timer's not running
56 E74D CE 19 02 dec cdtmv1+1 ;decrement high byte
57 E750 timer1_lobytezero:
58 E750 CE 18 02 dec cdtmv1 ;decrement low byte
59 E753 D0 08 bne timer1_done ;no underflow if non-zero
60 E755 AD 19 02 lda cdtmv1+1 ;low byte is zero... check if high byte is too
61 E758 D0 03 bne timer1_done ;if it's not, we're not done yet ($xx00 > 0)
62 E75A 20 67 E7 jsr timer1_dispatch ;jump through timer vector
63 E75D timer1_done:
64
65 ;check for critical operation
66 E75D A5 42 lda critic
67 E75F F0 09 beq no_critic
68 E761 xit:
69 E761 68 pla
70 E762 A8 tay
71 E763 68 pla
72 E764 AA tax
73 E765 exit_a:
74 E765 68 pla
75 E766 exit_none:
76 E766 40 rti
77
78 E767 timer1_dispatch:
79 E767 6C 26 02 jmp (cdtma1)
80
81 E76A no_critic:
82 E76A A9 04 lda #$04 ;I flag
83 E76C BA tsx
84 E76D 3D 04 01 and $0104,x ;I flag set on pushed stack?
85 E770 D0 EF bne xit ;exit if so
86
87 ;======== stage 2 processing
88
89 E772 stage_2:
90 ;re-enable interrupts
91 E772 58 cli
92
93 ;update shadow registers
94 E773 AD 31 02 8D 03 D4 mva sdlsth dlisth
95 E779 AD 30 02 8D 02 D4 mva sdlstl dlistl
96 E77F AD 2F 02 8D 00 D4 mva sdmctl dmactl
97 E785 AD F4 02 8D 09 D4 mva chbas chbase
98 E78B AD F3 02 8D 01 D4 mva chact chactl
99 E791 AD 6F 02 8D 1B D0 mva gprior prior
100
101 E797 A2 08 ldx #8
102 E799 8E 1F D0 stx consol ;sneak in speaker reset while we have an 8
103 E79C ColorLoop
104 E79C BD C0 02 lda pcolr0,x
105 E79F 45 4F eor colrsh
106 E7A1 25 4E and drkmsk
107 E7A3 9D 12 D0 sta colpm0,x
108 E7A6 CA dex
109 E7A7 10 F3 bpl ColorLoop
110
111 ;decrement timer 2 and check for underflow
112 E7A9 A2 03 ldx #3
113 E7AB 20 51 E8 jsr VBIDecrementTimer
114 E7AE D0 03 20 2F E8 sne:jsr Timer2Dispatch
115
116 ;Decrement timers 3-5 and set flags
117 ;
118 ;[OS Manual] Appendix L, page 254 says that the OS never modifies CDTMF3-5
119 ;except to set them to zero on timeout at init. This is a LIE. It also sets
120 ;the flags to $FF when they are running. It does not write the flags when
121 ;the timer is idle. Spider Quake depends on this.
122 ;
123 E7B3 A2 09 ldx #9
124 E7B5 timer_n_loop:
125 E7B5 18 clc
126 E7B6 20 51 E8 jsr VBIDecrementTimer
127 E7B9 B0 07 bcs timer_n_not_running
128 E7BB F0 02 A9 FF seq:lda #$ff
129 E7BF timer_n_not_expired:
130 E7BF 9D 25 02 sta cdtmf3-5,x
131 E7C2 timer_n_not_running:
132 E7C2 CA dex
133 E7C3 CA dex
134 E7C4 E0 05 cpx #5
135 E7C6 B0 ED bcs timer_n_loop
136
137 ;Read POKEY keyboard register and handle auto-repeat
138 E7C8 AD 0F D2 lda skstat ;get key status
139 E7CB 29 04 and #$04 ;check if key is down
140 E7CD D0 12 bne no_repeat_key ;skip if not
141 E7CF CE 2B 02 dec srtimr ;decrement repeat timer
142 E7D2 D0 12 bne no_repeat ;skip if not time to repeat yet
143 E7D4 AD 09 D2 8D FC 02 mva kbcode ch ;repeat last key
144
145 .if _KERNEL_XLXE
146 mva keyrep srtimr ;reset repeat timer
147 .else
148 E7DA A9 06 8D 2B 02 mva #$06 srtimr ;reset repeat timer
149 .endif
150
151 E7DF D0 0D bne no_keydel ;skip debounce counter decrement
152
153 E7E1 no_repeat_key:
154 E7E1 A9 00 lda #0
155 E7E3 8D 2B 02 sta srtimr
156 E7E6 no_repeat:
157 ;decrement keyboard debounce counter
158 E7E6 AD F1 02 lda keydel
159 E7E9 F0 03 CE F1 02 seq:dec keydel
160 E7EE no_keydel:
161
162 ;Update controller shadows.
163 ;
164 ;The PORTA/PORTB decoding is a bit complex:
165 ;
166 ; bits 0-3 -> STICK0/4 (and no, we cannot leave junk in the high bits)
167 ; bits 4-7 -> STICK1/5
168 ; bit 2 -> PTRIG0/4
169 ; bit 3 -> PTRIG1/5
170 ; bit 6 -> PTRIG2/6
171 ; bit 7 -> PTRIG3/7
172 ;
173 ;XL/XE machines only have two joystick ports, so the results of ports 0-1
174 ;are mapped onto ports 2-3.
175 ;
176
177 .if _KERNEL_XLXE
178 lda porta
179 tax
180 and #$0f
181 sta stick0
182 sta stick2
183 txa
184 lsr ;shr1
185 lsr ;shr2
186 tax
187 lsr ;shr3
188 lsr ;shr4
189 sta stick1
190 sta stick3
191 lsr ;shr5
192 lsr ;shr6
193 tay
194 and #$01
195 sta ptrig2
196 tya
197 lsr
198 sta ptrig3
199 txa
200 and #$01
201 sta ptrig0
202 txa
203 lsr
204 and #$01
205 sta ptrig1
206
207 ldx #3
208 pot_loop:
209 lda pot0,x
210 sta paddl0,x
211 sta paddl4,x
212 lda ptrig0,x
213 sta ptrig4,x
214 dex
215 bpl pot_loop
216
217 ldx #1
218 port_loop:
219 lda trig0,x
220 sta strig0,x
221 sta strig2,x
222 dex
223 bpl port_loop
224
225 .else
226 E7EE A2 07 ldx #7
227 E7F0 pot_loop:
228 E7F0 BD 00 D2 lda pot0,x
229 E7F3 9D 70 02 sta paddl0,x
230 E7F6 A9 00 lda #0
231 E7F8 9D 7C 02 sta ptrig0,x
232 E7FB CA dex
233 E7FC 10 F2 bpl pot_loop
234
235 E7FE A2 03 ldx #3
236 E800 trig_loop:
237 E800 BD 10 D0 lda trig0,x
238 E803 9D 84 02 sta strig0,x
239 E806 CA dex
240 E807 10 F7 bpl trig_loop
241
242 E809 AD 00 D3 lda porta
243 E80C A2 00 ldx #0
244 E80E A0 00 ldy #0
245 E810 20 32 E8 jsr do_stick_ptrigs
246 E813 AD 01 D3 lda portb
247 E816 A2 04 ldx #4
248 E818 A0 02 ldy #2
249 E81A 20 32 E8 jsr do_stick_ptrigs
250 .endif
251
252 ;restart pots (required for SysInfo)
253 E81D 8D 0B D2 sta potgo
254
255 ;update light pen
256 E820 AD 0C D4 8D 34 02 mva penh lpenh
257 E826 AD 0D D4 8D 35 02 mva penv lpenv
258
259 E82C 6C 24 02 jmp (vvblkd) ;jump through vblank deferred vector
260
261 E82F Timer2Dispatch
262 E82F 6C 28 02 jmp (cdtma2)
263
264 .if !_KERNEL_XLXE
265 E832 do_stick_ptrigs:
266 E832 48 pha
267 E833 29 0F and #$0f
268 E835 99 78 02 sta stick0,y
269 E838 68 pla
270 E839 4A lsr
271 E83A 4A lsr
272 E83B 4A lsr
273 E83C 3E 7C 02 rol ptrig0,x
274 E83F 4A lsr
275 E840 3E 7D 02 rol ptrig1,x
276 E843 99 79 02 sta stick1,y
277 E846 4A lsr
278 E847 4A lsr
279 E848 4A lsr
280 E849 3E 7E 02 rol ptrig2,x
281 E84C 4A lsr
282 E84D 3E 7F 02 rol ptrig3,x
283 E850 60 rts
284 .endif
285
286 .endp
287
288 ;==========================================================================
289 ; VBIDecrementTimer
290 ;
291 ; Entry:
292 ; X = timer index *2+1 (1-9)
293 ;
294 ; Exit:
295 ; C=1, Z=0, A!0 timer not running
296 ; C=0/same, Z=1, A=0 timer just expired
297 ; C=0/same, Z=0, A=? timer still running
298 ;
299 E851 .proc VBIDecrementTimer
300 ;check low byte
301 E851 BD 17 02 lda cdtmv1-1,x
302 E854 D0 0A bne lononzero
303
304 ;check high byte; set C=1/Z=1 if zero, C=0/Z=0 otherwise
305 E856 DD 18 02 cmp cdtmv1,x
306 E859 D0 02 bne lozero_hinonzero
307
308 ;both bytes are zero, so timer's not running
309 E85B 8A txa
310 E85C 60 rts
311
312 E85D lozero_hinonzero:
313 ;decrement high byte
314 E85D DE 18 02 dec cdtmv1,x
315
316 E860 lononzero:
317 ;decrement low byte
318 E860 DE 17 02 dec cdtmv1-1,x
319 E863 D0 03 bne still_running
320
321 ;return high byte to set Z appropriately
322 E865 BD 18 02 lda cdtmv1,x
323 E868 still_running:
324 E868 60 rts
325 .endp
326
327 ;==========================================================================
328 ; VBISetVector - set vertical blank vector or counter
329 ;
330 ; This is a drop-in replacement for SETVBV.
331 ;
332 ; A = item to update
333 ; 1-5 timer 1-5 counter value
334 ; 6 VVBLKI
335 ; 7 VVBLKD
336 ; X = MSB
337 ; Y = LSB
338 ;
339 E869 .proc VBISetVector
340 ;A = item to update
341 ; 1-5 timer 1-5 counter value
342 ; 6 VVBLKI
343 ; 7 VVBLKD
344 ;X = MSB
345 ;Y = LSB
346 ;
347 ;NOTE:
348 ;The Atari OS Manual says that DLIs will be disabled after SETVBV is called.
349 ;This is a lie -- neither the OS-B nor XL kernels do this, and the Bewesoft
350 ;8-players demo depends on it being left enabled.
351 ;
352 ;IRQ mask state must be saved across this proc. DOSDISKA.ATR breaks if IRQs
353 ;are unmasked.
354
355 E869 0A asl
356 E86A 8D 2D 02 sta intemp
357 E86D 08 php
358 E86E 78 sei
359 E86F 98 tya
360 E870 AC 2D 02 ldy intemp
361
362 ;We're relying on a rather tight window here. We can't touch NMIEN, so we have
363 ;to wing it with DLIs enabled. Problem is, in certain conditions we can be under
364 ;very tight timing constraints. In order to do this safely we have to finish
365 ;before a DLI can execute. The worst case is a wide mode 2 line at the end of
366 ;a vertically scrolled region with P/M graphics enabled and an LMS on the next
367 ;mode line. In that case we only have 7 cycles before we hit the P/M graphics
368 ;and another two cycles after that until the DLI fires. The exact cycle timing
369 ;looks like this:
370 ;
371 ;* inc wsync
372 ;ANTIC halts CPU until cycle 105
373 ;105 playfield DMA
374 ;106 refresh DMA
375 ;107 sta abs,y (1/5)
376 ;108 sta abs,y (2/5)
377 ;109 sta abs,y (3/5)
378 ;110 sta abs,y (4/5)
379 ;111 sta abs,y (5/5)
380 ;112 txa (1/2)
381 ;113 txa (2/2)
382 ;0 missiles
383 ;1 display list
384 ;2 player 0
385 ;3 player 1
386 ;4 player 2
387 ;5 player 3
388 ;6 display list address low
389 ;7 display list address high
390 ;8 sta abs,y (1/5)
391 ;9 sta abs,y (2/5)
392 ;10 sta abs,y (3/5)
393 ;11 sta abs,y (4/5)
394 ;12 sta abs,y (5/5)
395 ;
396 ;We rely on the 6502 not being able to service interrupts until the end of an
397 ;instruction for this to work. The INC WSYNC is necessary to combat the case
398 ;where the NMI is triggered across the WSYNC wait; without it, the VBI could
399 ;fire immediately after the first STA.
400
401 E873 EE 0A D4 inc wsync
402 E876 99 16 02 sta cdtmv1-2,y
403 E879 8A txa
404 E87A 99 17 02 sta cdtmv1-1,y
405 E87D 28 plp
406 E87E 60 rts
407 .endp
242 E87F icl 'interrupt.s'
Source: source/Shared/interrupt.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Interrupt Handlers
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 ; Dispatched from INTINV. Used by SpartaDOS X.
12 ;
13 E87F .proc IntInitInterrupts
14 E87F A9 40 8D 0E D4 mva #$40 nmien
15
16 .if _KERNEL_XLXE
17 ;Required by XEGS carts to run since they have a clone of the XL/XE
18 ;OS in them.
19 mva trig3 gintlk
20 .endif
21
22 E884 60 rts
23 .endp
24
25 ;==========================================================================
26 E885 .proc IntDispatchNMI
27 E885 2C 0F D4 bit nmist ;check nmi status
28 E888 10 06 bpl not_dli ;skip if not a DLI
29 E88A 6C 00 02 jmp (vdslst) ;jump to display list vector
30
31 .if !_KERNEL_XLXE
32 E88D is_system_reset:
33 E88D 4C 74 E4 jmp warmsv
34 .endif
35
36 E890 not_dli:
37 E890 48 pha
38
39 .if _KERNEL_XLXE
40 ;Only XL/XE OSes cleared the decimal bit.
41 cld
42 .else
43 ;The stock OS treats 'not RNMI' as VBI. We'd best follow its example.
44 E891 A9 20 lda #$20
45 E893 2C 0F D4 bit nmist
46 E896 D0 F5 bne is_system_reset
47 .endif
48
49 E898 8A txa
50 E899 48 pha
51 E89A 98 tya
52 E89B 48 pha
53 E89C 8D 0F D4 sta nmires ;reset VBI interrupt
54 E89F 6C 22 02 jmp (vvblki) ;jump through vblank immediate vector
55 .endp
56
57 E8A2 .proc IntDispatchIRQ
58 .if _KERNEL_XLXE
59 cld
60 .endif
61 E8A2 6C 16 02 jmp (vimirq)
62 .endp
63
64 ;==============================================================================
65 = E765 IntExitHandler_A = VBIProcess.exit_a
66 = E766 IntExitHandler_None = VBIProcess.exit_none
243 E8A5 icl 'irq.s'
Source: source/Shared/irq.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - IRQ routines
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 ; _KERNEL_FAST_IRQ
12 ;
13 ; If set, expands the IRQ module slightly to save 12 cycles when ack'ing
14 ; POKEY IRQs. This is still faster than the stock XL/XE OS. If cleared,
15 ; an additional subroutine call is used to reduce code size.
16 ;
17 .ifndef _KERNEL_FAST_IRQ
18 _KERNEL_FAST_IRQ = 0
19 .endif
20
21 ;==========================================================================
22 .if _KERNEL_FAST_IRQ
23 _ACK_IRQ .macro
24 sta irqen
25 lda pokmsk
26 sta irqen
27 .endm
28 .else
29 _ACK_IRQ .macro
30 jsr IrqAcknowledge
31 .endm
32 .endif
33
34 ;==========================================================================
35 ; The canonical IRQ priority order for the XL/XE is:
36 ; - Serial input ready ($20)
37 ; - PBI devices
38 ; - Serial output ready ($10)
39 ; - Serial output complete ($08)
40 ; - Timer 1 ($01)
41 ; - Timer 2 ($02)
42 ; - Timer 4 ($04)
43 ; - Keyboard ($80)
44 ; - Break ($40)
45 ; - PIA proceed
46 ; - PIA interrupt
47 ; - BRK instruction
48 ;
49 = E8CD IRQHandler = _IRQHandler._entry
50 E8A5 .proc _IRQHandler
51 .if _KERNEL_PBI_SUPPORT
52 check_pbi:
53 ;check if a device interrupt is active
54 and $d1ff
55 beq no_pbi_interrupt
56
57 ;save X
58 sta jveck
59 txa
60 pha
61
62 ;jump through PBI interrupt vector
63 lda jveck
64 jmp (vpirq)
65 .endif
66
67 E8A5 dispatch_serout:
68 E8A5 A9 EF lda #$ef
69 E8A7 _ACK_IRQ
Macro: _ACK_IRQ [Source: source/Shared/irq.s]
1 E8A7 20 3C E9 jsr IrqAcknowledge
Source: source/Shared/irq.s
70 E8AA 6C 0C 02 jmp (vseror)
71
72 E8AD check_seroc:
73 E8AD 2C 0E D2 bit irqst
74 E8B0 D0 3C bne not_seroc
75 E8B2 dispatch_seroc:
76 E8B2 6C 0E 02 jmp (vseroc)
77
78 E8B5 dispatch_timer1:
79 E8B5 A9 FE lda #$fe
80 E8B7 _ACK_IRQ
Macro: _ACK_IRQ [Source: source/Shared/irq.s]
1 E8B7 20 3C E9 jsr IrqAcknowledge
Source: source/Shared/irq.s
81 E8BA 6C 10 02 jmp (vtimr1)
82
83 E8BD dispatch_timer2:
84 E8BD A9 FD lda #$fd
85 E8BF _ACK_IRQ
Macro: _ACK_IRQ [Source: source/Shared/irq.s]
1 E8BF 20 3C E9 jsr IrqAcknowledge
Source: source/Shared/irq.s
86 E8C2 6C 12 02 jmp (vtimr2)
87
88 E8C5 dispatch_timer4:
89 E8C5 A9 FB lda #$fb
90 E8C7 _ACK_IRQ
Macro: _ACK_IRQ [Source: source/Shared/irq.s]
1 E8C7 20 3C E9 jsr IrqAcknowledge
Source: source/Shared/irq.s
91 E8CA 6C 14 02 jmp (vtimr4)
92
93 E8CD _entry:
94 E8CD 48 pha
95
96 ;check for serial input ready IRQ
97 E8CE A9 20 lda #$20
98 E8D0 2C 0E D2 bit irqst
99 E8D3 D0 0D bne not_serin
100 E8D5 A9 DF lda #$df
101 E8D7 8D 0E D2 sta irqen
102 E8DA A5 10 lda pokmsk
103 E8DC 8D 0E D2 sta irqen
104 E8DF 6C 0A 02 jmp (vserin)
105 E8E2 not_serin:
106
107 .if _KERNEL_PBI_SUPPORT
108 ;check for PBI devices requiring interrupt handling
109 lda pdmsk
110 bne check_pbi
111 no_pbi_interrupt:
112 .endif
113
114 ;check for serial output ready IRQ
115 E8E2 A9 10 lda #$10
116 E8E4 2C 0E D2 bit irqst
117 E8E7 F0 BC beq dispatch_serout
118
119 ;check for serial output complete (not a latch, so must mask)
120 E8E9 4A lsr
121 E8EA 24 10 bit pokmsk
122 E8EC D0 BF bne check_seroc
123 E8EE not_seroc:
124
125 E8EE AD 0E D2 lda irqst
126 E8F1 4A lsr
127 E8F2 90 C1 bcc dispatch_timer1
128 E8F4 4A lsr
129 E8F5 90 C6 bcc dispatch_timer2
130 E8F7 4A lsr
131 E8F8 90 CB bcc dispatch_timer4
132 E8FA 2C 0E D2 bit irqst
133 E8FD 50 21 bvc dispatch_keyboard
134 E8FF 10 27 bpl dispatch_break
135
136 ;check for serial bus proceed line
137 E901 2C 02 D3 bit pactl
138 E904 30 2A bmi dispatch_pia_irqa
139
140 ;check for serial bus interrupt line
141 E906 2C 03 D3 bit pbctl
142 E909 30 2B bmi dispatch_pia_irqb
143
144 ;check for break instruction
145 ;
146 ;we used to use TSX here, but this takes too many insns to
147 ;handle stack wrapping properly
148 E90B 68 pla
149 E90C 8D 8C 02 sta jveck
150 E90F 68 pla
151 E910 48 pha
152 E911 29 10 and #$10
153 E913 F0 07 beq not_brk
154 E915 AD 8C 02 lda jveck
155 E918 48 pha
156 E919 6C 06 02 jmp (vbreak)
157 E91C not_brk:
158 E91C AD 8C 02 lda jveck
159 E91F 40 rti
160
161
162 E920 dispatch_keyboard:
163 E920 A9 BF lda #$bf
164 E922 _ACK_IRQ
Macro: _ACK_IRQ [Source: source/Shared/irq.s]
1 E922 20 3C E9 jsr IrqAcknowledge
Source: source/Shared/irq.s
165 E925 6C 08 02 jmp (vkeybd)
166
167 E928 dispatch_break:
168 E928 A9 7F lda #$7f
169 E92A _ACK_IRQ
Macro: _ACK_IRQ [Source: source/Shared/irq.s]
1 E92A 20 3C E9 jsr IrqAcknowledge
Source: source/Shared/irq.s
170 E92D 6C 36 02 jmp (brkky)
171
172 E930 dispatch_pia_irqa:
173 ;clear serial bus proceed interrupt
174 E930 AD 00 D3 lda porta
175 E933 6C 02 02 jmp (vprced)
176
177 E936 dispatch_pia_irqb:
178 ;clear serial bus interrupt interrupt
179 E936 AD 01 D3 lda portb
180 E939 6C 04 02 jmp (vinter)
181
182 .endp
183
184 ;==========================================================================
185 .if !_KERNEL_FAST_IRQ
186 E93C .proc IrqAcknowledge
187 E93C 8D 0E D2 sta irqen
188 E93F A5 10 lda pokmsk
189 E941 8D 0E D2 sta irqen
190 E944 60 rts
191 .endp
192 .endif
244 .endif
245 E945 _KERNEL_REPORT_MODULE_SIZE 'Interrupt routines', $E944-$E6D5
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', $E944-$E6D5, ')', ' ', 'Interrupt routines'
1 $E945 -> $0228($026F) Interrupt routines
3 = E945 .def ?@_kernel_lastpt = *
Source: source/main.xasm
246
247 E945 icl 'sio.inc'
Source: source/Shared/sio.inc
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - SIO definitions
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 .ifndef f_SIO_INC
11 .def f_SIO_INC
12
13 SIOSuccess = $01
14 SIOErrorTimeout = $8A
15 SIOErrorNAK = $8B
16 SIOErrorBadFrame = $8C
17 SIOErrorOverrun = $8E
18 SIOErrorChecksum = $8F
19 SIOErrorDeviceError = $90
20
21 .endif
248 E945 icl 'sio.s'
Source: source/Shared/sio.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; AltirraOS modular Kernel ROM - Serial Input/Output (SIO) routines
3 ; Copyright (C) 2008-2019 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 E945 .proc SIOInit
11 ;turn off POKEY init mode so polynomial counters and audio run
12 E945 A9 03 8D 0F D2 mva #3 skctl
13 E94A 8D 32 02 sta sskctl
14
15 ;enable noisy sound (yes, this is actually documented as being inited to
16 ;3)
17 E94D 85 41 sta soundr
18 E94F 60 rts
19 .endp
20
21 ;==============================================================================
22 E950 .proc SIO
23 ;set retry counters
24 E950 A9 01 8D BD 02 mva #$01 dretry
25
26 ;enter critical section
27 E955 85 42 sta critic
28
29 .if _KERNEL_PBI_SUPPORT
30 ;attempt PBI transfer
31 jsr PBIAttemptSIO
32 scc:jmp xit_pbi
33 .endif
34
35 ;we must not save STACKP until after PBI devices are polled -- the
36 ;BlackBox PBI routines depend on being able to reuse this location
37 E957 BA tsx
38 E958 8E 18 03 stx stackp
39
40 ;Set timeout timer address -- MUST be done on each call to SIO, or
41 ;Cross-Town Crazy Eight hangs on load due to taking over this vector
42 ;previously. This is guaranteed by the OS Manual in Appendix L, H27.
43 E95B 20 65 EA jsr SIOSetTimeoutVector
44
45 ;check for cassette -- needs to match $60 or else Prisma: Alien Ambush
46 ;fails to load.
47 E95E A2 00 ldx #0
48 E960 AD 00 03 lda ddevic
49 E963 C9 60 cmp #$60
50 E965 D0 01 CA sne:dex
51 E968 8E 0F 03 stx casflg
52
53 ;init POKEY hardware
54 E96B 20 B8 EA jsr SIOInitHardware
55
56 ;go do cassette now
57 E96E 2C 0F 03 bit casflg
58 E971 10 03 bpl retry_command
59 E973 4C 2E EC jmp SIOCassette
60
61 E976 retry_command:
62 ;We try 13 times to get a command accepted by a device; after that it
63 ;counts as a device failure and we try one more round of 13 tries.
64 E976 A9 0D 8D 9C 02 mva #$0d cretry
65
66 E97B retry_command_2:
67 ;init command buffer
68 E97B AD 00 03 lda ddevic
69 E97E 18 clc
70 E97F 6D 01 03 adc dunit
71 E982 38 sec
72 E983 E9 01 sbc #1
73 E985 8D 3A 02 sta cdevic
74
75 E988 AD 02 03 8D 3B 02 mva dcomnd ccomnd
76 E98E AD 0A 03 8D 3C 02 mva daux1 caux1
77 E994 AD 0B 03 8D 3D 02 mva daux2 caux2
78
79 ;assert command line
80 E99A A9 34 8D 03 D3 mva #$34 pbctl
81
82 ;wait ~600us to ensure 750us minimum delay (~1k cycles or ~10 scanlines)
83 E99F A2 05 ldx #5
84 E9A1 AC 0B D4 ldy vcount
85 E9A4 cmddelay:
86 E9A4 CC 0B D4 F0 FB cpy:req vcount
87 E9A9 C8 iny
88 E9AA CA dex
89 E9AB D0 F7 bne cmddelay
90
91 ;send command frame
92 E9AD A9 00 85 3C mva #0 nocksm
93 E9B1 A9 02 lda #>cdevic
94 E9B3 85 33 sta bufrhi
95 E9B5 85 35 sta bfenhi
96 E9B7 A9 3A 85 32 mva #<cdevic bufrlo
97 E9BB A9 3E 85 34 mva #<caux2+1 bfenlo
98 E9BF 20 1D EB jsr SIOSend
99 E9C2 30 65 bmi xit
100
101 ;wait for the ACK
102 E9C4 20 70 EA jsr SIOWaitForACK
103 E9C7 10 0A bpl ackOK
104
105 E9C9 command_error:
106 E9C9 20 8A EB jsr SIOReceiveStop
107 E9CC CE 9C 02 dec cretry
108 E9CF 10 AA bpl retry_command_2
109 E9D1 30 4B bmi transfer_error
110
111 E9D3 ackOK:
112
113 ;check if we should send a data frame
114 E9D3 2C 03 03 bit dstats
115 E9D6 10 0D bpl no_send_frame
116
117 ;setup buffer pointers
118 E9D8 20 07 EB jsr SIOSetupBufferPointers
119
120 ;send data frame
121 E9DB 20 1D EB jsr SIOSend
122 E9DE 30 49 bmi xit
123
124 ;wait for ACK
125 E9E0 20 70 EA jsr SIOWaitForACK
126 E9E3 30 E4 bmi command_error
127
128 E9E5 no_send_frame:
129
130 ;setup for receiving complete
131 E9E5 A2 FF ldx #$ff
132 E9E7 8E 17 03 stx timflg
133 E9EA 86 3C stx nocksm
134
135 ;setup frame delay for complete
136 E9EC AD 06 03 lda dtimlo
137 E9EF 6A ror
138 E9F0 6A ror
139 E9F1 48 pha
140 E9F2 6A ror
141 E9F3 29 C0 and #$c0
142 E9F5 A8 tay
143 E9F6 68 pla
144 E9F7 29 3F and #$3f
145 E9F9 AA tax
146
147 E9FA A9 01 lda #1
148 E9FC 20 5C E4 jsr setvbv
149
150 E9FF A2 3E ldx #<temp
151 EA01 86 32 stx bufrlo
152 EA03 E8 inx
153 EA04 86 34 stx bfenlo
154 EA06 A2 02 ldx #>temp
155 EA08 86 33 stx bufrhi
156 EA0A 86 35 stx bfenhi
157 EA0C 20 4C EB jsr SIOReceive
158 EA0F 30 0D bmi transfer_error
159
160 ;Check if we received a C ($43) or E ($45) -- we must NOT abort immediately
161 ;on a device error, as the device still sends back data we need to read, and
162 ;Music Studio relies on the data coming back from a CRC error.
163 EA11 AD 3E 02 lda temp
164 EA14 C9 43 cmp #$43
165 EA16 F0 32 beq completeOK
166 EA18 C9 45 cmp #$45
167 EA1A F0 2E beq completeOK
168
169 ;we received crap... fail it now
170 EA1C device_error:
171 EA1C A0 90 ldy #SIOErrorDeviceError
172
173 EA1E transfer_error:
174 EA1E 20 8A EB jsr SIOReceiveStop
175
176 EA21 CE BD 02 dec dretry
177 EA24 30 03 bmi device_retries_exhausted
178 EA26 4C 76 E9 jmp retry_command
179
180 EA29 device_retries_exhausted:
181 EA29 xit:
182 EA29 AE 0F 03 ldx casflg
183 EA2C D0 0C bne leave_cassette_audio_on
184 EA2E 8E 01 D2 stx audc1
185 EA31 8E 03 D2 stx audc2
186 EA34 8E 05 D2 stx audc3
187 EA37 8E 07 D2 stx audc4
188 EA3A leave_cassette_audio_on:
189
190 .ifdef _KERNEL_816
191 ;we may be in native mode, so we can't f-up the high byte of the stack pointer
192 lda #1
193 xba
194 lda stackp
195 tcs
196 .else
197 EA3A AE 18 03 ldx stackp
198 EA3D 9A txs
199 .endif
200
201 EA3E xit_pbi:
202 EA3E A9 00 lda #0
203 EA40 85 42 sta critic
204
205 EA42 C0 00 cpy #0 ;!! - A=0 must be preserved for LiteDOS
206 EA44 8C 03 03 sty dstats
207 EA47 84 30 sty status
208 EA49 60 rts
209
210 EA4A completeOK:
211 ;check if we should read a data frame
212 EA4A 2C 03 03 bit dstats
213 EA4D 50 08 bvc no_receive_frame
214
215 ;setup buffer pointers
216 EA4F 20 07 EB jsr SIOSetupBufferPointers
217
218 ;receive the rest of the frame
219 EA52 20 4C EB jsr SIOReceive
220 EA55 30 C7 bmi transfer_error
221
222 EA57 no_receive_frame:
223 ;now we can finally shut off the receive IRQ
224 EA57 20 8A EB jsr SIOReceiveStop
225
226 ;Now check whether we got a device error earlier. If we did, return
227 ;that instead of success.
228 EA5A AD 3E 02 lda temp
229 EA5D C9 43 cmp #'C'
230 EA5F D0 BB bne device_error
231
232 ;nope, we're good... exit OK.
233 EA61 A0 01 ldy #SIOSuccess
234 EA63 D0 C4 bne xit
235 .endp
236
237 ;==============================================================================
238 EA65 .proc SIOSetTimeoutVector
239 EA65 A9 28 8D 26 02 A9 + mwa #SIOCountdown1Handler cdtma1
240 EA6F 60 rts
241 .endp
242
243 ;==============================================================================
244 EA70 .proc SIOWaitForACK
245 ;setup 2 frame delay for ack
246 EA70 A2 FF ldx #$ff
247 EA72 8E 17 03 stx timflg
248 EA75 86 3C stx nocksm
249 EA77 E8 inx ;X=0
250 EA78 A9 01 lda #1
251 EA7A A0 02 ldy #2
252 EA7C 84 33 sty bufrhi ;>temp = 2
253 EA7E 84 35 sty bfenhi ;>temp+1 = 2
254 EA80 20 5C E4 jsr setvbv
255
256 ;setup for receiving ACK
257 EA83 A2 3E ldx #<temp
258 EA85 86 32 stx bufrlo
259 EA87 E8 inx
260 EA88 86 34 stx bfenlo ;#<[temp+1]
261
262 EA8A 20 4C EB jsr SIOReceive
263
264 ;check if we had a receive error
265 EA8D 30 09 bmi xit
266
267 ;check if we got an ACK
268 EA8F AD 3E 02 lda temp
269 EA92 C9 41 cmp #'A'
270 EA94 F0 02 beq xit
271
272 ;doh
273 EA96 A0 8B ldy #SIOErrorNAK
274 EA98 xit:
275 EA98 60 rts
276 .endp
277
278 ;==============================================================================
279 ;SIO send enable routine
280 ;
281 ; This is one of those routines that Atari inadvisably exposed in the OS jump
282 ; table even though they shouldn't. Responsibilities of this routine are:
283 ;
284 ; - Hit SKCTL to reset serial hardware and init for sending
285 ; - Hit SKRES to clear status
286 ; - Enable send interrupts
287 ; - Configure AUDF3/AUDF4 frequency (19200 baud or 600 baud)
288 ; - Set AUDC3/AUDC4 for noisy or non-noisy audio
289 ; - Set AUDCTL
290 ;
291 ; It does not init any of the SIO variables, only hardware/shadow state.
292 ;
293 = EAB8 SIOInitHardware = SIOSendEnable.init_hardware
294 EA99 .proc SIOSendEnable
295 ;enable serial output ready IRQ and suppress serial output complete IRQ
296 EA99 A5 10 lda pokmsk
297 EA9B 09 10 ora #$10
298 EA9D 29 F7 and #$f7
299 EA9F 85 10 sta pokmsk
300 EAA1 8D 0E D2 sta irqen
301
302 EAA4 no_irq_setup:
303 ;clear forced break mode and reset serial clocking mode to timer 4
304 ;synchronous; also enable two-tone mode if in cassette mode
305 EAA4 AD 32 02 lda sskctl
306 EAA7 29 0F and #$0f
307 EAA9 09 20 ora #$20
308 EAAB AE 0F 03 ldx casflg
309 EAAE F0 02 09 08 seq:ora #$08
310 EAB2 8D 32 02 sta sskctl
311 EAB5 8D 0F D2 sta skctl
312
313 EAB8 init_hardware:
314 ;clock channel 3 and 4 together at 1.79MHz
315 ;configure pokey timers 3 and 4 for 19200 baud (1789773/(2*40+7) = 19040)
316 EAB8 A2 08 ldx #8
317
318 ;check if we are doing a cassette transfer; if so, use the cassette
319 ;register table instead
320 EABA AD 0F 03 lda casflg
321 EABD F0 02 beq not_cassette
322
323 EABF A2 11 ldx #17
324
325 EAC1 not_cassette:
326
327 = EAC1 .def :SIOInitPOKEYWithRegOffsetX
328 ;load POKEY audio registers
329 EAC1 A0 08 ldy #8
330 EAC3 BD EC EA CA 99 00 + mva:rpl regdata_normal,x- audf1,y-
331
332 ;go noisy audio if requested
333 EACD A5 41 lda soundr
334 EACF F0 17 beq no_noise
335
336 EAD1 A9 A8 lda #$a8
337 EAD3 8D 07 D2 sta audc4
338 EAD6 AE 0F 03 ldx casflg
339 EAD9 F0 0D beq no_noise
340 EADB A9 10 lda #$10
341 EADD 2C 32 02 bit sskctl
342 EAE0 D0 06 bne no_noise
343 EAE2 8D 01 D2 sta audc1
344 EAE5 8D 03 D2 sta audc2
345
346 EAE8 no_noise:
347
348 ;reset serial status
349 EAE8 8D 0A D2 sta skres
350 EAEB 60 rts
351
352 EAEC regdata:
353 EAEC regdata_normal:
354 EAEC 00 dta $00 ;audf1
355 EAED A0 dta $a0 ;audc1
356 EAEE 00 dta $00 ;audf2
357 EAEF A0 dta $a0 ;audc2
358 EAF0 28 dta $28 ;audf3
359 EAF1 A0 dta $a0 ;audc3
360 EAF2 00 dta $00 ;audf4
361 EAF3 A0 dta $a0 ;audc4
362 EAF4 28 dta $28 ;audctl
363
364 EAF5 regdata_cassette_write:
365 EAF5 05 dta $05 ;audf1
366 EAF6 A0 dta $a0 ;audc1
367 EAF7 07 dta $07 ;audf2
368 EAF8 A0 dta $a0 ;audc2
369 EAF9 CC dta $cc ;audf3
370 EAFA A0 dta $a0 ;audc3
371 EAFB 05 dta $05 ;audf4
372 EAFC A0 dta $a0 ;audc4
373 EAFD 28 dta $28 ;audctl
374
375 EAFE regdata_cassette_read:
376 EAFE 00 dta $00 ;audf1
377 EAFF A0 dta $a0 ;audc1
378 EB00 00 dta $00 ;audf2
379 EB01 A0 dta $a0 ;audc2
380 EB02 CC dta $cc ;audf3
381 EB03 A0 dta $a0 ;audc3
382 EB04 05 dta $05 ;audf4
383 EB05 A0 dta $a0 ;audc4
384 EB06 28 dta $28 ;audctl
385 .endp
386
387 ;==============================================================================
388 EB07 .proc SIOSetupBufferPointers
389 EB07 18 clc
390 EB08 AD 04 03 lda dbuflo
391 EB0B 85 32 sta bufrlo
392 EB0D 6D 08 03 adc dbytlo
393 EB10 85 34 sta bfenlo
394 EB12 AD 05 03 lda dbufhi
395 EB15 85 33 sta bufrhi
396 EB17 6D 09 03 adc dbythi
397 EB1A 85 35 sta bfenhi
398 EB1C 60 rts
399 .endp
400
401 ;==============================================================================
402 ;SIO send routine
403 ;
404 EB1D .proc SIOSend
405 ;configure serial port for synchronous transmission
406 ;enable transmission IRQs
407 EB1D 78 sei
408 EB1E 20 99 EA jsr SIOSendEnable
409
410 EB21 A0 00 ldy #0
411 EB23 84 3A sty xmtdon
412 EB25 84 30 sty status
413 EB27 84 3B sty chksnt
414
415 ;send first byte and set checksum (must be atomic)
416 EB29 B1 32 lda (bufrlo),y
417 EB2B 8D 0D D2 sta serout
418 EB2E 85 31 sta chksum
419
420 ;unmask IRQs
421 EB30 58 cli
422
423 ;wait for transmit to complete or Break to be pressed
424 EB31 wait:
425 EB31 A5 11 lda brkkey
426 EB33 F0 06 beq break_detected
427 EB35 A5 3A lda xmtdon
428 EB37 F0 F8 beq wait
429 EB39 D0 04 bne send_completed
430
431 EB3B break_detected:
432 EB3B A0 80 ldy #$80
433 EB3D 84 30 sty status
434
435 EB3F send_completed:
436 ;shut off transmission IRQs
437 EB3F 78 sei
438 EB40 A5 10 lda pokmsk
439 EB42 29 E7 and #$e7
440 EB44 85 10 sta pokmsk
441 EB46 8D 0E D2 sta irqen
442 EB49 58 cli
443
444 ;we're done
445 EB4A 98 tya
446 EB4B 60 rts
447 .endp
448
449 ;==============================================================================
450 ; SIO receive routine
451 ;
452 ; The exit and entry paths of this routine are time critical when receiving
453 ; the Complete/Error byte and data frame since there may be no delay at all
454 ; in between. The exit path needs to exit with the receive IRQ hot but IRQs
455 ; masked; the entry path in turn needs to keep the IRQ enabled but not unmask
456 ; IRQs until ready to receive.
457 ;
458 EB4C .proc SIOReceive
459 EB4C A9 00 lda #0
460 EB4E use_checksum:
461 EB4E 85 31 sta chksum
462 EB50 A2 00 ldx #0
463 EB52 86 39 stx recvdn ;receive done flag = false
464 EB54 86 38 stx bufrfl ;buffer full flag = false
465 EB56 E8 inx
466 EB57 86 30 stx status ;set status to success (1)
467
468 ;configure serial port for asynchronous receive
469 ;enable receive IRQ
470 EB59 78 sei
471 EB5A AD 32 02 lda sskctl
472 EB5D 29 8F and #$8f
473 EB5F 09 10 ora #$10
474 EB61 8D 32 02 sta sskctl
475 EB64 8D 0F D2 sta skctl
476 EB67 A5 10 lda pokmsk
477 EB69 09 20 ora #$20
478 EB6B 85 10 sta pokmsk
479 EB6D 8D 0E D2 sta irqen
480 EB70 58 cli
481
482 ;Negate command line (if it isn't already negated).
483 ;
484 ;Note that we DON'T do this until we are entirely ready to receive,
485 ;because as soon as we do this we can get data.
486 EB71 A9 3C 8D 03 D3 mva #$3c pbctl
487
488 ;wait for receive to complete
489 EB76 wait:
490 EB76 AD 17 03 lda timflg ;check for timeout
491 EB79 F0 0B beq timeout ;bail if so
492 EB7B A4 30 ldy status ;check for another error code
493 EB7D 30 05 bmi error ;bail if so
494 EB7F A5 39 lda recvdn ;check for receive complete
495 EB81 F0 F3 beq wait ;keep waiting if not
496 EB83 98 tya ;set flags from status
497
498 EB84 error:
499 ;Mask interrupts, but exit with them masked. We do this in order to
500 ;handle the transition from Complete to data frame during receive. There
501 ;is no guaranteed device delay in between these and some disk drives
502 ;send back-to-back bytes. In addition, there are demos that have DLIs
503 ;active during SIO loads. Therefore, we avoid turning off the receive
504 ;interrupt and instead hold it off to give us the best chance of snagging
505 ;the first and second bytes successfully, even if delayed.
506 EB84 78 sei
507 EB85 60 rts
508
509 EB86 timeout:
510 EB86 A0 8A ldy #SIOErrorTimeout
511 EB88 78 sei
512 EB89 60 rts
513 .endp
514
515 ;==============================================================================
516 EB8A .proc SIOReceiveStop
517 ;shut off receive IRQs
518 EB8A A5 10 lda pokmsk
519 EB8C 29 D7 and #$d7
520 EB8E 85 10 sta pokmsk
521 EB90 8D 0E D2 sta irqen
522 EB93 58 cli
523 EB94 60 rts
524 .endp
525
526 ;==============================================================================
527 ; SIO serial input routine
528 ;
529 ; DOS 2.0S replaces (VSERIN), so it's critical that this routine follow the
530 ; rules compatible with DOS. The rules are as follows:
531 ;
532 ; BUFRLO/BUFRHI: Points to next byte to read. Note that this is different
533 ; from (VSEROR)!
534 ; BFENLO/BFENHI: Points one after last byte in buffer.
535 ; BUFRFL: Set when all data bytes have been read.
536 ; NOCKSM: Set if no checksum byte is expected. Cleared after checked.
537 ; RECVDN: Set when receive is complete, including any checksum.
538 ;
539 EB95 .proc SIOInputReadyHandler
540 EB95 A5 38 lda bufrfl
541 EB97 D0 2A bne receiveChecksum
542
543 ;receive data byte
544 EB99 98 tya
545 EB9A 48 pha
546 EB9B AD 0D D2 lda serin
547 EB9E A0 00 ldy #$00
548 EBA0 91 32 sta (bufrlo),y
549 EBA2 18 clc
550 EBA3 65 31 adc chksum
551 EBA5 69 00 adc #$00
552 EBA7 85 31 sta chksum
553
554 ;restore Y now
555 EBA9 68 pla
556 EBAA A8 tay
557
558 ;bump buffer pointer
559 EBAB E6 32 D0 02 E6 33 inw bufrlo
560
561 ;check for EOB
562 EBB1 A5 32 lda bufrlo
563 EBB3 C5 34 cmp bfenlo
564 EBB5 A5 33 lda bufrhi
565 EBB7 E5 35 sbc bfenhi
566 EBB9 90 06 bcc xit
567
568 EBBB C6 38 dec bufrfl ;!! - this was $00 coming in
569
570 ;should there be a checksum?
571 EBBD A5 3C lda nocksm
572 EBBF D0 15 bne skipChecksum
573 EBC1 xit:
574 EBC1 68 pla
575 EBC2 40 rti
576
577 EBC3 receiveChecksum:
578 ;read and compare checksum
579 EBC3 AD 0D D2 lda serin
580 EBC6 C5 31 cmp chksum
581 EBC8 D0 06 bne checksum_fail
582
583 EBCA signal_end:
584 ;set receive done flag
585 EBCA A9 FF 85 39 mva #$ff recvdn
586
587 ;exit
588 EBCE 68 pla
589 EBCF 40 rti
590
591 EBD0 checksum_fail:
592 EBD0 A9 8F lda #SIOErrorChecksum
593 EBD2 85 30 sta status
594 EBD4 D0 F4 bne signal_end ;!! - unconditional
595
596 EBD6 skipChecksum:
597 ;set receive done flag
598 EBD6 85 39 sta recvdn
599
600 ;clear no checksum flag
601 EBD8 A9 00 lda #0
602 EBDA 85 3C sta nocksm
603 EBDC 68 pla
604 EBDD 40 rti
605 .endp
606
607 ;==============================================================================
608 ; SIO serial output ready routine
609 ;
610 ; DOS 2.0S replaces (VSEROR), so it's critical that this routine follow the
611 ; rules compatible with DOS. The rules are as follows:
612 ;
613 ; BUFRLO/BUFRHI: On entry, points to one LESS than the next byte to write.
614 ; BFENLO/BFENHI: Points to byte immediately after buffer.
615 ; CHKSUM: Holds running checksum as bytes are output.
616 ; CHKSNT: $00 if checksum not yet sent, $FF if checksum sent.
617 ; POKMSK: Used to enable the serial output complete IRQ after sending
618 ; checksum.
619 ;
620 EBDE .proc SIOOutputReadyHandler
621 ;increment buffer pointer
622 EBDE E6 32 inc bufrlo
623 EBE0 D0 02 bne addrcc
624 EBE2 E6 33 inc bufrhi
625 EBE4 addrcc:
626
627 ;compare against buffer end
628 EBE4 A5 32 lda bufrlo
629 EBE6 C5 34 cmp bfenlo
630 EBE8 A5 33 lda bufrhi
631 EBEA E5 35 sbc bfenhi ;set flags according to (dst - end)
632 EBEC B0 13 bcs doChecksum
633
634 ;save Y
635 EBEE 98 tya
636 EBEF 48 pha
637
638 ;send out next byte
639 EBF0 A0 00 ldy #0
640 EBF2 B1 32 lda (bufrlo),y
641 EBF4 8D 0D D2 sta serout
642
643 ;update checksum
644 EBF7 65 31 adc chksum
645 EBF9 69 00 adc #0
646 EBFB 85 31 sta chksum
647
648 ;restore registers and exit
649 EBFD 68 pla
650 EBFE A8 tay
651 EBFF 68 pla
652 EC00 40 rti
653
654 EC01 doChecksum:
655 ;send checksum
656 EC01 A5 31 lda chksum
657 EC03 8D 0D D2 sta serout
658
659 ;set checksum sent flag
660 EC06 A9 FF 85 3B mva #$ff chksnt
661
662 ;enable output complete IRQ and disable serial output IRQ
663 EC0A A5 10 lda pokmsk
664 EC0C 09 08 ora #$08
665 EC0E 29 EF and #$ef
666 EC10 85 10 sta pokmsk
667 EC12 8D 0E D2 sta irqen
668
669 EC15 68 pla
670 EC16 40 rti
671 .endp
672
673 ;==============================================================================
674 EC17 .proc SIOOutputCompleteHandler
675 ;check that we've sent the checksum
676 EC17 A5 3B lda chksnt
677 EC19 F0 0B beq xit
678
679 ;we're done sending the checksum
680 EC1B 85 3A sta xmtdon
681
682 ;need to shut off this interrupt as it is not latched
683 EC1D A5 10 lda pokmsk
684 EC1F 29 F7 and #$f7
685 EC21 85 10 sta pokmsk
686 EC23 8D 0E D2 sta irqen
687
688 EC26 xit:
689 EC26 68 pla
690 EC27 40 rti
691 .endp
692
693 ;==============================================================================
694 EC28 .proc SIOCountdown1Handler
695 ;signal operation timeout
696 EC28 A9 00 8D 17 03 mva #0 timflg
697 EC2D 60 rts
698 .endp
699
700 ;==============================================================================
701 EC2E .proc SIOCassette
702 ;check if it's read sector
703 EC2E AD 02 03 lda dcomnd
704 EC31 C9 52 cmp #$52
705 EC33 F0 0F beq isread
706
707 ;check if it's put sector
708 EC35 C9 50 cmp #$50
709 EC37 F0 05 beq iswrite
710
711 ;nope, bail
712 EC39 A0 8B ldy #SIOErrorNAK
713 EC3B 4C 29 EA jmp SIO.xit
714
715 EC3E iswrite:
716 EC3E 20 4A EC jsr SIOCassetteWriteFrame
717 EC41 4C 29 EA jmp SIO.xit
718
719 EC44 isread:
720 EC44 20 5B EC jsr SIOCassetteReadFrame
721 EC47 4C 29 EA jmp SIO.xit
722 .endp
723
724 ;==============================================================================
725 EC4A .proc SIOCassetteWriteFrame
726 ;wait for pre-record write tone or IRG read delay
727 EC4A A2 02 ldx #2
728 EC4C 20 9D EF jsr CassetteWaitLongShortCheck
729
730 ;set up to transmit
731 EC4F 20 99 EA jsr SIOSendEnable
732
733 ;setup buffer pointers
734 EC52 20 07 EB jsr SIOSetupBufferPointers
735
736 ;send data frame
737 EC55 20 1D EB jsr SIOSend
738
739 ;all done
740 EC58 4C 29 EA jmp SIO.xit
741 .endp
742
743 ;==============================================================================
744 ; Read cassette frame
745 ;
746 ; Wait for long/short IRG, measure baud rate from sync mark, and read frame.
747 ;
748 ; When reading a cassette frame, the audio configuration is expected to be
749 ; as follows:
750 ;
751 ; Channel 1: Inaudible (31.5KHz)
752 ; Channel 2: Inaudible (31.5KHz)
753 ; Channel 3: Silent
754 ; Channel 4: Audible if enabled in SOUNDR (600Hz modulated by async read)
755 ;
756 ; This is necessary for proper tape loading sounds.
757 ;
758 EC5B .proc SIOCassetteReadFrame
759 ;wait for pre-record write tone or IRG read delay
760 EC5B A2 04 ldx #4
761 EC5D 20 9D EF jsr CassetteWaitLongShortCheck
762
763 ;set to 600 baud, turn on async read to shut off annoying tone
764 EC60 A2 1A ldx #SIOSendEnable.regdata_cassette_read-SIOSendEnable.regdata+8
765 EC62 20 C1 EA jsr SIOInitPOKEYWithRegOffsetX
766
767 EC65 AD 32 02 lda sskctl
768 EC68 29 8F and #$8f
769 EC6A 09 10 ora #$10
770 EC6C 8D 32 02 sta sskctl
771
772 ;set timeout (approx; no NTSC/PAL switching yet)
773 EC6F A9 FF 8D 17 03 mva #$ff timflg
774 EC74 A9 01 lda #1
775 EC76 A2 0E ldx #>3600
776 EC78 A0 10 ldy #<3600
777 EC7A 20 69 E8 jsr VBISetVector
778
779 ;wait for beginning of frame
780 EC7D A9 10 lda #$10 ;test bit 4 of SKSTAT
781 EC7F waitzerostart:
782 EC7F 2C 17 03 bit timflg
783 EC82 10 2B bpl timeout
784 EC84 2C 0F D2 bit skstat
785 EC87 D0 F6 bne waitzerostart
786
787 ;take first time measurement
788 EC89 20 49 ED jsr readtimer
789 EC8C 8C 0D 03 sty timer1+1
790 EC8F 8D 0C 03 sta timer1
791
792 ;wait for 19 bit transitions
793 EC92 A9 10 lda #$10 ;test bit 4 of SKSTAT
794 EC94 A2 0A ldx #10 ;test 10 pairs of bits
795 EC96 waitone:
796 EC96 2C 17 03 bit timflg
797 EC99 10 14 bpl timeout
798 EC9B 2C 0F D2 bit skstat
799 EC9E F0 F6 beq waitone
800 ECA0 CA dex
801 ECA1 F0 11 beq waitdone
802 ECA3 waitzero:
803 ECA3 2C 17 03 bit timflg
804 ECA6 10 07 bpl timeout
805 ECA8 2C 0F D2 bit skstat
806 ECAB D0 F6 bne waitzero
807 ECAD F0 E7 beq waitone
808
809 ECAF timeout:
810 ECAF A0 8A ldy #SIOErrorTimeout
811 ECB1 4C 29 EA jmp SIO.xit
812
813 ECB4 waitdone:
814
815 ;take second time measurement
816 ECB4 20 49 ED jsr readtimer
817 ECB7 8D 10 03 sta timer2
818 ECBA 8C 11 03 sty timer2+1
819
820 ;compute baud rate and adjust pokey divisor
821 ;
822 ; counts = (pal ? 156 : 131)*rtdelta + vdelta;
823 ; lines = counts * 2
824 ; lines_per_bit = lines / 19
825 ; cycles_per_bit = lines_per_bit * 114
826 ; pokey_divisor = cycles_per_bit / 2 - 7
827 ;
828 ; -or-
829 ;
830 ; pokey_divisor = counts * 2 * 114 / 19 / 2 - 7
831 ; = counts * 6 - 7
832 ;
833 ;16 bits at 600 baud is nominally 209 scanline pairs. This means that we
834 ;don't have to worry about more than two frames, which is at least 262
835 ;scanline pairs or less than 480 baud.
836
837 ;set frame height - 262 scanlines for NTSC, 312 for PAL
838 ECBD A2 83 ldx #131
839 ECBF AD 14 D0 lda pal
840 ECC2 4A lsr
841 ECC3 D0 02 A2 9C sne:ldx #156
842 ECC7 8E 15 03 stx temp3
843
844 ;compute line difference
845 ECCA AD 0C 03 lda timer1
846 ECCD 20 57 ED jsr correct_time
847 ECD0 85 34 sta bfenlo
848
849 ECD2 AD 10 03 lda timer2
850 ECD5 20 57 ED jsr correct_time
851 ECD8 18 clc ;!! this decrements one line from the line delta
852 ECD9 E5 34 sbc bfenlo
853 ECDB 85 34 sta bfenlo
854 ECDD A0 00 ldy #0
855 ECDF B0 01 88 scs:dey
856
857 ;compute frame difference
858 ECE2 AD 11 03 lda timer2+1
859 ECE5 38 ED 0D 03 sub timer1+1
860 ECE9 AA tax
861
862 ;accumulate frame difference
863 ECEA F0 0C beq no_frames
864 ECEC A5 34 lda bfenlo
865 ECEE add_frame_loop:
866 ECEE 18 clc
867 ECEF 6D 15 03 adc temp3
868 ECF2 90 01 C8 scc:iny
869 ECF5 CA dex
870 ECF6 D0 F6 bne add_frame_loop
871 ECF8 no_frames:
872 ECF8 84 35 sty bfenhi
873
874 ;compute lines*6 - 7 = (lines-1)*6 - 1
875 ECFA 0A asl ;(lines-1)*2 (lo)
876 ECFB 26 35 rol bfenhi ;(lines-1)*2 (hi)
877 ECFD 85 34 sta bfenlo
878 ECFF A4 35 ldy bfenhi ;
879 ED01 06 34 asl bfenlo ;(lines-1)*4 (lo)
880 ED03 26 35 rol bfenhi ;(lines-1)*4 (hi)
881 ED05 65 34 adc bfenlo ;(lines-1)*6 (lo)
882 ED07 AA tax ;
883 ED08 98 tya ;
884 ED09 65 35 adc bfenhi ;(lines-1)*6 (hi) (and c=0)
885 ED0B CA dex ;-1 line, bringing us to -7
886 ED0C 8E 04 D2 stx audf3
887 ED0F 8E EE 02 stx cbaudl
888 ED12 E8 inx
889 ED13 D0 02 E9 00 sne:sbc #0
890 ED17 8D 06 D2 sta audf4
891 ED1A 8D EF 02 sta cbaudh
892
893 ;kick pokey into init mode to reset serial input shift hw
894 ED1D AE 32 02 ldx sskctl
895 ED20 8A txa
896 ED21 29 FC and #$fc
897 ED23 8D 0F D2 sta skctl
898
899 ;reset serial port status
900 ED26 8D 0A D2 sta skres
901
902 ;re-enable serial input hw
903 ED29 8E 0F D2 stx skctl
904
905 ED2C 20 07 EB jsr SIOSetupBufferPointers
906
907 ;stuff two $55 bytes into the buffer, which we "read" above
908 ED2F A9 55 lda #$55
909 ED31 A0 00 ldy #0
910 ED33 A2 02 ldx #2
911 ED35 aaloop:
912 ED35 91 32 sta (bufrlo),y
913 ED37 E6 32 D0 02 E6 33 inw bufrlo
914 ED3D CA D0 F5 dex:bne aaloop
915
916 ;reset checksum for two $55 bytes and receive frame
917 ED40 0A asl
918 ED41 85 31 sta chksum
919
920 ED43 20 4E EB jsr SIOReceive.use_checksum
921 ED46 4C 8A EB jmp SIOReceiveStop
922
923 ;-------------------------------------------------------------------------
924 ; We have to be VERY careful when reading (RTCLOK+2, VCOUNT), because
925 ; the VBI can strike in between. First, we double-check RTCLOK+2 to see
926 ; if it has changed. If so, we retry the read. Second, we check if
927 ; VCOUNT=124, which corresponds to lines 248/249. This can correspond to
928 ; either before or after the VBI -- with CRITIC off the VBI ends around
929 ; (249, 20-50) -- so we don't know which side of the frame boundary we're
930 ; on.
931 ;
932 ED49 readtimer:
933 ED49 A4 14 ldy rtclok+2
934 ED4B AD 0B D4 lda vcount
935 ED4E C4 14 cpy rtclok+2
936 ED50 D0 F7 bne readtimer
937 ED52 C9 7C cmp #124
938 ED54 F0 F3 beq readtimer
939 ED56 60 rts
940
941 ED57 correct_time:
942 ED57 38 sec
943 ED58 E9 7C sbc #124
944 ED5A B0 03 bcs time_ok
945 ED5C 6D 15 03 adc temp3
946 ED5F time_ok:
947 ED5F 60 rts
948
949 .endp
950
249 ED60 _KERNEL_REPORT_MODULE_SIZE 'Serial Input/Output (SIO)', $EDEA-$E944
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', $EDEA-$E944, ')', ' ', 'Serial Input/Output (SIO)'
1 $ED60 -> $041B($04A6) Serial Input/Output (SIO)
3 = ED60 .def ?@_kernel_lastpt = *
Source: source/main.xasm
250
251 ED60 icl 'disk.s'
Source: source/Shared/disk.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Disk Routines
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ED60 .proc DiskInit
11 .if _KERNEL_XLXE
12 ;set disk sector size to 128 bytes
13 mwa #$80 dsctln
14 .endif
15 ED60 60 rts
16 .endp
17
18 ;==========================================================================
19 ; Disk handler routine (pointed to by DSKINV)
20 ;
21 ; Exit:
22 ; A = command byte (undocumented; required by Pooyan)
23 ; Y = status
24 ; N = 1 if error, 0 if success (high bit of Y)
25 ; C = 1 if command is >=$21 (undocumented; required by Arcade Machine)
26 ;
27 ED61 .proc DiskHandler
28 ED61 A9 31 8D 00 03 mva #$31 ddevic
29 ED66 A9 0F 8D 06 03 mva #$0f dtimlo
30
31 ;check for status command
32 ED6B AD 02 03 lda dcomnd
33 ED6E 8D 3B 02 sta ccomnd
34 ED71 C9 53 cmp #$53
35 ED73 D0 20 bne notStatus
36
37 ED75 A9 EA lda #<dvstat
38 ED77 8D 04 03 sta dbuflo
39 ED7A A9 02 lda #>dvstat
40 ED7C 8D 05 03 sta dbufhi
41 ED7F 0A asl ;hack to save a byte to get $04 since >dvstat is $02
42 ED80 8D 08 03 sta dbytlo
43 ED83 A9 00 lda #0
44 ED85 8D 09 03 sta dbythi
45
46 ED88 20 AD ED jsr do_read
47 ED8B 30 07 bmi xit
48
49 ;update format timeout
50 ED8D AE EC 02 8E 46 02 mvx dvstat+2 dsktim
51 ED93 AA tax
52 ED94 xit:
53 ED94 60 rts
54
55 ED95 notStatus:
56
57 ;set disk sector length
58 .if _KERNEL_XLXE
59 mwy dsctln dbytlo
60 .else
61 ED95 A0 80 8C 08 03 A0 + mwy #$80 dbytlo
62 .endif
63
64 ;check for put/write
65 .if _KERNEL_XLXE
66 cmp #$50
67 beq do_write
68 .endif
69 ED9F C9 57 cmp #$57
70 EDA1 F0 19 beq do_write
71
72 ;check for format, or else assume it's a read command ($52) or similar
73 EDA3 C9 21 cmp #$21
74 EDA5 D0 06 bne do_read
75
76 ;it's format... use the format timeout
77 EDA7 AD 46 02 8D 06 03 mva dsktim dtimlo
78
79 EDAD do_read:
80 EDAD A9 40 lda #$40
81 EDAF do_io:
82 EDAF 8D 03 03 sta dstats
83 EDB2 20 59 E4 jsr siov
84
85 ;load disk command back into A (required by Pooyan)
86 ;emulate compare against format command (required by Arcade Machine)
87 ;sort-of emulate compare against status (required by Micropainter)
88 EDB5 AD 02 03 lda dcomnd
89 EDB8 C0 00 cpy #0 ;!! Atari800WinPlus's SIO patch doesn't set STATUS
90 EDBA 38 sec
91 EDBB 60 rts
92
93 EDBC do_write:
94 EDBC A9 80 lda #$80
95 EDBE D0 EF bne do_io
96 .endp
252 EDC0 _KERNEL_REPORT_MODULE_SIZE 'Disk Handler', $EE78-$EDEA
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', $EE78-$EDEA, ')', ' ', 'Disk Handler'
1 $EDC0 -> $0060($008E) Disk Handler
3 = EDC0 .def ?@_kernel_lastpt = *
Source: source/main.xasm
253
254 EDC0 icl 'printer.s'
Source: source/Shared/printer.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Printer Handler
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 EDC0 .proc PrinterInit
12 ;set printer timeout to default
13 EDC0 A9 1E 8D 14 03 mva #30 ptimot
14 EDC5 60 rts
15 .endp
16
17 ;==========================================================================
18 EDC6 .proc PrinterOpen
19 ;check for sideways mode and compute line size
20 EDC6 A2 28 ldx #40
21 EDC8 A5 2B lda icax2z
22 EDCA C9 53 cmp #$53
23 EDCC D0 02 A2 1D sne:ldx #29
24 EDD0 8E DF 02 stx pbufsz
25
26 EDD3 A9 00 lda #0
27 EDD5 8D DE 02 sta pbpnt
28
29 EDD8 xit:
30 EDD8 A0 01 ldy #1
31 EDDA 60 rts
32 .endp
33
34 ;==========================================================================
35 = EDDB PrinterClose = _PrinterPutByte.close_entry
36 = EDE2 PrinterPutByte = _PrinterPutByte.put_entry
37
38 EDDB .proc _PrinterPutByte
39 EDDB close_entry:
40 ;check if we have anything in the buffer
41 EDDB AD DE 02 lda pbpnt
42
43 ;exit if buffer is empty
44 EDDE F0 F8 beq PrinterOpen.xit
45
46 ;fall through to put with EOL
47 EDE0 A9 9B lda #$9b
48
49 EDE2 put_entry:
50 ;preload buffer index (useful later)
51 EDE2 AE DE 02 ldx pbpnt
52
53 ;check for EOL
54 EDE5 C9 9B cmp #$9b
55 EDE7 F0 0E beq do_eol
56
57 ;mask off MSB
58 EDE9 29 7F and #$7f
59
60 ;put char and advance
61 EDEB 9D C0 03 sta prnbuf,x
62 EDEE E8 inx
63 EDEF 8E DE 02 stx pbpnt
64
65 ;check for end of line and exit if not
66 EDF2 EC DF 02 cpx pbufsz
67 EDF5 90 E1 bcc PrinterOpen.xit
68
69 ;fall through to EOL
70
71 EDF7 do_eol:
72 ;fill remainder of buffer with spaces
73 EDF7 A9 20 lda #$20
74 EDF9 fill_loop:
75 EDF9 EC DF 02 cpx pbufsz
76 EDFC B0 06 bcs fill_done
77 EDFE 9D C0 03 sta prnbuf,x
78 EE01 E8 inx
79 EE02 90 F5 bcc fill_loop
80 EE04 fill_done:
81
82 ;send line to printer
83 EE04 A0 0A ldy #10
84 EE06 B9 25 EE 99 FF 02 + mva:rne iocbdat-1,y ddevic-1,y-
85
86 ;empty buffer
87 EE0F 8C DE 02 sty pbpnt
88
89 ;set line length
90 EE12 8E 08 03 stx dbytlo
91
92 ;Compute AUX1 byte from length.
93 ;
94 ;Note that the OS manual is wrong -- this byte needs to go into AUX1 and
95 ;not AUX2 as the manual says.
96 ;
97 ; normal (40): 00101000 -> 01001110 ($4E 'N')
98 ; sideways (29): 00011101 -> 01010011 ($53 'S')
99 ; 010_1I1_
100 EE15 8A txa
101 EE16 29 15 and #%00010101
102 EE18 49 4E eor #%01001110
103 EE1A 8D 0A 03 sta daux1 ;set AUX1 to indicate width to device
104
105 ;send to printer and exit
106 EE1D do_io:
107 EE1D AD 14 03 8D 06 03 mva ptimot dtimlo
108 EE23 4C 59 E4 jmp siov
109
110 EE26 iocbdat:
111 EE26 40 dta $40 ;device
112 EE27 01 dta $01 ;unit
113 EE28 57 dta $57 ;command 'W'
114 EE29 80 dta $80 ;input/output mode (write)
115 EE2A C0 03 dta a(prnbuf) ;buffer address
116 EE2C 00 00 dta a(0) ;timeout
117 EE2E 00 00 dta a(0) ;buffer length
118 .endp
119
120 ;==============================================================================
121 EE30 .proc PrinterGetStatus
122 ;setup parameter block
123 EE30 A2 09 ldx #9
124 EE32 BD 47 EE 9D 00 03 + mva:rpl iocbdat,x ddevic,x-
125
126 ;issue status call
127 EE3B 20 1D EE jsr _PrinterPutByte.do_io
128 EE3E 30 06 bmi error
129
130 ;update timeout
131 EE40 AD EC 02 8D 14 03 mva dvstat+2 ptimot
132
133 EE46 error:
134 EE46 60 rts
135
136 EE47 iocbdat:
137 EE47 40 dta $40 ;device
138 EE48 01 dta $01 ;unit
139 EE49 53 dta $53 ;command 'S'
140 EE4A 40 dta $40 ;input/output mode (read)
141 EE4B EA 02 dta a(dvstat) ;buffer address
142 EE4D 00 00 dta a(0) ;timeout
143 EE4F 04 00 dta a(4) ;buffer length
144 .endp
145
146 ;==============================================================================
147 = E4CB PrinterGetByte = CIOExitNotSupported
148 = E4CB PrinterSpecial = CIOExitNotSupported
255 EE51 _KERNEL_REPORT_MODULE_SIZE 'Printer Handler', $EF41-$EE78
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', $EF41-$EE78, ')', ' ', 'Printer Handler'
1 $EE51 -> $0091($00C9) Printer Handler
3 = EE51 .def ?@_kernel_lastpt = *
Source: source/main.xasm
256
257 EE51 icl 'cassette.s'
Source: source/Shared/cassette.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Cassette tape support
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 EE51 .proc CassetteInit
12 ;Set CBAUDL/CBAUDH to $05CC, the nominal POKEY divisor for 600
13 ;baud. We don't care about this, but it's documented in the OS
14 ;Manual.
15 EE51 A9 CC 8D EE 02 A9 + mwa #$05CC cbaudl
16 EE5B 60 rts
17 .endp
18
19 ;==========================================================================
20 ; Cassette open routine.
21 ;
22 ; XL/XE OS behavior notes:
23 ; - Attempting to open for none (AUX1=$00) or read/write (AUX1=$0C)
24 ; results in a Not Supported error (146).
25 ; - Open for read gives one beep, while open for write gives two beeps.
26 ; - Break will break out of the wait.
27 ; - Ctrl+3 during the keypress causes an EOF error (!). This is a side
28 ; effect of reusing the keyboard handler.
29 ;
30 ; CSOPIV behavior:
31 ; - Does NOT set FTYPE (continuous mode flag).
32 ; - Sets read mode (WMODE).
33 ; - Does NOT require ICAX1Z or ICAX2Z to be set.
34 ;
35 = EE6F CassetteOpenRead = CassetteOpen.do_open_read
36 EE5C .proc CassetteOpen
37 ;stash continuous mode flag
38 EE5C A5 2B lda icax2z ;!! FIRST TWO BYTES CHECKED BY ARCHON
39 EE5E 85 3E sta ftype
40
41 ;check mode byte for read/write modes
42 EE60 A2 80 ldx #$80
43 EE62 A5 2A lda icax1z
44 EE64 29 0C and #$0c
45 EE66 C9 04 cmp #$04 ;read?
46 EE68 F0 05 beq found_read_mode
47 EE6A C9 08 cmp #$08 ;write?
48 EE6C F0 03 beq found_write_mode
49
50 ;invalid mode -- return not supported
51 EE6E 60 rts
52
53 EE6F do_open_read:
54 EE6F found_read_mode:
55 EE6F A2 00 ldx #$00
56 EE71 found_write_mode:
57 EE71 8E 89 02 stx wmode
58
59 ;set cassette buffer size to 128 bytes and mark it empty
60 EE74 A9 80 lda #$80
61 EE76 85 3D sta bptr
62 EE78 8D 8A 02 sta blim
63
64 ;clear EOF flag
65 EE7B 0A asl
66 EE7C 85 3F sta feof
67
68 ;request one beep for read, or two for write
69 EE7E 2C 89 02 bit wmode
70 EE81 10 05 bpl one_ping_only
71
72 EE83 06 3D asl bptr ;!! - set bptr=0 when starting write
73
74 EE85 20 C9 EF jsr CassetteBell
75
76 EE88 one_ping_only:
77 EE88 20 C9 EF jsr CassetteBell
78
79 ;wait for a key press
80 EE8B 20 66 FE jsr KeyboardGetByte
81 EE8E 30 20 bmi aborted
82
83 ;need to set up POKEY for writes now to write leader
84 EE90 2C 89 02 bit wmode
85 EE93 10 08 bpl no_write_init
86 EE95 A9 FF lda #$ff
87 EE97 8D 0F 03 sta casflg
88 EE9A 20 A4 EA jsr SIOSendEnable.no_irq_setup
89 EE9D no_write_init:
90
91 ;turn on motor (continuous mode or not)
92 EE9D A9 34 lda #$34
93 EE9F 8D 02 D3 sta pactl
94
95 ;wait for leader (9.6 seconds read, 19.2s write)
96 EEA2 A2 00 ldx #0
97 EEA4 2C 89 02 bit wmode
98 EEA7 30 02 A2 01 smi:ldx #1
99 EEAB 20 A3 EF jsr CassetteWait
100
101 ;all done
102 EEAE A0 01 ldy #1
103 EEB0 aborted:
104 EEB0 60 rts
105 .endp
106
107 ;==========================================================================
108 EEB1 .proc CassetteClose
109 ;check if we are in write mode
110 EEB1 AD 89 02 lda wmode ;!! FIRST TWO BYTES CHECKED BY ARCHON
111 EEB4 10 0A bpl notwrite
112
113 ;check if we have data to write
114 EEB6 A5 3D lda bptr
115 EEB8 F0 03 beq nopartial
116
117 ;flush partial record ($FA)
118 EEBA 20 22 EF jsr CassetteFlush
119
120 EEBD nopartial:
121 ;write EOF record ($FE)
122 EEBD 20 22 EF jsr CassetteFlush
123
124 EEC0 notwrite:
125 ;stop the motor
126 EEC0 A9 3C lda #$3c
127 EEC2 8D 02 D3 sta pactl
128
129 ;kill audio
130 EEC5 A0 00 ldy #0
131 EEC7 8C 01 D2 sty audc1
132 EECA 8C 03 D2 sty audc2
133 EECD 8C 07 D2 sty audc4
134
135 ;all done
136 EED0 C8 iny
137 EED1 60 rts
138 .endp
139
140 ;==========================================================================
141 EED2 .proc CassetteGetByte
142 ;check if we have an EOF condition
143 EED2 A5 3F lda feof ;!! FIRST TWO BYTES CHECKED BY ARCHON
144 EED4 D0 1D bne xit_eof
145
146 EED6 fetchbyte:
147 ;check if we can still fetch a byte
148 EED6 A6 3D ldx bptr
149 EED8 EC 8A 02 cpx blim
150 EEDB F0 08 beq nobytes
151
152 EEDD BD 00 04 lda casbuf+3,x
153 EEE0 E6 3D inc bptr
154 EEE2 A0 01 ldy #1
155 EEE4 60 rts
156
157 EEE5 nobytes:
158 ;fetch more bytes
159 EEE5 20 52 EF jsr CassetteReadBlock
160 EEE8 30 0B bmi error
161
162 ;check control byte
163 EEEA AD FF 03 lda casbuf+2
164 EEED C9 FE cmp #$fe
165 EEEF D0 05 bne noteofbyte
166
167 ;found $FE (EOF) - set flag and return EOF
168 EEF1 85 3F sta feof
169 EEF3 xit_eof:
170 EEF3 A0 88 ldy #CIOStatEndOfFile
171 EEF5 error:
172 EEF5 60 rts
173
174 EEF6 noteofbyte:
175 ;reset buffer ptr
176 EEF6 A2 00 86 3D mvx #0 bptr
177
178 ;assume full block first (128 bytes)
179 EEFA A2 80 ldx #$80
180
181 ;check if it actually is one
182 EEFC C9 FC cmp #$fc
183 EEFE D0 06 bne not_full_block
184
185 EF00 init_new_block:
186 ;reset block length and loop back
187 EF00 8E 8A 02 stx blim
188 EF03 4C D6 EE jmp fetchbyte
189
190 EF06 not_full_block:
191 ;check if we have a partial block
192 EF06 C9 FA cmp #$fa
193 EF08 D0 05 bne not_partial_block
194
195 ;set length of partial block and the jump to init+loop
196 EF0A AE 7F 04 ldx casbuf+130
197 EF0D B0 F1 bcs init_new_block
198
199 EF0F not_partial_block:
200 ;uh oh... bad control byte.
201 EF0F A0 A3 ldy #CIOStatFatalDiskIO
202 EF11 60 rts
203 .endp
204
205 ;==========================================================================
206 EF12 .proc CassettePutByte
207 ;put a byte into the buffer
208 EF12 A6 3D ldx bptr ;!! FIRST TWO BYTES CHECKED BY ARCHON
209 EF14 9D 00 04 sta casbuf+3,x
210
211 ;bump and check if it's time to write
212 EF17 E8 inx
213 EF18 86 3D stx bptr
214 EF1A EC 8A 02 cpx blim
215 EF1D B0 03 bcs CassetteFlush
216
217 ;all done
218 EF1F A0 01 ldy #1
219 EF21 60 rts
220 .endp
221
222 ;==========================================================================
223 EF22 .proc CassetteFlush
224 EF22 A9 00 lda #0
225
226 ;set control byte based on buffer level
227 EF24 A2 FE ldx #$fe ;empty -> EOF
228 EF26 A4 3D ldy bptr ;get buffer level
229 EF28 D0 08 bne not_empty ;skip not empty
230
231 ;clear buffer for EOF
232 EF2A 99 00 04 C8 10 FA sta:rpl casbuf+3,y+
233 EF30 30 0C bmi is_empty ;!! - unconditional
234
235 EF32 not_empty:
236 EF32 A2 FC ldx #$fc ;load complete code
237 EF34 CC 8A 02 cpy blim ;check if buffer is full
238 EF37 B0 05 bcs is_complete ;skip if so
239 EF39 A2 FA ldx #$fa ;load partial code
240 EF3B 8C 7F 04 sty casbuf+130 ;store level in last byte
241 EF3E is_complete:
242 EF3E is_empty:
243
244 ;store code
245 EF3E 8E FF 03 stx casbuf+2
246
247 ;reset buffer level
248 EF41 85 3D sta bptr
249
250 ;setup sync bytes
251 EF43 A9 55 lda #$55
252 EF45 8D FD 03 sta casbuf
253 EF48 8D FE 03 sta casbuf+1
254
255 ;issue write request and exit
256 EF4B A2 80 ldx #$80
257 EF4D A0 50 ldy #'P'
258 EF4F 4C 56 EF jmp CassetteDoIO
259 .endp
260
261 ;==========================================================================
262 = E4C9 CassetteGetStatus = CIOExitSuccess
263 = E4CB CassetteSpecial = CIOExitNotSupported
264
265 ;==========================================================================
266 ; CassetteDoIO
267 ;
268 ; X = DSTATS value
269 ; Y = SIO command byte
270 ;
271 ; Note that SOUNDR must take effect each time a cassette I/O operation
272 ; occurs.
273 ;
274 = EF56 CassetteDoIO = _CassetteDoIO.do_io
275 = EF52 CassetteReadBlock = _CassetteDoIO.read_block
276
277 EF52 .proc _CassetteDoIO
278 EF52 read_block:
279 EF52 A2 40 ldx #$40
280 EF54 A0 52 ldy #'R'
281 EF56 do_io:
282 ;start the motor if not already running
283 EF56 A9 34 lda #$34
284 EF58 8D 02 D3 sta pactl
285
286 ;set up SIO read/write
287 EF5B 8E 03 03 stx dstats
288 EF5E 8C 02 03 sty dcomnd
289 EF61 A9 FD 8D 04 03 A9 + mwa #casbuf dbuflo
290 EF6B A9 83 8D 08 03 A9 + mwa #131 dbytlo
291 EF75 A9 60 8D 00 03 mva #$60 ddevic
292 EF7A A9 00 8D 01 03 mva #0 dunit
293 EF7F A5 3E 8D 0B 03 mva ftype daux2
294
295 ;do it
296 EF84 20 59 E4 jsr siov
297
298 ;check if we are in continuous mode (again)
299 EF87 A5 3E lda ftype
300 EF89 30 0F bmi rolling_stop
301
302 ;not in continuous mode -- wait for post-write tone if writing
303 EF8B 2C 89 02 bit wmode
304 EF8E 10 05 bpl no_pwt
305 EF90 A2 06 ldx #6
306 EF92 20 A3 EF jsr CassetteWait
307 EF95 no_pwt:
308
309 ;stop the motor
310 EF95 A9 3C lda #$3c
311 EF97 8D 02 D3 sta pactl
312
313 EF9A rolling_stop:
314 EF9A A4 30 ldy status
315 EF9C 60 rts
316 .endp
317
318 ;==========================================================================
319 ;Entry:
320 ; X = delay type
321 ;
322 = EFA3 CassetteWait = CassetteWaitLongShortCheck.normal_entry
323 EF9D .proc CassetteWaitLongShortCheck
324 EF9D 2C 0B 03 bit daux2
325 EFA0 10 01 E8 spl:inx
326 EFA3 normal_entry:
327 EFA3 20 65 EA jsr SIOSetTimeoutVector
328 EFA6 BC BB EF ldy wait_table_lo,x
329 EFA9 BD C2 EF lda wait_table_hi,x
330 EFAC AA tax
331 EFAD A9 01 lda #1
332 EFAF 8D 17 03 sta timflg
333 EFB2 20 69 E8 jsr VBISetVector
334 EFB5 AD 17 03 D0 FB lda:rne timflg
335 EFBA 60 rts
336
337 EFBB wait_table_lo:
338 EFBB 80 dta <$0480 ;$00 - write file leader (19.2 seconds NTSC)
339 EFBC 40 dta <$0240 ;$01 - read leader delay (9.6 seconds NTSC)
340 EFBD B4 dta <$00B4 ;$02 - long pre-record write tone (3.0s NTSC)
341 EFBE 0F dta <$000F ;$03 - short pre-record write tone (0.25s NTSC)
342 EFBF 78 dta <$0078 ;$04 - long read IRG (2.0s NTSC)
343 EFC0 0A dta <$000A ;$05 - short read IRG (0.16s NTSC)
344 EFC1 3C dta <$003C ;$06 - post record gap (1s NTSC)
345
346 EFC2 wait_table_hi:
347 EFC2 04 dta >$0480 ;$00 - write file leader (19.2 seconds NTSC)
348 EFC3 02 dta >$0240 ;$01 - read leader delay (9.6 seconds NTSC)
349 EFC4 00 dta >$00B4 ;$02 - long pre-record write tone (3.0s NTSC)
350 EFC5 00 dta >$000F ;$03 - short pre-record write tone (0.25s NTSC)
351 EFC6 00 dta >$0078 ;$04 - long read IRG (2.0s NTSC)
352 EFC7 00 dta >$000A ;$05 - short read IRG (0.16s NTSC)
353 EFC8 00 dta >$003C ;$06 - post record gap (1s NTSC)
354 .endp
355
356 ;==========================================================================
357 ; Sound a bell using the console speaker (cassette version)
358 ;
359 ; Modified:
360 ; A, X, Y
361 ;
362 EFC9 .proc CassetteBell
363 EFC9 A0 00 ldy #0
364 EFCB 98 tya
365 EFCC soundloop:
366 EFCC A2 0A ldx #10
367 EFCE 48 pha
368 EFCF delay:
369 EFCF AD 0B D4 lda vcount
370 EFD2 CD 0B D4 F0 FB cmp:req vcount
371 EFD7 CA dex
372 EFD8 D0 F5 bne delay
373 EFDA 68 pla
374 EFDB 49 08 eor #$08
375 EFDD 8D 1F D0 sta consol
376 EFE0 D0 EA bne soundloop
377 EFE2 88 dey
378 EFE3 D0 E7 bne soundloop
379 EFE5 60 rts
380 .endp
258 EFE6 _KERNEL_REPORT_MODULE_SIZE 'Cassette Handler', $F0E3-$EF41
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', $F0E3-$EF41, ')', ' ', 'Cassette Handler'
1 $EFE6 -> $0195($01A2) Cassette Handler
3 = EFE6 .def ?@_kernel_lastpt = *
Source: source/main.xasm
259
260 .ifdef _KERNEL_816
261 icl 'init816.s'
262 .else
263 EFE6 icl 'init.s'
Source: source/Shared/init.s
1 ; Altirra - Atari 800/800XL emulator
2 ; Kernel ROM replacement - Initialization
3 ; Copyright (C) 2008-2019 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 .if _KERNEL_XLXE
11 .proc InitBootSignature
12 dta $5C,$93,$25
13 .endp
14 .endif
15
16 EFE6 .proc InitHandlerTable
17 EFE6 50 30 E4 dta c'P',a(printv)
18 EFE9 43 40 E4 dta c'C',a(casetv)
19 EFEC 45 00 E4 dta c'E',a(editrv)
20 EFEF 53 10 E4 dta c'S',a(screnv)
21 EFF2 4B 20 E4 dta c'K',a(keybdv)
22 .endp
23
24 EFF5 .nowarn .proc _InitReset
25 EFF5 run_diag:
26 ; start diagnostic cartridge
27 EFF5 6C FE BF jmp ($bffe)
28
29 = EFF8 .def :InitReset
30 ;mask interrupts and initialize CPU
31 EFF8 78 sei
32 EFF9 D8 cld
33 EFFA A2 FF ldx #$ff
34 EFFC 9A txs
35
36 .if _KERNEL_XLXE
37 ;wait for everything to stabilize (0.1s) (XL/XE only)
38 ldy #140
39 stabilize_loop:
40 dex:rne
41 dey
42 bne stabilize_loop
43
44 ;check for warmstart signature (XL/XE)
45 ldx #2
46 warm_check:
47 lda pupbt1,x
48 cmp InitBootSignature,x
49 bne cold_boot
50 dex
51 bpl warm_check
52
53 jmp InitWarmStart
54 .endif
55
56 = EFFD .def :InitColdStart
57 EFFD cold_boot:
58 ; 1. initialize CPU
59 EFFD 78 sei
60 EFFE D8 cld
61 EFFF A2 FF ldx #$ff
62 F001 9A txs
63
64 ; 2. clear warmstart flag
65 F002 E8 inx
66 F003 86 08 stx warmst
67
68 ; 3. test for diagnostic cartridge
69 F005 AD FC BF lda $bffc
70 F008 D0 17 bne not_diag
71 F00A A2 FF ldx #$ff
72 F00C EC FF BF cpx $bfff ;prevent diagnostic cart from activating if addr is $FFxx
73 F00F F0 10 beq not_diag
74 F011 8E FC BF stx $bffc
75 F014 CD FC BF cmp $bffc
76 F017 8D FC BF sta $bffc
77 F01A D0 05 bne not_diag
78
79 ; is it enabled?
80 F01C 2C FD BF bit $bffd
81 F01F 30 D4 bmi run_diag
82
83 F021 not_diag:
84
85 F021 20 70 F0 jsr InitHardwareReset
86
87 .if _KERNEL_XLXE
88 ;check for OPTION and enable BASIC (note that we do NOT set BASICF just yet)
89 lda #4
90 bit consol
91 beq no_basic
92
93 .ifdef _KERNEL_SOFTKICK
94 ldx #$fc
95 .else
96 ldx #$fd
97 .endif
98
99 ;check for keyboard present + SELECT or no keyboard + no SELECT and enable game if so
100 lda trig2 ;check keyboard present (1 = present)
101 asl
102 eor consol ;XOR against select (0 = pressed)
103 and #$02
104
105 .ifdef _KERNEL_SOFTKICK
106 seq:ldx #$be
107 .else
108 seq:ldx #$bf
109 .endif
110
111 stx portb ;enable GAME or BASIC
112
113 no_basic:
114 .endif
115
116 ; 4. measure memory -> tramsz
117 F024 20 9C F0 jsr InitMemory
118
119 ; 6. clear memory from $0008 up to [tramsz,0]
120 .ifdef _KERNEL_SOFTKICK
121 ldx #$50
122 .else
123 F027 A6 06 ldx tramsz
124 .endif
125 F029 A0 08 ldy #8
126 F02B A9 00 85 66 mva #0 a1
127 F02F 85 67 sta a1+1
128 F031 clearloop:
129 F031 91 66 C8 D0 FB sta:rne (a1),y+
130 F036 E6 67 inc a1+1
131 F038 CA dex
132 F039 D0 F6 bne clearloop
133
134 .if _KERNEL_XLXE
135 ;Blip the self test ROM for a second -- this is one way that Altirra detects
136 ;that Option has been used by the OS. The XL/XE OS does this as part of its
137 ;ROM checksum routine (which we don't bother with).
138 ldx portb
139 txa
140 and #$7f
141 sta portb
142 stx portb
143 .endif
144
145 ; 7. set dosvec to blackboard routine
146 .if _KERNEL_USE_BOOT_SCREEN
147 mwa #SelfTestEntry dosvec
148 .else
149 F03B A9 80 85 0A A9 E4 + mwa #Blackboard dosvec
150 .endif
151
152 ; 8. set coldstart flag
153 F043 CE 44 02 dec coldst ;!! coldst=0 from clear loop above, now $ff
154
155 .if _KERNEL_XLXE
156 ; set BASIC flag
157 lda portb
158 and #$02
159 sta basicf
160 .endif
161
162 ; 9. set screen margins
163 ; 10. initialize RAM vectors
164 ; 11. set misc database values
165 ; 12. enable IRQ interrupts
166 ; 13. initialize device table
167 ; 14. initialize cartridges
168 ; 15. use IOCB #0 to open screen editor (E)
169 ; 16. wait for VBLANK so screen is initialized
170 ; 17. do cassette boot, if it was requested
171 ; 18. do disk boot
172 ; 19. reset coldstart flag
173 ; 20. run cartridges or blackboard
174 F046 4C DA F0 jmp InitEnvironment
175 .endp
176
177 ;==============================================================================
178 F049 .proc InitWarmStart
179 ; A. initialize CPU
180 ;
181 ; Undocumented: Check if cold start completed (COLDST=0); if not, force
182 ; a cold start. ACTris 2.1 relies on this since its boot doesn't reset
183 ; COLDST. This is also required to work on Atari800WinPLus, which doesn't
184 ; clear memory on a cold start.
185 ;
186 F049 78 sei ;!! FIRST TWO BYTES CHECKED BY ARCHON
187 F04A AD 44 02 lda coldst
188 F04D D0 AE bne InitColdStart
189 F04F D8 cld
190 F050 A2 FF ldx #$ff
191 F052 9A txs
192
193 ; B. set warmstart flag
194 F053 86 08 stx warmst
195
196 ; reinitialize hardware without doing a full clear
197 F055 20 70 F0 jsr InitHardwareReset
198
199 .if _KERNEL_XLXE
200 ; reinitialize BASIC
201 lda basicf
202 sne:mva #$fd portb
203 .endif
204
205 ; C. check for diag, measure memory, clear hw registers
206 F058 20 9C F0 jsr InitMemory
207
208 ; D. zero 0010-007F and 0200-03EC (must not clear BASICF).
209 F05B A2 60 ldx #$60
210 F05D A9 00 lda #0
211 F05F 95 0F CA D0 FB sta:rne $0f,x-
212
213 F064 dbclear:
214 F064 9D 00 02 sta $0200,x
215 F067 9D ED 02 sta $02ed,x
216 F06A E8 inx
217 F06B D0 F7 bne dbclear
218
219 ; E. steps 9-16 above
220 ; F. if cassette boot was successful on cold boot, execute cassette init
221 ; G. if disk boot was successful on cold boot, execute disk init
222 ; H. same as steps 19 and 20
223 F06D 4C DA F0 jmp InitEnvironment
224 .endp
225
226 ;==============================================================================
227 F070 .proc InitHardwareReset
228 ; clear all hardware registers
229 F070 A0 00 ldy #0
230 F072 98 tya
231 F073 hwclear:
232 F073 99 00 D0 sta $d000,y
233 F076 99 00 D2 sta $d200,y
234 F079 99 00 D4 sta $d400,y
235 F07C C8 iny
236 F07D D0 F4 bne hwclear
237
238 ;initialize PIA
239 F07F A9 3C lda #$3c
240 F081 A2 38 ldx #$38
241
242 .ifdef _KERNEL_SOFTKICK
243 stx pactl ;switch to DDRA
244 sty porta ;portA -> input
245 sta pactl ;switch to IORA
246 sty porta ;portA -> $00
247 sta pbctl ;switch to IORB
248 dey
249 dey
250 sty portb ;portB -> $FE
251 stx pbctl ;switch to DDRB
252 iny
253 sty portb ;portB -> all output
254 sta pbctl ;switch to IORB
255 .elseif _KERNEL_XLXE
256 stx pactl ;switch to DDRA
257 sty porta ;portA -> input
258 sta pactl ;switch to IORA
259 sty porta ;portA -> $00
260 sta pbctl ;switch to IORB
261 dey
262 sty portb ;portB -> $FF
263 stx pbctl ;switch to DDRB
264 sty portb ;portB -> all output
265 sta pbctl ;switch to IORB
266 .else
267 F083 8E 02 D3 stx pactl ;switch to DDRA
268 F086 8E 03 D3 stx pbctl ;switch to DDRB
269 F089 8C 00 D3 sty porta ;portA -> input
270 F08C 8C 01 D3 sty portb ;portB -> input
271 F08F 8D 02 D3 sta pactl ;switch to IORA
272 F092 8D 03 D3 sta pbctl ;switch to IORB
273 F095 8C 00 D3 sty porta ;portA -> $00
274 F098 8C 01 D3 sty portb ;portB -> $00
275 .endif
276 F09B 60 rts
277 .endp
278
279 ;==============================================================================
280 F09C .proc InitMemory
281 ; 4. measure memory -> tramsz
282 F09C A0 00 ldy #$00
283 F09E 84 64 sty adress
284 F0A0 A2 02 ldx #$02
285 F0A2 pageloop:
286 F0A2 86 65 stx adress+1
287 F0A4 B1 64 lda (adress),y
288 F0A6 49 FF eor #$ff
289 F0A8 91 64 sta (adress),y
290 F0AA D1 64 cmp (adress),y
291 F0AC D0 09 bne notRAM
292 F0AE 49 FF eor #$ff
293 F0B0 91 64 sta (adress),y
294 F0B2 E8 inx
295
296 .if _KERNEL_XLXE
297 cpx #$c0
298 .else
299 F0B3 E0 D0 cpx #$d0
300 .endif
301
302 F0B5 D0 EB bne pageloop
303 F0B7 notRAM:
304 F0B7 86 06 stx tramsz
305
306 F0B9 60 rts
307 .endp
308
309 ;==============================================================================
310 F0BA .proc InitVectorTable1
311 F0BA 66 E7 dta a(IntExitHandler_None) ;$0200 VDSLST
312 F0BC 65 E7 dta a(IntExitHandler_A) ;$0202 VPRCED
313 F0BE 65 E7 dta a(IntExitHandler_A) ;$0204 VINTER
314 F0C0 65 E7 dta a(IntExitHandler_A) ;$0206 VBREAK
315 F0C2 CC FE dta a(KeyboardIRQ) ;$0208 VKEYBD
316 F0C4 95 EB dta a(SIOInputReadyHandler) ;$020A VSERIN
317 F0C6 DE EB dta a(SIOOutputReadyHandler) ;$020C VSEROR
318 F0C8 17 EC dta a(SIOOutputCompleteHandler) ;$020E VSEROC
319 F0CA 65 E7 dta a(IntExitHandler_A) ;$0210 VTIMR1
320 F0CC 65 E7 dta a(IntExitHandler_A) ;$0212 VTIMR2
321 F0CE 65 E7 dta a(IntExitHandler_A) ;$0214 VTIMR4
322 F0D0 CD E8 dta a(IrqHandler) ;$0216 VIMIRQ
323 F0D2 end:
324 .endp
325
326 F0D2 .proc InitVectorTable2
327 F0D2 1D E7 dta a(VBIStage1) ;$0222 VVBLKI
328 F0D4 61 E7 dta a(VBIExit) ;$0224 VVBLKD
329 F0D6 00 00 dta a(0) ;$0226 CDTMA1
330 .endp
331
332 F0D8 krpdel_table:
333 F0D8 30 28 dta 48,40
334
335 ;==============================================================================
336 F0DA .proc InitEnvironment
337 F0DA A5 06 8D E4 02 mva tramsz ramsiz
338
339 .if _KERNEL_XLXE
340 ; set warmstart signature -- must be done before cart init, because
341 ; SDX doesn't return.
342 ldx #3
343 mva:rne InitBootSignature-1,x pupbt1-1,x-
344 .endif
345
346 ; 9. set screen margins
347 F0DF A9 02 85 52 mva #2 lmargn
348 F0E3 A9 27 85 53 mva #39 rmargn
349
350 ;set PAL/NTSC flag (XL/XE only)
351 .if _KERNEL_XLXE
352 ldx #0
353 lda pal
354 ldy #6
355 and #$0e
356 bne is_ntsc
357 sne:inx
358 dey
359 is_ntsc:
360 stx palnts
361 sty keyrep
362 mva krpdel_table,x krpdel
363 .endif
364
365 ; 10. initialize RAM vectors
366
367 ;VDSLST-VIMIRQ
368 F0E7 A2 17 ldx #[.len InitVectorTable1]-1
369 F0E9 BD BA F0 9D 00 02 + mva:rpl InitVectorTable1,x vdslst,x-
370
371 ;VVBLKI-CDTMA1
372 F0F2 A2 05 ldx #[.len InitVectorTable2]-1
373 F0F4 BD D2 F0 9D 22 02 + mva:rpl InitVectorTable2,x vvblki,x-
374
375 F0FD A9 00 8D 36 02 A9 + mwa #KeyboardBreakIRQ brkky
376
377 ; 11. set misc database values
378 F107 A2 FF ldx #$ff
379 F109 86 11 stx brkkey
380 F10B E8 inx
381 F10C 8E E5 02 stx memtop
382 F10F 8E E7 02 stx memlo
383 F112 A5 06 8D E6 02 mva tramsz memtop+1
384 F117 A2 07 8E E8 02 mvx #$07 memlo+1
385
386 F11C 20 60 ED jsr DiskInit
387 F11F 20 91 F5 jsr ScreenInit
388 ;jsr DisplayInit
389 F122 20 4B FE jsr KeyboardInit
390
391 .if _KERNEL_PRINTER_SUPPORT
392 F125 20 C0 ED jsr PrinterInit
393 .endif
394
395 ; 13. initialize device table (HATABS has already been cleared)
396 ; NOTE: The R: emulation relies on this being before CIOINV is invoked.
397 F128 A2 0E ldx #14
398 F12A BD E6 EF 9D 1A 03 + mva:rpl InitHandlerTable,x hatabs,x-
399
400 ;jsr CassetteInit
401 F133 20 6E E4 jsr cioinv
402 F136 20 45 E9 jsr SIOInit
403 F139 20 7F E8 jsr IntInitInterrupts
404
405 ; check for START key, and if so, set cassette boot flag
406 F13C AD 1F D0 lda consol
407 F13F 29 01 and #1
408 F141 49 01 eor #1
409 F143 8D E9 03 sta ckey
410
411 .if _KERNEL_PBI_SUPPORT
412 jsr PBIScan
413 .endif
414
415 ; 12. enable IRQ interrupts
416 ;
417 ; We do this later than the original OS specification because the PBI scan needs
418 ; to happen with IRQs disabled (a PBI device with interrupts may not have been
419 ; inited yet) and that PBI scan in turn needs to happen after HATABS has been
420 ; set up. There's no harm in initing HATABS with interrupts masked, so we do so.
421
422 F146 58 cli
423
424 ; 14. initialize cartridges
425 F147 A9 00 85 07 mva #0 tstdat
426
427 .if !_KERNEL_XLXE
428 F14B AD FC 9F lda $9ffc
429 F14E D0 18 bne skipCartBInit
430 F150 AD FB 9F lda $9ffb
431 F153 AA tax
432 F154 49 FF eor #$ff
433 F156 8D FB 9F sta $9ffb
434 F159 CD FB 9F cmp $9ffb
435 F15C 8E FB 9F stx $9ffb
436 F15F F0 07 beq skipCartBInit
437 F161 20 11 F2 jsr InitCartB
438 F164 A9 01 85 07 mva #1 tstdat
439 F168 skipCartBInit:
440 .endif
441
442 F168 A9 00 85 06 mva #0 tramsz
443 F16C AD FC BF lda $bffc
444 F16F D0 18 bne skipCartAInit
445 F171 AD FB BF lda $bffb
446 F174 AA tax
447 F175 49 FF eor #$ff
448 F177 8D FB BF sta $bffb
449 F17A CD FB BF cmp $bffb
450 F17D 8E FB BF stx $bffb
451 F180 F0 07 beq skipCartAInit
452 F182 20 0E F2 jsr InitCartA
453 F185 A9 01 85 06 mva #1 tramsz
454 F189 skipCartAInit:
455
456 ; 15. use IOCB #0 ($0340) to open screen editor (E)
457 ;
458 ; NOTE: We _must_ leave $0C in the A register when invoking CIO. Pooyan
459 ; relies on $0C being left in CIOCHR after the last call to CIO before
460 ; disk boot!
461
462 F189 A9 03 8D 42 03 mva #$03 iccmd ;OPEN
463 F18E A9 14 8D 44 03 A9 + mwa #ScreenEditorName icbal
464 F198 A9 0C 8D 4A 03 mva #$0c icax1 ;read/write, no forced read
465 F19D A2 00 ldx #0
466 F19F 8E 4B 03 stx icax2 ;mode 0
467 F1A2 20 56 E4 jsr ciov
468
469 ; 16. wait for VBLANK so screen is initialized
470 F1A5 A5 14 lda rtclok+2
471 F1A7 waitvbl:
472 F1A7 C5 14 cmp rtclok+2
473 F1A9 F0 FC beq waitvbl
474
475 ;-------------------------------------------------------------------------
476 ; Pre-boot hook (AltirraOS-specific)
477 ;
478
479 .ifdef _KERNEL_PRE_BOOT_HOOK
480 jsr InitPreBootHook
481 .endif
482
483 ;-------------------------------------------------------------------------
484 ; Run cartridge/cassette/disk
485 ;
486
487 ; 17. do cassette boot, if it was requested
488 ; F. if cassette boot was successful on cold boot, execute cassette init
489
490 ; The cold boot path must check the warm start flag and switch paths if
491 ; necessary. SpartaDOS X relies on being able to set the warm start
492 ; flag from its cart init handler.
493 ;
494 ; Disk boot must be attempted after cassette boot. Besides support for
495 ; using DOS from tape-based software, this is also required by the tape
496 ; version of Fun With Spelling (featuring Heathcliff), which depends on
497 ; the SIO request causing the tape start vector to be invoked shortly
498 ; after VBI so it can do an unsafe screen swap.
499 ;
500
501 F1AB A5 08 lda warmst
502 F1AD D0 0B bne reinitcas
503
504 F1AF AD E9 03 lda ckey
505 F1B2 F0 0F beq postcasboot
506 F1B4 20 7B F2 jsr BootCassette
507 F1B7 4C C3 F1 jmp postcasboot
508
509 F1BA reinitcas:
510 F1BA A9 02 lda #2
511 F1BC 24 09 bit boot?
512 F1BE F0 03 beq postcasboot
513 F1C0 20 18 F2 jsr InitCassetteBoot
514 F1C3 postcasboot:
515
516 ;-------------------------------------------------------------------------
517 ; 18. do disk boot
518 ; G. if disk boot was successful on cold boot, execute disk init
519 ;
520 ; For 800 mode, we must check if either cart A or cart B is present,
521 ; doing a disk boot if either there are no carts or one of the carts
522 ; requests disk boot. For the XL/XE case, cart B doesn't exist and we
523 ; can simplify the logic.
524 ;
525
526 F1C3 A5 08 lda warmst
527 F1C5 D0 1D bne reinitDisk
528
529 .if !_KERNEL_XLXE
530
531 ;check if we have cart B
532 F1C7 A5 07 lda tstdat
533 F1C9 D0 06 bne have_cart_b
534
535 ;no cart B -- if no cart A either, do disk boot
536 F1CB A6 06 ldx tramsz ;cart A
537 F1CD F0 0F beq boot_disk
538 F1CF D0 07 bne have_cart_a
539
540 F1D1 have_cart_b:
541 ;have cart B - grab boot disk flag (bit 0)
542 F1D1 AD FD 9F lda $9ffd
543
544 ;merge cart A's flags if it is present
545 F1D4 A6 06 ldx tramsz
546 F1D6 F0 03 beq no_cart_a
547
548 F1D8 have_cart_a:
549 F1D8 0D FD BF ora $bffd
550
551 F1DB no_cart_a:
552 ;skip disk boot if neither cart requested it
553 F1DB 4A lsr
554 F1DC 90 0E bcc skip_disk_boot
555
556 .else
557
558 ;check for cart A requesting boot
559 lda tramsz
560 beq boot_disk
561
562 ;have cart A - boot disk if requested
563 lda $bffd
564 lsr
565 bcc skip_disk_boot
566
567 .endif
568
569 F1DE boot_disk:
570 F1DE 20 1C F2 jsr BootDisk
571 F1E1 4C EC F1 jmp post_disk_boot
572
573 F1E4 reinitDisk:
574 F1E4 A5 09 lda boot?
575 F1E6 4A lsr
576 F1E7 90 03 bcc skip_disk_boot
577 F1E9 20 15 F2 jsr InitDiskBoot
578
579 F1EC post_disk_boot:
580 .if _KERNEL_XLXE
581 ; (XL/XE only) do type 3 poll or reinit handlers
582 ; !! - must only do this if a disk boot occurs; Pole Position audio breaks if
583 ; we do this and hit SKCTL before booting the cart
584 lda warmst
585 bne reinit_handlers
586 jsr PHStartupPoll
587 jmp post_reinit
588 reinit_handlers:
589 jsr PHReinitHandlers
590 post_reinit:
591 .endif
592
593 F1EC skip_disk_boot:
594
595 ;-------------------------------------------------------------------------
596 ; H. same as steps 19 and 20
597 ; 19. reset coldstart flag
598
599 F1EC A2 00 ldx #0
600 F1EE 8E 44 02 stx coldst
601
602 ;-------------------------------------------------------------------------
603 ; 20. run cartridges or blackboard
604 ;
605 ; Weird quirk here: if the left cart is absent or doesn't request
606 ; cart start, and the right cart is present and also doesn't request
607 ; cart start, OS-B endlessly does disk boots instead of running (DOSVEC).
608 ; We don't emulate this behavior for now since in practice it just seems
609 ; useless, boot looping until DOS crashes. It is moot starting with the
610 ; 1200XL DOS due to support for cart B being dropped.
611 ;
612
613 ; try to boot cart A
614 F1F1 A9 04 lda #$04
615 F1F3 A6 06 ldx tramsz
616 F1F5 F0 08 beq NoBootCartA
617 F1F7 2C FD BF bit $bffd
618 F1FA F0 03 6C FA BF seq:jmp ($bffa)
619 F1FF NoBootCartA:
620
621 ; try to boot cart B
622 F1FF A6 07 ldx tstdat
623 F201 F0 08 beq NoBootCartB
624 F203 2C FD 9F bit $9ffd
625 F206 F0 03 6C FA 9F seq:jmp ($9ffa)
626 F20B NoBootCartB:
627
628 ; run blackboard
629 F20B 6C 0A 00 jmp (dosvec)
630
631 F20E InitCartA:
632 F20E 6C FE BF jmp ($bffe)
633
634 F211 InitCartB:
635 F211 6C FE 9F jmp ($9ffe)
636
637 F214 ScreenEditorName:
638 F214 45 dta c"E"
639
640 .endp
641
642 ;==============================================================================
643 F215 .proc InitDiskBoot
644 F215 6C 0C 00 jmp (dosini)
645 .endp
646
647 F218 .proc InitCassetteBoot
648 .endp
649 F218 6C 02 00 jmp (casini)
650
651 ;==============================================================================
652
653 F21B EA nop
264 .endif
265
266 F21C icl 'boot.s'
Source: source/Shared/boot.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Boot Code
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 ; Disk boot routine.
12 ;
13 ; Exit:
14 ; DBUFLO/DBUFHI = $0400 (Undoc; required by Ankh and the 1.atr SMB demo)
15 ; Last sector in $0400 (Undoc; required by Ankh)
16 ;
17 F21C .proc BootDisk
18 ;issue a status request first to see if the disk is active; if this
19 ;doesn't come back, don't bother trying to read
20 F21C A9 53 lda #$53
21 F21E 8D 02 03 sta dcomnd
22 F221 A2 01 ldx #1
23 F223 8E 01 03 stx dunit
24 F226 20 53 E4 jsr dskinv
25 F229 30 3C bmi xit
26
27 ;read first sector to $0400
28 F22B A2 01 ldx #1
29 F22D 8E 01 03 stx dunit
30 F230 8E 0A 03 stx daux1
31 F233 CA dex
32 F234 8E 04 03 stx dbuflo
33 F237 8E 0B 03 stx daux2
34 F23A A9 52 8D 02 03 mva #$52 dcomnd
35 F23F A9 04 8D 05 03 mva #$04 dbufhi
36 F244 20 53 E4 jsr dskinv
37 F247 30 1A bmi fail
38
39 F249 sector1_ok:
40 F249 A2 0C ldx #dosini
41 F24B 20 B6 F2 jsr BootInitHeaders
42
43 ;load remaining sectors
44 F24E sectorloop:
45 ;copy sector from $0400 to destination (required by Ankh; see above)
46 ;bump destination address for next sector copy
47 F24E 20 E3 F2 jsr BootCopyBlock
48
49 ;exit if this was the last sector (note that 0 means to load 256 sectors!)
50 F251 CE 41 02 dec dbsect
51 F254 F0 18 beq loaddone
52
53 ;increment sector (yes, this can overflow to 256)
54 F256 EE 0A 03 D0 03 EE + inw daux1
55
56 ;read next sector
57 F25E 20 53 E4 jsr dskinv
58
59 ;keep going if we succeeded
60 F261 10 EB bpl sectorloop
61
62 ;read failed
63 F263 fail:
64 F263 C0 8A cpy #SIOErrorTimeout
65 F265 D0 01 bne failmsg
66 F267 xit:
67 F267 60 rts
68
69 F268 failmsg:
70 .if _KERNEL_USE_BOOT_SCREEN
71 st_loop:
72 lda portb
73 eor #$80
74 sta portb
75 bmi sector1_ok
76 jsr BootScreen.boot_entry
77 jmp st_loop
78 .else
79 F268 20 F8 F2 jsr BootShowError
80 F26B 4C 1C F2 jmp BootDisk
81 .endif
82
83 F26E loaddone:
84 F26E 20 D3 F2 jsr BootRunLoader
85 F271 B0 F5 bcs failmsg
86
87 ;Diskette Boot Process, step 7 (p.161 of the OS Manual) is misleading. It
88 ;says that DOSVEC is invoked after DOSINI, but actually that should NOT
89 ;happen here -- it happens AFTER cartridges have had a chance to run.
90 ;This is necessary for BASIC to gain control before DOS goes to load
91 ;DUP.SYS.
92 F273 20 15 F2 jsr InitDiskBoot
93
94 ;Must not occur until after init routine is called -- SpartaDOS 3.2 does
95 ;an INC on this flag and never exits.
96 F276 A9 01 85 09 mva #1 boot?
97 F27A 60 rts
98 .endp
99
100
101 ;============================================================================
102
103 F27B .proc BootCassette
104 ;set continuous mode -- must do this as CSOPIV doesn't
105 F27B A9 80 lda #$80
106 F27D 85 3E sta ftype
107
108 ;open cassette device
109 F27F 20 7D E4 jsr csopiv
110
111 ;read first block
112 F282 20 7A E4 jsr rblokv
113 F285 30 24 bmi load_failure
114
115 F287 A2 02 ldx #casini
116 F289 20 B6 F2 jsr BootInitHeaders
117
118 F28C block_loop:
119 ;copy 128 bytes from CASBUF+3 ($0400) to destination
120 ;update destination pointer
121 F28C 20 E3 F2 jsr BootCopyBlock
122
123 ;read next block
124 ;we always need to do one more to catch the EOF block, which is
125 ;required by STDBLOAD2
126 F28F 20 7A E4 jsr rblokv
127 F292 30 17 bmi load_failure
128
129 F294 CE 41 02 dec dbsect
130 F297 D0 F3 bne block_loop
131
132 ;run loader
133 F299 20 D3 F2 jsr BootRunLoader
134
135 ;run cassette init routine
136 F29C 20 18 F2 jsr InitCassetteBoot
137
138 ;clear cassette boot key flag
139 F29F A9 00 lda #0
140 F2A1 8D E9 03 sta ckey
141
142 ;set cassette boot flag
143 F2A4 A9 02 85 09 mva #2 boot?
144
145 ;run application
146 F2A8 6C 0A 00 jmp (dosvec)
147
148 F2AB load_failure:
149 F2AB A9 00 lda #0
150 F2AD 8D E9 03 sta ckey
151 F2B0 20 B1 EE jsr CassetteClose
152 F2B3 4C F8 F2 jmp BootShowError
153 .endp
154
155 ;============================================================================
156 F2B6 .proc BootInitHeaders
157 ;copy the first four bytes to DFLAGS, DBSECT, and BOOTAD
158 F2B6 A0 FC ldy #$fc
159 F2B8 B9 04 03 99 44 01 + mva:rne $0400-$fc,y dflags-$fc,y+
160
161 ;copy boot address in BOOTAD to BUFADR
162 F2C1 85 16 sta bufadr+1
163 F2C3 AD 42 02 lda bootad
164 F2C6 85 15 sta bufadr
165
166 ;copy init vector
167 F2C8 AD 04 04 95 00 AD + mwa $0404 0,x
168 F2D2 60 rts
169 .endp
170
171 ;============================================================================
172 F2D3 .proc BootRunLoader
173 ;loader is at load address + 6
174 F2D3 AD 42 02 lda bootad
175 F2D6 18 69 05 add #$05
176 F2D9 AA tax
177 F2DA AD 43 02 lda bootad+1
178 F2DD 69 00 adc #0
179 F2DF 48 pha
180 F2E0 8A txa
181 F2E1 48 pha
182 F2E2 60 rts
183 .endp
184
185 ;============================================================================
186 F2E3 .proc BootCopyBlock
187 F2E3 A0 7F ldy #$7f
188 F2E5 B9 00 04 91 15 88 + mva:rpl $0400,y (bufadr),y-
189
190 F2ED A5 15 lda bufadr
191 F2EF 49 80 eor #$80
192 F2F1 85 15 sta bufadr
193 F2F3 30 02 E6 16 smi:inc bufadr+1
194 F2F7 60 rts
195 .endp
196
197 ;============================================================================
198
199 F2F8 .proc BootShowError
200 F2F8 A2 F5 ldx #$f5
201 F2FA msgloop:
202 F2FA 8A txa
203 F2FB 48 pha
204 F2FC BD 13 F2 lda errormsg-$f5,x
205 F2FF 20 A8 FA jsr EditorPutByte
206 F302 68 pla
207 F303 AA tax
208 F304 E8 inx
209 F305 D0 F3 bne msgloop
210 F307 60 rts
211
212 F308 errormsg:
213 F308 42 4F 4F 54 20 45 + dta 'BOOT ERROR',$9B
214 .endp
267 F313 _KERNEL_REPORT_MODULE_SIZE 'Monitor routines', $F3E4-$F0E3
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', $F3E4-$F0E3, ')', ' ', 'Monitor routines'
1 $F313 -> $032D($0301) Monitor routines
3 = F313 .def ?@_kernel_lastpt = *
Source: source/main.xasm
268
269 F313 icl 'screen.s'
Source: source/Shared/screen.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Screen Handler
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;Display list:
11 ; 24 blank lines (3 bytes)
12 ; initial mode line with LMS (3 bytes)
13 ; mode lines
14 ; LMS for modes >4 pages
15 ; wait VBL (3 bytes)
16 ;
17 ; total is 8-10 bytes + mode lines
18
19 ; These are the addresses produced by the normal XL/XE OS:
20 ;
21 ; Normal Split, coarse Split, fine
22 ; Mode DL PF TX DL PF TX DL PF TX
23 ; 0 9C20 9C40 9F60 9C20 9C40 9F60 9C1F 9C40 9F60
24 ; 1 9D60 9D80 9F60 9D5E 9D80 9F60 9D5D 9D80 9F60
25 ; 2 9E5C 9E70 9F60 9E58 9E70 9F60 9E57 9E70 9F60
26 ; 3 9E50 9E70 9F60 9E4E 9E70 9F60 9E4D 9E70 9F60
27 ; 4 9D48 9D80 9F60 9D4A 9D80 9F60 9D49 9D80 9F60
28 ; 5 9B68 9BA0 9F60 9B6A 9BA0 9F60 9B69 9BA0 9F60
29 ; 6 9778 97E0 9F60 9782 97E0 9F60 9781 97E0 9F60
30 ; 7 8F98 9060 9F60 8FA2 9060 9F60 8FA1 9060 9F60
31 ; 8 8036 8150 9F60 8050 8150 9F60 804F 8150 9F60
32 ; 9 8036 8150 9F60 8036 8150 9F60 8036 8150 9F60
33 ; 10 8036 8150 9F60 8036 8150 9F60 8036 8150 9F60
34 ; 11 8036 8150 9F60 8036 8150 9F60 8036 8150 9F60
35 ; 12 9B80 9BA0 9F60 9B7E 9BA0 9F60 9B7D 9BA0 9F60
36 ; 13 9D6C 9D80 9F60 9D68 9D80 9F60 9D67 9D80 9F60
37 ; 14 8F38 9060 9F60 8F52 9060 9F60 8F51 9060 9F60
38 ; 15 8036 8150 9F60 8050 8150 9F60 804F 8150 9F60
39 ;
40 ; *DL = display list (SDLSTL/SDLSTH)
41 ; *PF = playfield (SAVMSC)
42 ; *TX = text window (TXTMSC)
43 ;
44 ; From this, we can derive a few things:
45 ; - The text window is always 160 ($A0) bytes below the ceiling.
46 ; - The playfield is always positioned to have enough room for
47 ; the text window, even though this wastes a little bit of
48 ; memory for modes 1, 2, 3, 4, and 13. This means that the
49 ; PF address does not have to be adjusted for split mode.
50 ; - The display list and playfield addresses are sometimes
51 ; adjusted in order to avoid crossing 1K boundaries for the
52 ; display list (gr.7) and 4K boundaries for the playfield (gr.8).
53 ; However, these are fixed offsets -- adjusting RAMTOP to $9F
54 ; does not remove the DL padding in GR.7 and breaks GR.7/8.
55 ; - Fine-scrolled modes take one additional byte for the extra
56 ; mode 2 line. In fact, it displays garbage that is masked by
57 ; a DLI that sets COLPF1 equal to COLPF2. (!)
58 ;
59 ; You might ask, why bother replicating these? Well, there are a
60 ; number of programs that rely on the layout of the default screen
61 ; and break if the memory addressing is different, such as ForemXEP.
62
63 .macro _SCREEN_TABLES_2
64
65 ;Mode Type Res Colors ANTIC Mem(unsplit) Mem(split)
66 ; 0 Text 40x24 1.5 2 960+32 (4) 960+32 (4)
67 ; 1 Text 20x24 5 6 480+32 (2) 560+32 (3)
68 ; 2 Text 20x12 5 7 240+20 (2) 360+22 (2)
69 ; 3 Bitmap 40x24 4 8 240+32 (2) 360+32 (2)
70 ; 4 Bitmap 80x48 2 9 480+56 (3) 560+52 (3)
71 ; 5 Bitmap 80x48 4 A 960+56 (4) 960+52 (4)
72 ; 6 Bitmap 160x96 2 B 1920+104 (8) 1760+92 (8)
73 ; 7 Bitmap 160x96 4 D 3840+104 (16) 3360+92 (14)
74 ; 8 Bitmap 320x192 1.5 F 7680+202 (32) 6560+174 (27)
75 ; 9 Bitmap 80x192 16 F 7680+202 (32) 6560+174 (27)
76 ; 10 Bitmap 80x192 9 F 7680+202 (32) 6560+174 (27)
77 ; 11 Bitmap 80x192 16 F 7680+202 (32) 6560+174 (27)
78 ; 12 Text 40x24 5 4 960+32 (4) 960+32 (4)
79 ; 13 Text 40x12 5 5 480+20 (2) 560+24 (3)
80 ; 14 Bitmap 160x192 2 C 3840+200 (16) 3360+172 (14)
81 ; 15 Bitmap 160x192 4 E 7680+202 (32) 6560+172 (27)
82
83 ;==========================================================================
84 ;
85 .proc ScreenPlayfieldSizesLo
86 dta <($10000-$03C0) ;gr.0 960 bytes = 40*24 = 40*24
87 dta <($10000-$0280) ;gr.1 640 bytes = 20*24 + 40*4 = 40*12 + 40*4
88 dta <($10000-$0190) ;gr.2 400 bytes = 10*24 + 40*4 = 40*6 + 40*4
89 dta <($10000-$0190) ;gr.3 400 bytes = 10*24 + 40*4 = 40*6 + 40*4
90 dta <($10000-$0280) ;gr.4 640 bytes = 10*48 + 40*4 = 40*12 + 40*4
91 dta <($10000-$0460) ;gr.5 1120 bytes = 20*48 + 40*4 = 40*24 + 40*4
92 dta <($10000-$0820) ;gr.6 2080 bytes = 20*96 + 40*4 = 40*48 + 40*4
93 dta <($10000-$0FA0) ;gr.7 4000 bytes = 40*96 + 40*4 = 40*96 + 40*4
94 dta <($10000-$1EB0) ;gr.8 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
95 dta <($10000-$1EB0) ;gr.9 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
96 dta <($10000-$1EB0) ;gr.10 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
97 dta <($10000-$1EB0) ;gr.11 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
98 dta <($10000-$0460) ;gr.12 1120 bytes = 40*24 + 40*4 = 40*24 + 40*4
99 dta <($10000-$0280) ;gr.13 640 bytes = 40*12 + 40*4 = 40*12 + 40*4
100 dta <($10000-$0FA0) ;gr.14 4000 bytes = 20*192 + 40*4 = 40*96 + 40*4
101 dta <($10000-$1EB0) ;gr.15 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
102 .endp
103
104 .proc ScreenPlayfieldSizesHi
105 dta >($10000-$03C0) ;gr.0
106 dta >($10000-$0280) ;gr.1
107 dta >($10000-$0190) ;gr.2
108 dta >($10000-$0190) ;gr.3
109 dta >($10000-$0280) ;gr.4
110 dta >($10000-$0460) ;gr.5
111 dta >($10000-$0820) ;gr.6
112 dta >($10000-$0FA0) ;gr.7
113 dta >($10000-$1EB0) ;gr.8
114 dta >($10000-$1EB0) ;gr.9
115 dta >($10000-$1EB0) ;gr.10
116 dta >($10000-$1EB0) ;gr.11
117 dta >($10000-$0460) ;gr.12
118 dta >($10000-$0280) ;gr.13
119 dta >($10000-$0FA0) ;gr.14
120 dta >($10000-$1EB0) ;gr.15
121 .endp
122
123 ;==========================================================================
124 ; ANTIC mode is in bits 0-3, PRIOR bits in 6-7.
125 ; DL 1K hop: bit 4
126 ; playfield 4K hop: bit 5
127 ;
128 .proc ScreenModeTable
129 dta $02,$06,$07,$08,$09,$0A,$0B,$1D,$3F,$7F,$BF,$FF,$04,$05,$1C,$3E
130 .endp
131
132 ;==========================================================================
133 ;
134 .proc ScreenHeightShifts
135 dta 1
136 dta 1
137 dta 0
138 dta 1
139 dta 2
140 dta 2
141 dta 3
142 dta 3
143 dta 4
144 dta 4
145 dta 4
146 dta 4
147 dta 1
148 dta 0
149 dta 4
150 dta 4
151 .endp
152
153 .proc ScreenHeights
154 dta 12, 24, 48, 96, 192
155 .endp
156
157 .proc ScreenPixelWidthIds
158 dta 1 ;gr.0 40 pixels
159 dta 0 ;gr.1 20 pixels
160 dta 0 ;gr.2 20 pixels
161 dta 1 ;gr.3 40 pixels
162 dta 2 ;gr.4 80 pixels
163 dta 2 ;gr.5 80 pixels
164 dta 3 ;gr.6 160 pixels
165 dta 3 ;gr.7 160 pixels
166 dta 4 ;gr.8 320 pixels
167 dta 2 ;gr.9 80 pixels
168 dta 2 ;gr.10 80 pixels
169 dta 2 ;gr.11 80 pixels
170 dta 1 ;gr.12 40 pixels
171 dta 1 ;gr.13 40 pixels
172 dta 3 ;gr.14 160 pixels
173 dta 3 ;gr.15 160 pixels
174 .endp
175 .endm
176
177 = F9C7 ScreenHeightsSplit = ScreenWidths
178 ; dta 10, 20, 40, 80, 160
179
180 = F9C8 ScreenPixelWidthsLo = ScreenWidths + 1
181
182 .macro _SCREEN_TABLES_1
183
184 .proc ScreenWidths
185 dta <10
186 dta <20
187 dta <40
188 dta <80
189 dta <160
190 dta <320
191 .endp
192
193 .proc ScreenPixelWidthsHi
194 dta >20
195 dta >40
196 dta >80
197 dta >160
198 dta >320
199 .endp
200
201 .proc ScreenEncodingTab
202 dta 0 ;gr.0 direct bytes
203 dta 0 ;gr.1 direct bytes
204 dta 0 ;gr.2 direct bytes
205 dta 2 ;gr.3 two bits per pixel
206 dta 3 ;gr.4 one bit per pixel
207 dta 2 ;gr.5 two bits per pixel
208 dta 3 ;gr.6 one bit per pixel
209 dta 2 ;gr.7 two bits per pixel
210 dta 3 ;gr.8 one bit per pixel
211 dta 1 ;gr.9 four bits per pixel
212 dta 1 ;gr.10 four bits per pixel
213 dta 1 ;gr.11 four bits per pixel
214 dta 0 ;gr.12 direct bytes
215 dta 0 ;gr.13 direct bytes
216 dta 3 ;gr.14 one bit per pixel
217 dta 2 ;gr.15 two bits per pixel
218 .endp
219
220 .proc ScreenPixelMasks
221 dta $ff, $0f, $03, $01, $ff, $f0, $c0, $80
222 .endp
223 .endm
224
225 .macro _SCREEN_TABLES_3
226 .proc ScreenEncodingTable
227 dta $00,$11,$22,$33,$44,$55,$66,$77,$88,$99,$aa,$bb,$cc,$dd,$ee,$ff
228 dta $00,$55,$aa,$ff
229 dta $00,$ff
230 .endp
231 .endm
232
233 .if _KERNEL_XLXE
234 _SCREEN_TABLES_3
235 _SCREEN_TABLES_2
236 _SCREEN_TABLES_1
237 .endif
238
239 ;==========================================================================
240 ;==========================================================================
241
242 ;Many compilation disks rely on ScreenOpen being at $F3F6.
243
244 .if *>$f3f6-8
245 .error 'ROM overflow into Screen Handler region: ',*,' > $F3EE.'
246 .endif
247
248 .ifdef _KERNEL_REPORT_MODULE_PAD_ADJUST
249 F313 _KERNEL_REPORT_MODULE_PAD_ADJUST [$f3f6-8]-*
Macro: _KERNEL_REPORT_MODULE_PAD_ADJUST [Source: source/main.xasm]
1 = F3EE .def ?@_kernel_lastpt = ?@_kernel_lastpt + [$F3F6-8]-*
Source: source/Shared/screen.s
250 .endif
251
252 F313 org $f3f6-8
253
254 ;==========================================================================
255 ;==========================================================================
256
257 ;==========================================================================
258 ;
259 ; Return:
260 ; MEMTOP = first byte used by display
261 ;
262 ; Errors:
263 ; - If there is not enough memory (MEMTOP > APPMHI), GR.0 is reopened
264 ; automatically and an error is returned.
265 ;
266 ; Notes:
267 ; - Resets character base (CHBAS).
268 ; - Resets character attributes (CHACT).
269 ; - Resets playfield colors (COLOR0-COLOR4).
270 ; - Resets tab map, even if the mode does not have a text window.
271 ; - Resets logical line map, even if the mode does not have a text window.
272 ; - Does NOT reset P/M colors (PCOLR0-PCOLR3).
273 ; - Does NOT reset margins (LMARGN/RMARGN).
274 ; - Sets up fine scrolling if FINE bit 7 is set. Note that this is
275 ; different than the scroll logic itself, which tests the whole byte.
276 ; - Returns error $80 if BREAK has been pressed.
277 ; - If clear is bypassed, ROWCRS and COLCRS are preserved.
278 ;
279 ; Modified:
280 ; - FRMADR: used for bitflags
281 ; bit 7 = skip clear
282 ; bit 6 = split screen
283 ; bit 0 = fine scrolling (XL/XE only)
284 ; - ADRESS: temporary addressing
285 ;
286 = F3F6 ScreenOpen = ScreenOpenGr0.use_iocb
287 = F3F2 ScreenOpenMode0 = ScreenOpenGr0.use_mode0
288 F3EE .proc ScreenOpenGr0
289 F3EE A9 0C 85 2A mva #12 icax1z
290 F3F2 use_mode0:
291 F3F2 A9 00 85 2B mva #0 icax2z
292 F3F6 use_iocb:
293 ;shut off ANTIC playfield and instruction DMA
294 F3F6 AD 2F 02 lda sdmctl
295 F3F9 29 DC and #$dc
296 F3FB 8D 2F 02 sta sdmctl
297 F3FE 8D 00 D4 sta dmactl
298
299 ;reset cursor parameters
300 F401 A2 0B ldx #11
301 F403 A9 00 lda #0
302 F405 clear_parms:
303 F405 95 54 sta rowcrs,x
304 F407 9D 90 02 sta txtrow,x
305 F40A CA dex
306 F40B D0 F8 bne clear_parms
307
308 ;mark us as being in main screen context
309 F40D 86 7B stx swpflg
310
311 ;copy mode value to dindex
312 F40F A5 2B lda icax2z
313 F411 29 0F and #15
314 F413 85 57 sta dindex
315 F415 AA tax
316
317 ;poke PRIOR value (saves us some time to do it now)
318 ;note that we must preserve bits 0-5 of GPRIOR or else Wayout shows logo artifacts
319 F416 BD 16 FE lda ScreenModeTable,x
320 F419 4D 6F 02 eor gprior
321 F41C 29 C0 and #$c0
322 F41E 4D 6F 02 eor gprior
323 F421 8D 6F 02 sta gprior
324
325 ;if a GTIA mode is active or we're in mode 0, force off split mode
326 F424 C9 40 cmp #$40
327 F426 A5 2A lda icax1z
328 F428 B0 04 bcs kill_split
329 F42A E0 00 cpx #0
330 F42C D0 02 bne not_gtia_mode_or_gr0
331 F42E kill_split:
332 F42E 29 EF and #$ef
333 F430 not_gtia_mode_or_gr0:
334
335 ;save off the split screen and clear flags in a more convenient form
336 F430 0A asl
337 F431 0A asl
338 F432 85 68 sta frmadr
339
340 ;compute number of mode lines that we're going to have and save it off
341 F434 BC 26 FE ldy ScreenHeightShifts,x
342 F437 BE 36 FE ldx ScreenHeights,y
343 F43A 0A asl
344 F43B 10 03 BE C7 F9 spl:ldx ScreenHeightsSplit,y
345 F440 86 69 stx frmadr+1
346
347 ;attempt to allocate playfield memory
348 F442 A5 6A lda ramtop
349 F444 A6 57 ldx dindex
350 F446 18 clc
351 F447 7D 06 FE adc ScreenPlayfieldSizesHi,x
352 F44A B0 09 bcs pf_alloc_ok
353
354 F44C alloc_fail:
355 ;we ran out of memory -- attempt to reopen with gr.0 if we aren't
356 ;already (to prevent recursion), and exit with an error
357 F44C 8A txa
358 F44D F0 03 beq cant_reopen_gr0
359
360 F44F 20 EE F3 jsr ScreenOpenGr0
361 F452 cant_reopen_gr0:
362 F452 A0 93 ldy #CIOStatOutOfMemory
363 F454 60 rts
364
365 F455 pf_alloc_ok:
366 F455 85 59 sta savmsc+1
367 F457 BC F6 FD ldy ScreenPlayfieldSizesLo,x
368 F45A 84 58 sty savmsc
369
370 ;Gr. modes 7 and 14 consume enough space for the playfield that there
371 ;is not enough space left between the playfield and the next 1K
372 ;boundary to contain the display list. In these cases, we preallocate
373 ;to the 1K boundary to prevent a DL crossing error. Gr.8-11 and 15
374 ;do this too -- I have no idea why, as it's not like the OS correctly
375 ;handles moving the 4K page split for those modes if RAMTOP is
376 ;misaligned.
377 F45C BD 16 FE lda ScreenModeTable,x
378 F45F A6 59 ldx savmsc+1
379 F461 29 30 and #$30
380 F463 F0 03 beq no_dlist_page_crossing
381 F465 A0 00 ldy #0
382 F467 CA dex
383 F468 no_dlist_page_crossing:
384 F468 84 70 sty rowac
385 F46A 8E E6 02 stx memtop+1
386 F46D 86 71 stx rowac+1
387 F46F 8E 31 02 stx sdlsth
388
389 ;Compute display list size.
390 ;
391 ; We need:
392 ; - 8 fixed bytes (24 blank lines, LMS address, JVB)
393 ; - N bytes for mode lines
394 ; - 2 bytes for LMS split address (ANTIC modes E-F only)
395 ; - 6 bytes for split
396 ;
397 ;Note that the display list never crosses a page boundary. This is
398 ;conservative, as the display list only can't cross 1K boundaries.
399
400 F472 C9 20 cmp #$20 ;test 4K hop bit (bit 5)
401 F474 A9 F8 lda #$f8 ;start with -8 (if carry is clear after test)
402 F476 90 02 A9 F5 scc:lda #$f5 ;use -11 if so (carry is set)
403 F47A E5 69 sbc frmadr+1 ;subtract mode line count
404 F47C 24 68 bit frmadr
405 F47E 50 02 E9 06 svc:sbc #6 ;subtract 6 bytes for a split
406
407 .if _KERNEL_XLXE
408 ldy #1
409 cpy fine ;clear carry to alloc +1 byte if fine scrolling is enabled
410 .endif
411
412 F482 65 70 adc rowac ;allocate dl bytes (note that carry is set!)
413 F484 8D E5 02 sta memtop
414 F487 85 70 sta rowac
415 F489 8D 30 02 sta sdlstl
416
417 ;check if we're below APPMHI
418 F48C E4 0F cpx appmhi+1
419 F48E 90 BC bcc alloc_fail
420 F490 D0 04 bne alloc_ok
421 F492 C5 0E cmp appmhi
422 F494 90 B6 bcc alloc_fail
423
424 F496 alloc_ok:
425 ;MEMTOP is -1 from first used byte; we cheat here with the knowledge that
426 ;the low byte of MEMTOP is never $00
427 F496 CE E5 02 dec memtop
428
429 ;set up text window address (-160 from top)
430 F499 A6 6A ldx ramtop
431 F49B CA dex
432 F49C 8E 95 02 stx txtmsc+1
433 F49F A9 60 8D 94 02 mva #$60 txtmsc
434
435 ;Turn on keyboard and break interrupts; note that this is done both for S:
436 ;and E: opens. Close does not do this.
437 F4A4 08 php
438 F4A5 78 sei
439 F4A6 0A asl ;!! - A = $C0
440 F4A7 05 10 ora pokmsk
441 F4A9 85 10 sta pokmsk
442 F4AB 8D 0E D2 sta irqen
443 F4AE 28 plp
444
445 ;Set row count: 24 for full-screen. We will fix up the split case to 4 later
446 ;while we are writing the display list. Mapping the Atari incorrectly states
447 ;that this value is set to 0 when no text window is present; this is wrong
448 ;and in fact BAYPILOT.BAS relies on this being set to 24 for a GR.7+16
449 ;screen since it later aliases it to GR.0.
450 F4AF A0 18 ldy #24
451 F4B1 8C BF 02 sty botscr
452
453 ;init colors -- note that we do NOT overwrite pcolr0-3!
454 F4B4 A0 05 ldy #5
455 F4B6 B9 88 F5 99 C3 02 + mva:rne standard_colors-1,y color0-1,y-
456
457 F4BF 8C F0 02 sty crsinh ;!! - Y=0 for this and for write index
458
459 ;add 24 blank lines
460 F4C2 A9 70 lda #$70
461 F4C4 A2 03 ldx #3
462 F4C6 20 6D F5 jsr write_repeat
463
464 ;override COLOR4 (background) to $06 for GR.11 so it isn't dark
465 F4C9 A5 57 lda dindex
466 F4CB C9 0B cmp #11
467 F4CD D0 05 bne not_gr11
468 F4CF A9 06 lda #$06
469 F4D1 8D C8 02 sta color4
470 F4D4 not_gr11:
471
472 ;add in the main screen
473 F4D4 20 32 F5 jsr setup_display
474
475 ;save off the DL ptr
476 F4D7 84 7E sty countr
477
478 ;clear it if necessary
479 F4D9 20 82 F5 jsr try_clear
480
481 ;check if we are doing a split
482 F4DC 24 68 bit frmadr
483 F4DE 50 12 bvc nosplit
484
485 ;change text screen height to four lines
486 F4E0 A2 04 ldx #4
487 F4E2 8E BF 02 stx botscr
488
489 ;swap to the text screen
490 F4E5 20 0A F9 jsr EditorSwapToText
491
492 ;add text screen dlist
493 F4E8 A4 7E ldy countr
494 F4EA 20 32 F5 jsr setup_display
495 F4ED 84 7E sty countr
496
497 ;clear the split screen
498 F4EF 20 82 F5 jsr try_clear
499
500 F4F2 nosplit:
501 F4F2 A9 02 8D F3 02 mva #2 chact
502
503 ;init tab map to every 8 columns
504 F4F7 A2 0F ldx #15
505 F4F9 4A lsr ;!! A=1
506 F4FA 9D A2 02 CA D0 FA sta:rne tabmap-1,x-
507
508 ;reset line status
509 F500 86 6B stx bufcnt
510
511 ;init character set
512 F502 A2 E0 8E F4 02 mvx #$e0 chbas ;!! - also used for NMIEN
513
514 ;enable VBI; note that we have not yet enabled display DMA
515 .if _KERNEL_XLXE
516 bit frmadr
517 sne:ldx #$40
518 .else
519 F507 A2 40 ldx #$40
520 .endif
521 F509 8E 0E D4 stx nmien
522
523 ;terminate display list with jvb
524 F50C A4 7E ldy countr
525 F50E A2 70 ldx #rowac
526 F510 A9 41 lda #$41
527 F512 20 74 F5 jsr write_with_zp_address
528
529 ;init display list and playfield dma
530 F515 AD 2F 02 lda sdmctl
531 F518 09 22 ora #$22
532 F51A 8D 2F 02 sta sdmctl
533
534 ;wait for screen to establish (necessary for Timewise splash screen to render)
535 F51D A5 14 lda rtclok+2
536 F51F C5 14 F0 FC cmp:req rtclok+2
537
538 ;If we're in screen mode 0, show the cursor; otherwise, skip it and wait for
539 ;E: to do so. We need to skip this even if a split screen is present, or else
540 ;ACTris 2.1 displays a bogus cursor. Unfortunately we may have swapped to the
541 ;split screen, so the mode we need may be in either DINDEX or TINDEX; it's
542 ;easier for us just to re-check AUX2 bits 0-3.
543 F523 A5 2B lda icax2z
544 F525 29 0F and #$0f
545 F527 D0 03 bne no_cursor
546
547 ;show cursor
548 F529 20 82 F6 jsr ScreenPutByte.recompute_show_cursor_exit
549 F52C no_cursor:
550 ;swap back to main context
551 F52C 20 61 FD jsr EditorSwapToScreen_Y1
552
553 ;exit
554 F52F A2 00 ldx #0 ;required by Qix (v3)
555 F531 60 rts
556
557
558 ;--------------------------------------------------------
559 F532 setup_display:
560 ;Add initial mode line with LMS, and check if we need to do an LMS
561 ;split (playfield exceeds 4K). As it turns out, this only happens if
562 ;we're using ANTIC mode E or F.
563 F532 A6 57 ldx dindex
564 F534 BD 16 FE lda ScreenModeTable,x
565 F537 29 0F and #$0f
566
567 .if _KERNEL_XLXE
568 ;check if we are doing fine scrolling and set the vscrol bit if so
569 ldx dindex
570 bne nofine
571 ldx fine
572 beq nofine
573 ora #$20
574 nofine:
575 .endif
576
577 F539 48 pha
578 F53A 09 40 ora #$40
579 F53C A2 58 ldx #savmsc
580 F53E 20 74 F5 jsr write_with_zp_address
581
582 ;retrieve row count
583 F541 A6 69 ldx frmadr+1
584 F543 A5 57 lda dindex
585 F545 D0 03 AE BF 02 sne:ldx botscr
586
587 ;dec row count since we already did the LMS
588 F54A CA dex
589 F54B 68 pla
590
591 .if _KERNEL_XLXE
592 ;subtract two rows if we are fine scrolling, as we need to do DLI
593 ;and non-vscrolled row
594 cmp #$22
595 beq dofine
596 .endif
597
598 ;check if this is a split mode
599 F54C C9 0E cmp #$0e
600 F54E 90 1D bcc no_lms_split
601
602 ;yes it is -- write 93 lines
603 F550 A2 5D ldx #93
604 F552 20 6D F5 jsr write_repeat
605
606 ;write LMS to jump over 4K boundary
607 F555 48 pha
608 F556 09 40 ora #$40
609 F558 91 70 C8 sta (rowac),y+
610 F55B A9 00 lda #0
611 F55D 91 70 C8 sta (rowac),y+
612 F560 A5 59 lda savmsc+1
613 F562 69 0E adc #$0f-1 ;!! - C=1 from bcc above
614 F564 91 70 C8 sta (rowac),y+
615
616 ;set up to write 95 fewer lines (note that carry is cleared)
617 F567 A5 69 lda frmadr+1
618 F569 E9 5E sbc #94
619 F56B AA tax
620 F56C 68 pla
621
622 ;write mode lines and return
623 F56D no_lms_split:
624 F56D write_repeat:
625 F56D 91 70 C8 sta (rowac),y+
626 F570 CA dex
627 F571 D0 FA bne write_repeat
628 F573 no_clear:
629 F573 60 rts
630
631 .if _KERNEL_XLXE
632 dofine:
633 ;write the regular lines (22 or 2)
634 dex
635 jsr write_repeat
636
637 ;write DLI line
638 ora #$80
639 sta (rowac),y+
640
641 ;write non-scrolled line
642 and #$5f
643 sta (rowac),y+
644
645 ;indicate to mainline that DLIs should be turned on
646 inc frmadr
647
648 ;set up DLI routine
649 ldx #<ScreenFineScrollDLI
650 lda #>ScreenFineScrollDLI
651 write_vdslst:
652 stx vdslst
653 sta vdslst+1
654 rts
655 .endif
656
657 ;--------------------------------------------------------
658 F574 write_with_zp_address:
659 F574 91 70 C8 sta (rowac),y+
660 F577 B5 00 lda 0,x
661 F579 91 70 C8 sta (rowac),y+
662 F57C B5 01 lda 1,x
663 F57E A2 01 ldx #1
664 F580 D0 EB bne write_repeat ;!! - unconditional
665
666 F582 try_clear:
667 F582 24 68 bit frmadr
668 F584 30 ED bmi no_clear
669 F586 4C 17 F8 jmp ScreenClear
670
671 ;--------------------------------------------------------
672 F589 standard_colors:
673 F589 28 dta $28
674 F58A CA dta $ca
675 F58B 94 dta $94
676 F58C 46 dta $46
677 = F58D .def :ScreenBitposFlipTab
678 F58D 00 dta $00 ;!! - shared value between tables
679 F58E 01 dta $01
680 F58F 03 dta $03
681 F590 07 dta $07
682
683 .endp
684
685 ;==========================================================================
686 F591 .proc ScreenInit
687 F591 AD E6 02 85 6A mva memtop+1 ramtop
688
689 .ifdef _KERNEL_816
690 stz colrsh
691 .else
692 F596 A9 00 85 4F mva #0 colrsh
693 .endif
694
695 F59A A9 FE 85 4E mva #$FE drkmsk
696 F59E 60 rts
697 .endp
698
699 ;==========================================================================
700 ; Behavior in gr.0:
701 ; - Reading char advances to next position, but cursor is not moved
702 ; - Cursor is picked up ($A0)
703 ; - Wrapping from end goes to left margin on next row
704 ; - Cursor may be outside of horizontal margins
705 ; - Error 141 (cursor out of range) if out of range
706 ; - Cursor will wrap to out of range if at end of screen (no automatic
707 ; vertical wrap)
708 ; - Does NOT update OLDROW/OLDCOL
709 ;
710 F59F .proc ScreenGetByte
711 F59F 20 C7 F8 jsr ScreenCheckPosition
712 F5A2 30 3A bmi xit
713
714 ;compute addressing
715 F5A4 A4 54 ldy rowcrs
716 F5A6 20 42 F9 jsr ScreenComputeToAddrX0
717 F5A9 A5 55 lda colcrs
718 F5AB A6 57 ldx dindex
719 F5AD BC D2 F9 ldy ScreenEncodingTab,x
720 F5B0 59 8D F5 eor ScreenBitposFlipTab,y
721 F5B3 AA tax
722 F5B4 A5 56 lda colcrs+1
723 F5B6 20 8B F9 jsr ScreenSetupPixelAddr.phase2
724
725 ;retrieve byte containing pixel
726 F5B9 A4 6F ldy shfamt
727 F5BB B1 66 lda (toadr),y
728
729 ;shift down
730 F5BD 20 78 F9 jsr ScreenAlignPixel
731
732 ;convert from Internal to ATASCII - must be done before we mask
733 ;Internal ATASCII
734 ;00-1F 20-3F
735 ;20-3F 40-5F
736 ;40-5F 00-1F
737 ;60-7F 60-7F
738 F5C0 0A asl
739 F5C1 08 php
740 F5C2 10 02 49 40 spl:eor #$40 ;00>20, 20>40, 40>60, 60>40
741 F5C6 69 40 adc #$40 ;00>20, 20>40, 40>00, 60>60
742 F5C8 28 plp
743 F5C9 6A ror
744
745 ;mask using right-justified pixel mask for mode
746 F5CA A6 57 ldx dindex
747 F5CC BC D2 F9 ldy ScreenEncodingTab,x
748 F5CF 39 E2 F9 and ScreenPixelMasks,y
749
750 ;advance to next position
751 F5D2 A6 57 ldx dindex
752 F5D4 F0 03 beq mode0
753 F5D6 4C A3 F9 jmp ScreenAdvancePosNonMode0
754 F5D9 mode0:
755 F5D9 20 D6 FD jsr ScreenAdvancePosMode0
756 F5DC A0 01 ldy #1
757 F5DE xit:
758 F5DE 60 rts
759 .endp
760
761 ;==========================================================================
762 ; Common behavior:
763 ; - Output is suspended if SSFLAG is set for non-clear and non-EOL chars
764 ; - Clear screen ($7D) and EOL ($9B) are always handled
765 ; - ESCFLG and DSPFLG are ignored (they are E: features)
766 ;
767 ; Behavior in gr.0:
768 ; - Logical lines are extended
769 ; - Scrolling occurs if bottom is hit
770 ; - Control chars other than clear and EOL are NOT handled by S:
771 ; - ROWCRS or COLCRS out of range results in an error.
772 ; - COLCRS in left margin is ignored and prints within margin.
773 ; - COLCRS in right margin prints one char and then does EOL.
774 ; - Previous cursor is not erased by S:, regardless of CRSINH state
775 ; - New cursor is drawn if CRSINH=0
776 ;
777 ; Behavior in gr.1+:
778 ; - No cursor is displayed
779 ; - LMARGN/RMARGN are ignored
780 ; - Cursor wraps from right side to next line
781 ; - ROWCRS may be below split screen boundary as long as it is within the
782 ; full screen size.
783 ;
784 F5DF .proc ScreenPutByte
785 F5DF 8D FB 02 sta atachr
786 F5E2 20 C7 F8 jsr ScreenCheckPosition
787 F5E5 30 0C bmi error
788
789 ;check for screen clear
790 F5E7 AD FB 02 lda atachr
791 F5EA C9 7D cmp #$7d
792 F5EC D0 0E bne not_clear_2
793 F5EE 20 17 F8 jsr ScreenClear
794 F5F1 A0 01 ldy #1
795 F5F3 error:
796 F5F3 60 rts
797
798 F5F4 graphics_eol:
799 F5F4 4C BC F9 jmp ScreenAdvancePosNonMode0.graphics_eol
800
801 ;*** ENTRY POINT FROM EDITOR FOR ESC HANDLING ***
802 F5F7 not_clear:
803 F5F7 20 C7 F8 jsr ScreenCheckPosition
804 F5FA 30 F7 bmi error
805
806 F5FC not_clear_2:
807 ;set old position now (used by setup code for plot pixel)
808 F5FC 20 CC FD jsr ScreenSetLastPosition
809
810 ;restore char
811 F5FF AD FB 02 lda atachr
812
813 ;check if we're in gr.0
814 F602 A6 57 ldx dindex
815 F604 F0 1E beq mode_0
816
817 ;nope, we're in a graphics mode... that makes this easier.
818 ;check if it's an EOL
819 F606 C9 9B cmp #$9b
820 F608 F0 EA beq graphics_eol
821
822 ;check for display suspend (ctrl+1) and wait until it is cleared
823 F60A AE FF 02 D0 FB ldx:rne ssflag
824
825 ;fold the pixel, compute masks, and convert ATASCII to Internal
826 F60F 20 9B F6 jsr ScreenFoldColor
827 F612 48 pha
828
829 ;compute addressing and shift mask
830 F613 20 73 F9 jsr ScreenSetupPlotPixel
831
832 F616 68 pla
833 F617 A4 6F ldy shfamt
834 F619 51 66 eor (toadr),y
835 F61B 25 6E and bitmsk
836 F61D 51 66 eor (toadr),y
837 F61F 91 66 sta (toadr),y
838
839 ;advance cursor position and exit
840 F621 4C A3 F9 jmp ScreenAdvancePosNonMode0
841
842 F624 mode_0:
843 ;check for EOL, which bypasses the ESC check
844 F624 C9 9B cmp #$9b
845 F626 D0 18 bne not_eol
846
847 ;it's an EOL
848 F628 A5 52 lda lmargn
849 F62A 85 55 sta colcrs
850 F62C E6 54 inc rowcrs
851 F62E A5 54 lda rowcrs
852 F630 CD BF 02 cmp botscr
853 F633 90 08 bcc noywrap
854
855 ;We've gone over -- delete logical line 0 to make room.
856 ;Note that we need to set ROWCRS here first because the scroll may
857 ;delete more than one physical line.
858 F635 AE BF 02 ldx botscr
859 F638 86 54 stx rowcrs
860
861 F63A 20 BC FC jsr EditorDeleteLine0
862 F63D noywrap:
863 F63D 4C 82 F6 jmp recompute_show_cursor_exit
864
865 F640 not_eol:
866 ;check for display suspend (ctrl+1) and wait until it is cleared
867 F640 AE FF 02 D0 FB ldx:rne ssflag
868
869 F645 48 pha
870 F646 20 B0 FC jsr EditorRecomputeCursorAddr
871 F649 68 pla
872 F64A 20 B8 F6 jsr ScreenConvertATASCIIToInternal
873
874 ;plot character
875 F64D A0 00 ldy #0
876 F64F 91 5E sta (oldadr),y
877
878 ;inc pos
879 F651 E6 5E D0 02 E6 5F inw oldadr
880 F657 20 D6 FD jsr ScreenAdvancePosMode0
881
882 ;check if we've gone beyond the right margin
883 F65A B0 29 bcs nowrap
884
885 ;check if we're beyond the bottom of the screen
886 F65C A5 54 lda rowcrs
887 F65E CD BF 02 cmp botscr
888 F661 90 12 bcc no_scroll
889
890 ;yes -- scroll up
891 F663 20 BC FC jsr EditorDeleteLine0
892
893 ;check if we can extend the current logical line -- 3 rows max.
894 F666 20 88 F6 jsr check_extend
895
896 ;Mark the current physical line as part of the last logical line.
897 ;
898 ;NOTE: There is a subtlety here in that we may delete multiple physical
899 ; lines if the top logical line is more than one line long, but we
900 ; only want to add one physical line onto our current logical line.
901 F669 20 34 FD jsr EditorGetCurLogicalLineInfo
902 F66C 59 B2 02 eor logmap,y
903 F66F 99 B2 02 sta logmap,y
904
905 F672 4C 82 F6 jmp post_scroll
906
907 F675 no_scroll:
908 ;check if we can extend the current logical line -- 3 rows max.
909 F675 20 88 F6 jsr check_extend
910
911 ;okay, here's the fun part -- we didn't scroll beyond, but we might
912 ;be on another logical line, in which case we need to scroll everything
913 ;down to extend it.
914 F678 A5 54 lda rowcrs
915 F67A 20 43 FD jsr EditorTestLogicalLineBit
916 F67D F0 03 beq post_scroll
917
918 ;yup, insert a physical line
919 F67F 20 5A F8 jsr ScreenInsertPhysLine
920
921 F682 recompute_show_cursor_exit:
922 F682 post_scroll:
923 F682 20 B0 FC jsr EditorRecomputeCursorAddr
924 F685 nowrap:
925 F685 4C E5 FD jmp ScreenShowCursorAndXitOK
926
927 F688 check_extend:
928 F688 A6 54 ldx rowcrs
929 F68A CA dex
930 F68B 8A txa
931 F68C 20 4C FD jsr EditorPhysToLogicalRow
932
933 .ifdef _KERNEL_816
934 inc
935 inc
936 .else
937 F68F 18 clc
938 F690 69 02 adc #2
939 .endif
940
941 F692 C5 54 cmp rowcrs
942 F694 90 01 60 scc:rts
943 F697 68 pla
944 F698 68 pla
945 F699 90 E7 bcc post_scroll
946 .endp
947
948 ;==========================================================================
949 = E4C9 ScreenGetStatus = CIOExitSuccess
950
951 ;==========================================================================
952 ; Given a color byte, mask it off to the pertinent bits and reflect it
953 ; throughout a byte. The byte is converted from ATASCII to Internal
954 ; if the mode uses byte encoding.
955 ;
956 ; Entry:
957 ; A = color value
958 ;
959 ; Exit:
960 ; A = folded color byte
961 ; Y = encoding mode
962 ; DMASK = right-justified bit mask
963 ; DELTAC = left-justified bit mask
964 ;
965 ; Modified:
966 ; HOLD1, ADRESS
967 ;
968 F69B .proc ScreenFoldColor
969 F69B A6 57 ldx dindex
970 F69D BC D2 F9 ldy ScreenEncodingTab,x ;0 = 8-bit, 1 = 4-bit, 2 = 2-bit, 3 = 1-bit
971 F6A0 BE E6 F9 86 77 mvx ScreenPixelMasks+4,y deltac
972 F6A5 BE E2 F9 8E A0 02 mvx ScreenPixelMasks,y dmask
973 F6AB 30 0B bmi fold_byte
974 F6AD 2D A0 02 and dmask
975 F6B0 19 9F FD ora ScreenEncodingOffsetTable-1,y
976 F6B3 AA tax
977 F6B4 BD A3 FD lda ScreenEncodingTable,x
978 F6B7 60 rts
979
980 F6B8 fold_byte:
981 ;convert byte from ATASCII to Internal -- this is required for gr.1
982 ;and gr.2 to work correctly, and harmless for other modes
983
984 ;==========================================================================
985 ; Convert an ATASCII character to displayable INTERNAL format.
986 ;
987 ; Entry:
988 ; A = ATASCII char
989 ;
990 ; Exit:
991 ; A = INTERNAL char
992 ;
993 = F6B8 .def :ScreenConvertATASCIIToInternal
994 ;ATASCII Internal
995 ;00-1F 40-5F
996 ;20-3F 00-1F
997 ;40-5F 20-3F
998 ;60-7F 60-7F
999
1000 F6B8 0A asl
1001 F6B9 08 php
1002 F6BA E9 3F sbc #$3f ;00>60, 20>00, 40>20, 60>40
1003 F6BC 10 02 49 40 spl:eor #$40 ;00>40, 20>00, 40>20, 60>60
1004 F6C0 28 plp
1005 F6C1 6A ror
1006 F6C2 60 rts
1007 .endp
1008
1009
1010 ;==========================================================================
1011 F6C3 .proc ScreenSpecial
1012 F6C3 A5 22 lda iccomz
1013 F6C5 C9 11 cmp #$11
1014 F6C7 F0 05 beq ScreenDrawLineFill ;draw line
1015 F6C9 C9 12 cmp #$12
1016 F6CB F0 01 beq ScreenDrawLineFill ;fill
1017 F6CD 60 rts
1018 .endp
1019
1020 ;==========================================================================
1021 ;
1022 ; Inputs:
1023 ; COLCRS,ROWCRS = next point
1024 ; OLDCOL,OLDROW = previous point
1025 ; ATACHR = color/character to use
1026 ;
1027 ; Outputs:
1028 ; OLDCOL,OLDROW = next point
1029 ;
1030 ; Behavior:
1031 ; - In GR.0:
1032 ; - Cursor is not drawn, even with CRSINH=0
1033 ; - OLDADR is updated to ending location, but not OLDCHR. If CRSINH=0,
1034 ; this can lead to a subsequent E: write stomping the last line draw
1035 ; cell with the under-cursor char from the last time the cursor was
1036 ; drawn elsewhere.
1037 ;
1038 ; Some test cases:
1039 ; - Ryba Pila
1040 ; - SPACEWAY.BAS
1041 ; - Worm of Bemer
1042 ;
1043 ; The Bresenham algorithm we use (from Wikipedia):
1044 ; dx = |x2 - x1|
1045 ; dy = |y2 - y1|
1046 ; e = dx - dy
1047 ;
1048 ; loop
1049 ; plot(x1, y1)
1050 ; if x1 == x2 and y1 == y2 then exit
1051 ; e2 = 2*e
1052 ; if e2 + dy > 0 then
1053 ; err = err - dy
1054 ; x0 = x0 + sign(dx)
1055 ; endif
1056 ; if e2 < dx then
1057 ; err = err + dx
1058 ; y0 = y0 + sign(dy)
1059 ; endif
1060 ; end
1061 ;
1062 F6CE .proc ScreenDrawLineFill
1063 ;;##TRACE "Drawing line (%d,%d)-(%d,%d) in mode %d" dw(oldcol) db(oldrow) dw(colcrs) db(rowcrs) db(dindex)
1064
1065 ;initialize bit mask and repeat pertinent pixel bits throughout byte
1066 F6CE AD FD 02 lda fildat
1067 F6D1 20 9B F6 jsr ScreenFoldColor
1068 F6D4 8D BC 02 sta hold4
1069 F6D7 AD FB 02 lda atachr
1070 F6DA 20 9B F6 jsr ScreenFoldColor
1071 F6DD 85 51 sta hold1
1072
1073 F6DF 20 73 F9 jsr ScreenSetupPlotPixel
1074
1075 ;compute screen pitch
1076 F6E2 A0 01 ldy #1
1077 F6E4 20 4C F9 jsr ScreenComputeRangeSize
1078 F6E7 85 78 sta deltac+1
1079 F6E9 AA tax
1080 F6EA A0 00 ldy #0
1081
1082 ;compute abs(dy) and sign(dy)
1083 F6EC A5 54 lda rowcrs
1084 F6EE 38 E5 5A sub oldrow
1085 F6F1 B0 0C bcs going_down
1086 F6F3 49 FF eor #$ff ;take abs(dy)
1087 F6F5 69 01 adc #1 ;
1088 ;negate screen pitch
1089 F6F7 48 pha
1090 F6F8 8A txa
1091 F6F9 49 FF eor #$ff
1092 F6FB AA tax
1093 F6FC E8 inx
1094 F6FD 88 dey
1095 F6FE 68 pla
1096 F6FF going_down:
1097 F6FF 86 70 stx rowac
1098 F701 85 76 sta deltar
1099 F703 84 71 sty rowac+1
1100
1101 ;;##TRACE "dy = %d" db(deltar)
1102
1103 ;compute abs(dx) and sign(dx)
1104 F705 A2 00 ldx #0
1105 F707 A5 55 lda colcrs
1106 F709 38 E5 5B sub oldcol
1107 F70C 85 72 sta colac
1108 F70E A5 56 lda colcrs+1
1109 F710 E5 5C sbc oldcol+1
1110 F712 B0 10 bcs going_right
1111 F714 49 FF eor #$ff
1112 F716 A8 tay
1113 F717 A5 72 lda colac
1114 F719 49 FF eor #$ff
1115 F71B 69 01 adc #1
1116 F71D 85 72 sta colac
1117 F71F 98 tya
1118 F720 69 00 adc #0
1119 F722 A2 CC ldx #left_shift_8-right_shift_8
1120 F724 going_right:
1121 F724 85 73 sta colac+1
1122
1123 ;;##TRACE "dx = %d" dw(colac)
1124
1125 ;set up x shift routine
1126 F726 8A txa
1127 F727 A6 57 ldx dindex
1128 F729 BC D2 F9 ldy ScreenEncodingTab,x
1129 F72C 18 clc
1130 F72D 79 7A F7 adc shift_lo_tab,y
1131 F730 85 64 sta adress
1132 F732 A9 F7 lda #>left_shift_8
1133 F734 85 65 sta adress+1
1134 F736 85 75 sta endpt+1
1135
1136 ;set up x fill shift routine
1137 F738 B9 7A F7 lda shift_lo_tab,y
1138 F73B 18 clc
1139 F73C 69 D9 adc #fill_right_8-right_shift_8
1140 F73E 85 74 sta endpt
1141
1142 ;compute initial error accumulator in frmadr (dx-dy)
1143 F740 A6 72 ldx colac
1144 F742 8A txa
1145 F743 38 E5 76 sub deltar
1146 F746 85 68 sta frmadr
1147 F748 A4 73 ldy colac+1 ;leave dx in y:x for max() below
1148 F74A 98 tya
1149 F74B E9 00 sbc #0
1150 F74D 85 69 sta frmadr+1
1151
1152 ;compute max(dx, dy) based on sign of (dx - dy)
1153 F74F B0 04 bcs dx_larger
1154 F751 A0 00 ldy #0
1155 F753 A6 76 ldx deltar
1156 F755 dx_larger:
1157 F755 86 7E stx countr
1158 F757 84 7F sty countr+1
1159
1160 F759 98 tya
1161 F75A D0 03 bne not_empty
1162 F75C 8A txa
1163 F75D F0 0D beq skip_showcursor
1164 F75F not_empty:
1165
1166 ;;##TRACE "Pixel count = %d" dw(countr)
1167
1168 ;enter pixel loop (this will do a decrement for us)
1169 F75F 4C CF F7 jmp next_pixel
1170
1171 ;----------------------------------------------
1172 F762 done:
1173 F762 20 CC FD jsr ScreenSetLastPosition
1174
1175 ;RYBA PILA requires the quirky behavior of the last character of a non-zero length
1176 ;DRAWTO being stomped by the character saved from the cursor draw of the last PLOT
1177 ;(write to S:). Note that we must NOT do this for length 0 or it breaks SPACEWAY.
1178 F765 A4 57 ldy dindex
1179 F767 D0 03 bne skip_showcursor
1180 F769 20 B0 FC jsr EditorRecomputeCursorAddr
1181 F76C skip_showcursor:
1182 F76C A0 01 ldy #1
1183 F76E 60 rts
1184
1185 ;----------------------------------------------
1186 F76F fill_done:
1187 F76F 86 6E stx bitmsk
1188 F771 4C CF F7 jmp next_pixel
1189
1190 ;----------------------------------------------
1191 F774 do_fill:
1192 F774 A4 6F ldy shfamt ;load current byte offset
1193 F776 A6 6E ldx bitmsk ;save current bitmask
1194 F778 D0 33 bne fill_start ;!! - unconditional
1195
1196 ;----------------------------------------------
1197 F77A shift_lo_tab:
1198 F77A B8 dta <right_shift_8
1199 F77B B2 dta <right_shift_4
1200 F77C B4 dta <right_shift_2
1201 F77D B5 dta <right_shift_1
1202
1203 ;----------------------------------------------
1204 F77E left_shift_4:
1205 F77E 0A asl
1206 F77F 0A asl
1207 F780 left_shift_2:
1208 F780 0A asl
1209 F781 left_shift_1:
1210 F781 0A asl
1211 F782 90 05 bcc left_shift_ok
1212 F784 left_shift_8:
1213 F784 C6 6F dec shfamt
1214 F786 AD A0 02 lda dmask
1215 F789 left_shift_ok:
1216 F789 D0 31 bne post_xinc ;!! - unconditional
1217
1218 ;----------------------------------------------
1219 F78B fill_right_4:
1220 F78B 4A lsr
1221 F78C 4A lsr
1222 F78D fill_right_2:
1223 F78D 4A lsr
1224 F78E fill_right_1:
1225 F78E 4A lsr
1226 F78F 90 09 bcc fill_right_ok
1227 F791 fill_right_8:
1228 F791 A5 77 lda deltac
1229 F793 C8 iny
1230 F794 C4 78 cpy deltac+1
1231 F796 90 02 A0 00 scc:ldy #0
1232 F79A fill_right_ok:
1233 F79A 85 6E sta bitmsk
1234 F79C F0 D1 beq fill_done
1235 F79E fill_loop:
1236 F79E B1 66 lda (toadr),y ;load screen byte
1237 F7A0 24 6E bit bitmsk ;mask to current pixel
1238 F7A2 D0 CB bne fill_done ;exit loop if non-zero
1239 F7A4 4D BC 02 eor hold4 ;XOR with fill color
1240 F7A7 25 6E and bitmsk ;mask change bits to current pixel
1241 F7A9 51 66 eor (toadr),y ;merge with screen byte
1242 F7AB 91 66 sta (toadr),y ;save screen byte
1243 F7AD fill_start:
1244 F7AD A5 6E lda bitmsk
1245 F7AF 6C 74 00 jmp (endpt)
1246
1247 ;----------------------------------------------
1248 F7B2 right_shift_4:
1249 F7B2 4A lsr
1250 F7B3 4A lsr
1251 F7B4 right_shift_2:
1252 F7B4 4A lsr
1253 F7B5 right_shift_1:
1254 F7B5 4A lsr
1255 F7B6 90 04 bcc right_shift_ok
1256 F7B8 right_shift_8:
1257 F7B8 E6 6F inc shfamt
1258 F7BA A5 77 lda deltac
1259 F7BC right_shift_ok:
1260 ;fall through to post_xinc
1261 F7BC post_xinc:
1262 F7BC 85 6E sta bitmsk
1263 F7BE no_xinc:
1264
1265 ;plot pixel
1266 ;;##TRACE "Plotting at $%04X+%d with mask $%02X" dw(toadr) db(shfamt) db(bitmsk)
1267 F7BE A4 6F ldy shfamt
1268 F7C0 A5 51 lda hold1
1269 F7C2 51 66 eor (toadr),y
1270 F7C4 25 6E and bitmsk
1271 F7C6 51 66 eor (toadr),y
1272 F7C8 91 66 sta (toadr),y
1273
1274 ;do fill if needed
1275 F7CA A5 22 lda iccomz
1276 F7CC 4A lsr
1277 F7CD 90 A5 bcc do_fill
1278
1279 F7CF next_pixel:
1280 ;loop back for next pixel
1281 F7CF A5 7E lda countr
1282 F7D1 D0 04 bne next_pixel_2
1283 F7D3 C6 7F dec countr+1
1284 F7D5 30 8B bmi done
1285 F7D7 next_pixel_2:
1286 F7D7 C6 7E dec countr
1287
1288 ;!! - fall through to pixel loop
1289
1290 ;------- pixel loop state -------
1291 ; (zp) frmadr error accumulator
1292 ; (zp) toadr current row address
1293 ; (abs) dmask right-justified bit mask
1294 ; (zp) deltac left-justified bit mask
1295 ; (zp) bitmsk current bit mask
1296 ; (zp) shfamt current byte offset within row
1297 ; (zp) rowac y step address increment/decrement (note different from Atari OS)
1298 ; (zp) adress left/right shift routine
1299 ; (zp) deltac+1 screen pitch, in bytes (for fill)
1300 ; (zp) endpt right shift routine
1301 ; (zp) colac dy
1302 F7D9 pixel_loop:
1303 ;compute 2*err
1304 ;;##TRACE "Error accum = %d (dx=%d, dy=%d(%d))" dsw(frmadr) dw(colac) db(deltar) dsw(rowac)
1305 F7D9 A5 68 lda frmadr
1306 F7DB 0A asl
1307 F7DC A8 tay
1308 F7DD A5 69 lda frmadr+1
1309 F7DF 2A rol
1310 F7E0 AA tax
1311
1312 ;check for y increment (2*e < dx, or A:Y < colac)
1313 F7E1 98 tya
1314 F7E2 18 clc
1315 F7E3 E5 72 sbc colac
1316 F7E5 8A txa
1317 F7E6 48 pha
1318 F7E7 E5 73 sbc colac+1
1319 F7E9 10 13 bpl no_yinc
1320
1321 F7EB do_yinc:
1322 ;bump y (add/subtract pitch, e += dx)
1323 F7EB A2 02 ldx #2
1324 F7ED yinc_loop:
1325 F7ED B5 70 lda rowac,x
1326 F7EF 18 clc
1327 F7F0 75 66 adc toadr,x
1328 F7F2 95 66 sta toadr,x
1329 F7F4 B5 71 lda rowac+1,x
1330 F7F6 75 67 adc toadr+1,x
1331 F7F8 95 67 sta toadr+1,x
1332 F7FA CA dex
1333 F7FB CA dex
1334 F7FC 10 EF bpl yinc_loop
1335 F7FE no_yinc:
1336
1337 ;check for x increment (2*e + dy > 0, or Y:[S] + deltar > 0)
1338 F7FE 98 tya
1339 F7FF 18 clc
1340 F800 65 76 adc deltar
1341 F802 68 pla
1342 F803 69 00 adc #0
1343 F805 30 B7 bmi no_xinc
1344
1345 ;update error accumulator
1346 F807 A5 68 lda frmadr
1347 F809 38 E5 76 sub deltar
1348 F80C 85 68 sta frmadr
1349 F80E B0 02 C6 69 scs:dec frmadr+1
1350
1351 ;bump x
1352 F812 A5 6E lda bitmsk
1353 F814 6C 64 00 jmp (adress)
1354
1355 .if [right_shift_4 ^ right_shift_8]&$ff00
1356 .error "Right draw routines cross page: ",right_shift_4,"-",right_shift_8
1357 .endif
1358 .if [left_shift_4 ^ left_shift_8]&$ff00
1359 .error "Left draw routines cross page: ",left_shift_4,"-",left_shift_8
1360 .endif
1361 .if [fill_right_4 ^ fill_right_8]&$ff00
1362 .error "Fill routines cross page: ",fill_right_4,"-",fill_right_8
1363 .endif
1364 .if [[right_shift_4^left_shift_4]|[left_shift_4^fill_right_4]]&$ff00
1365 .error "Line/fill routines cross page: ",left_shift_4,',',right_shift_4,',',fill_right_4
1366 .endif
1367
1368 .endp
1369
1370 ;==========================================================================
1371 ; Clear the screen.
1372 ;
1373 ; Used:
1374 ; ADRESS
1375 ; TOADR
1376 ;
1377 ; Quirks:
1378 ; Clears the split-screen text area even if the main screen (S:) receives
1379 ; the clear. The In-Store Demonstration Cart depends on this. The cursor
1380 ; state of the split screen is NOT reset, so if the cursor was over a
1381 ; non-blank character, that character will be restored when the cursor
1382 ; moves.
1383 ;
1384 ; The logical line map is always reset.
1385 ;
1386 F817 .proc ScreenClear
1387 ;first, set up for clearing the split-screen window (4*40 bytes main)
1388 F817 A0 04 ldy #4
1389
1390 ;check if we are in the split screen text window
1391 F819 A6 7B ldx swpflg
1392 F81B D0 08 bne is_text_window
1393
1394 ;nope, it's the main screen... compute size
1395 F81D A4 57 ldy dindex
1396 F81F BE 26 FE ldx ScreenHeightShifts,y
1397 F822 BC 36 FE ldy ScreenHeights,x
1398 F825 is_text_window:
1399 F825 20 4C F9 jsr ScreenComputeRangeSize
1400
1401 ;add 160 bytes to size if not GR.0 -- important to avoid clearing
1402 ;beyond GR.0 screen (the font breaks in BIKERDAV.BAS otherwise!)
1403 F828 18 clc
1404 F829 A6 57 ldx dindex
1405 F82B F0 02 beq is_gr0
1406 F82D 69 A0 adc #160
1407 F82F is_gr0:
1408 F82F A8 tay
1409 F830 A5 65 lda adress+1
1410 F832 69 00 adc #0
1411
1412 F834 AA tax
1413 F835 65 59 adc savmsc+1
1414 F837 85 67 sta toadr+1
1415 F839 A5 58 85 66 mva savmsc toadr
1416
1417 ;As it turns out, there are no cases where the main screen
1418 ;is an exact number of pages... so we can simply plow into
1419 ;the clear loop.
1420 F83D A9 00 lda #0
1421 F83F loop:
1422 F83F 88 dey
1423 F840 91 66 sta (toadr),y
1424 F842 D0 FB bne loop
1425 F844 C6 67 dec toadr+1
1426 F846 CA dex
1427 F847 10 F6 bpl loop
1428
1429 ;reset coordinates and cursor (we're going to wipe the cursor)
1430 F849 85 56 sta colcrs+1
1431 F84B 85 54 sta rowcrs
1432 F84D 85 5D sta oldchr
1433
1434 ;always reset the logical line map
1435 F84F A6 57 ldx dindex
1436 F851 D0 02 bne is_graphic_screen
1437 F853 A5 52 lda lmargn
1438 F855 is_graphic_screen:
1439 F855 85 55 sta colcrs
1440
1441 ;always reset the logical line map and exit
1442 F857 4C B9 FD jmp ScreenResetLogicalLineMap
1443 .endp
1444
1445 ;==========================================================================
1446 ; Insert a physical line at the current location.
1447 ;
1448 ; Entry:
1449 ; ROWCRS = row before which to insert new line
1450 ; C = 0 if physical line only, C = 1 if should start new logical line
1451 ;
1452 ; Modified:
1453 ; HOLD1, ADRESS
1454 ;
1455 = F85B ScreenInsertLine = ScreenInsertPhysLine.use_c
1456 F85A .proc ScreenInsertPhysLine
1457 F85A 18 clc
1458 F85B use_c:
1459 ;save new logline flag
1460 F85B 08 php
1461
1462 ;compute addresses
1463 F85C AC BF 02 ldy botscr
1464 F85F 88 dey
1465 F860 20 42 F9 jsr ScreenComputeToAddrX0
1466 F863 20 8A FD jsr EditorNextLineAddr
1467
1468 ;copy lines
1469 F866 AE BF 02 ldx botscr
1470 F869 D0 09 bne line_loop_start
1471 F86B line_loop:
1472 F86B A0 27 ldy #39
1473 F86D char_loop:
1474 F86D B1 68 lda (frmadr),y
1475 F86F 91 66 sta (toadr),y
1476 F871 88 dey
1477 F872 10 F9 bpl char_loop
1478 F874 line_loop_start:
1479 F874 A5 68 lda frmadr
1480 F876 85 66 sta toadr
1481 F878 38 sec
1482 F879 E9 28 sbc #40
1483 F87B 85 68 sta frmadr
1484 F87D A5 69 lda frmadr+1
1485 F87F 85 67 sta toadr+1
1486 F881 E9 00 sbc #0
1487 F883 85 69 sta frmadr+1
1488
1489 F885 CA dex
1490 F886 E4 54 cpx rowcrs
1491 F888 D0 E1 bne line_loop
1492
1493 F88A no_copy:
1494 ;clear the current line
1495 F88A A0 27 ldy #39
1496 F88C A9 00 lda #0
1497 F88E clear_loop:
1498 F88E 91 66 sta (toadr),y
1499 F890 88 dey
1500 F891 10 FB bpl clear_loop
1501
1502 ;insert bit into logical line mask
1503 F893 20 34 FD jsr EditorGetCurLogicalLineInfo
1504
1505 F896 28 plp
1506 F897 B0 02 A9 00 scs:lda #0
1507 F89B 85 51 sta hold1
1508
1509 F89D A9 00 lda #0
1510 F89F 38 sec
1511 F8A0 FD C1 E4 sbc ReversedBitMasks,x ;-bit
1512 F8A3 0A asl
1513 F8A4 39 B2 02 and logmap,y
1514 F8A7 18 clc
1515 F8A8 79 B2 02 adc logmap,y
1516 F8AB 6A ror
1517 F8AC 05 51 ora hold1
1518 F8AE 99 B2 02 sta logmap,y
1519
1520 F8B1 88 dey
1521 F8B2 10 03 6E B3 02 spl:ror logmap+1
1522 F8B7 88 dey
1523 F8B8 10 03 6E B4 02 spl:ror logmap+2
1524 F8BD 60 rts
1525 .endp
1526
1527 ;==========================================================================
1528 ; Hide the screen cursor, if it is present.
1529 ;
1530 ; Modified:
1531 ; Y
1532 ;
1533 ; Preserved:
1534 ; A
1535 ;
1536 F8BE .proc ScreenHideCursor
1537 ;erase the cursor
1538 F8BE 48 pha
1539 F8BF A0 00 ldy #0
1540 F8C1 A5 5D lda oldchr
1541 F8C3 91 5E sta (oldadr),y
1542 F8C5 68 pla
1543 F8C6 no_cursor:
1544 F8C6 60 rts
1545 .endp
1546
1547 ;==========================================================================
1548 F8C7 .proc ScreenCheckPosition
1549 ;Check for ROWCRS out of range. Note that for split screen modes we still
1550 ;check against the full height!
1551 F8C7 AD BF 02 lda botscr
1552 F8CA A6 57 ldx dindex
1553 F8CC F0 06 beq rowcheck_gr0
1554 F8CE BC 26 FE ldy ScreenHeightShifts,x
1555 F8D1 B9 36 FE lda ScreenHeights,y
1556 F8D4 rowcheck_gr0:
1557 ;while we know it's GR.0, clamp RMARGN to 39 (required for ARTILLERY.BAS)
1558 F8D4 A0 27 ldy #39
1559 F8D6 C4 53 cpy rmargn
1560 F8D8 B0 02 bcs rmargn_ok
1561 F8DA 84 53 sty rmargn
1562 F8DC rmargn_ok:
1563 F8DC 18 clc
1564 F8DD E5 54 sbc rowcrs
1565 F8DF B0 0E bcs rowcheck_pass
1566 F8E1 invalid_position:
1567
1568 ;If the cursor is out of range, reset it within bounds.
1569 F8E1 A0 00 ldy #0
1570 F8E3 84 56 sty colcrs+1 ;X high = 0
1571 F8E5 8A txa
1572 F8E6 D0 02 A4 52 sne:ldy lmargn
1573 F8EA 84 55 sty colcrs ;X low = X origin
1574
1575 F8EC A0 8D ldy #CIOStatCursorRange
1576 F8EE 60 rts
1577
1578 F8EF rowcheck_pass:
1579 ;check width
1580 F8EF BC 3B FE ldy ScreenPixelWidthIds,x
1581 F8F2 A5 55 lda colcrs
1582 F8F4 D9 C8 F9 cmp ScreenPixelWidthsLo,y
1583 F8F7 A5 56 lda colcrs+1
1584 F8F9 F9 CD F9 sbc ScreenPixelWidthsHi,y
1585 F8FC B0 E3 bcs invalid_position
1586
1587 ;check for BREAK
1588 F8FE A0 FF ldy #$ff
1589 F900 A5 11 lda brkkey
1590 F902 D0 04 bne no_break
1591 F904 84 11 sty brkkey
1592 F906 A0 7F ldy #CIOStatBreak-1
1593 F908 no_break:
1594 F908 C8 iny
1595 F909 60 rts
1596 .endp
1597
1598 ;==========================================================================
1599 ; Swap between the main screen and the split screen.
1600 ;
1601 ; Conventionally, the main screen is left as the selected context when
1602 ; the display handler is not active.
1603 ;
1604 ; Inputs:
1605 ; C = 0 for main screen
1606 ; C = 1 for split screen
1607 ;
1608 ; Modified:
1609 ; X
1610 ;
1611 ; Preserved:
1612 ; A
1613 ;
1614 ;==========================================================================
1615 ; Swap in the text screen (main if gr.0, split otherwise).
1616 ;
1617 F90A .proc EditorSwapToText
1618 ;set C=0 (main) if gr.0, C=1 (split) otherwise
1619 F90A A0 17 ldy #23
1620 F90C CC BF 02 cpy botscr
1621
1622 = F90F .def :ScreenSwap = *
1623 ;check if the correct set is in place
1624 F90F 48 pha
1625 F910 A9 00 lda #0
1626 F912 65 7B adc swpflg
1627 F914 F0 14 beq already_there
1628
1629 ;Nope, we need to swap. Conveniently, the data to be swapped
1630 ;is in a 12 byte block:
1631 ;
1632 ; ROWCRS ($0054) TXTROW ($0290)
1633 ; COLCRS ($0055) TXTCOL ($0291)
1634 ; DINDEX ($0057) TINDEX ($0293)
1635 ; SAVMSC ($0058) TXTMSC ($0294)
1636 ; OLDROW ($005A) TXTOLD ($0296)
1637 ; OLDCOL ($005B) TXTOLD ($0297)
1638 ; OLDCHR ($005D) TXTOLD ($0299)
1639 ; OLDADR ($005E) TXTOLD ($029A)
1640
1641 F916 A2 0B ldx #11
1642 F918 swap_loop:
1643 F918 B5 54 lda rowcrs,x
1644 F91A BC 90 02 ldy txtrow,x
1645 F91D 94 54 sty rowcrs,x
1646 F91F 9D 90 02 sta txtrow,x
1647 F922 CA dex
1648 F923 10 F3 bpl swap_loop
1649
1650 ;invert swap flag
1651 F925 8A txa
1652 F926 45 7B eor swpflg
1653 F928 85 7B sta swpflg
1654
1655 F92A already_there:
1656 F92A 68 pla
1657 F92B 60 rts
1658 .endp
1659
1660 ;==========================================================================
1661 ; Compute character address.
1662 ;
1663 ; Entry:
1664 ; X = byte index
1665 ; Y = line index
1666 ;
1667 ; Exit:
1668 ; A:X = address
1669 ;
1670 ; Used:
1671 ; ADRESS
1672 ;
1673 F92C .proc ScreenComputeAddr
1674 F92C 20 4C F9 jsr ScreenComputeRangeSize
1675 F92F 85 64 sta adress
1676 F931 8A txa
1677 F932 18 clc
1678 F933 65 64 adc adress ;row*10,20,40+col
1679 F935 90 02 E6 65 scc:inc adress+1
1680 F939 18 clc
1681 F93A 65 58 adc savmsc
1682 F93C AA tax
1683 F93D A5 65 lda adress+1
1684 F93F 65 59 adc savmsc+1
1685 F941 60 rts
1686 .endp
1687
1688 ;==========================================================================
1689 = F944 ScreenComputeToAddr = ScreenComputeToAddrX0.with_x
1690 F942 .proc ScreenComputeToAddrX0
1691 F942 A2 00 ldx #0
1692 F944 with_x:
1693 F944 20 2C F9 jsr ScreenComputeAddr
1694 F947 86 66 stx toadr
1695 F949 85 67 sta toadr+1
1696 F94B 60 rts
1697 .endp
1698
1699 ;==========================================================================
1700 ; Compute size, in bytes, of a series of lines.
1701 ;
1702 ; Entry:
1703 ; Y = line count
1704 ;
1705 ; Exit:
1706 ; ADRESS+1 High byte of size
1707 ; A Low byte of size
1708 ;
1709 ; Preserved:
1710 ; X
1711 ;
1712 ; Modified:
1713 ; Y
1714 ;
1715 F94C .proc ScreenComputeRangeSize
1716 F94C A9 00 85 65 mva #0 adress+1
1717 F950 84 64 sty adress
1718 F952 A4 57 ldy dindex
1719 F954 B9 3B FE lda ScreenPixelWidthIds,y
1720 F957 38 sec
1721 F958 F9 D2 F9 sbc ScreenEncodingTab,y
1722 F95B A8 tay
1723 F95C C8 iny
1724 F95D A5 64 lda adress
1725 F95F 0A asl
1726 F960 26 65 rol adress+1 ;row*2
1727 F962 0A asl
1728 F963 26 65 rol adress+1 ;row*4
1729 F965 18 clc
1730 F966 65 64 adc adress ;row*5
1731 F968 90 02 E6 65 scc:inc adress+1
1732 F96C shift_loop:
1733 F96C 0A asl
1734 F96D 26 65 rol adress+1 ;row*10,20,40
1735 F96F 88 dey
1736 F970 10 FA bpl shift_loop
1737 F972 60 rts
1738 .endp
1739
1740 ;==========================================================================
1741 ; Setup for pixel plot.
1742 ;
1743 ; Entry:
1744 ; OLDCOL, OLDROW = position
1745 ; DELTAC = left-justified pixel mask
1746 ;
1747 ; Exit:
1748 ; TOADR = screen row
1749 ; SHFAMT = byte offset within row
1750 ; BITMSK = shifted bit mask for pixel
1751 ;
1752 ; Modified:
1753 ; ADRESS
1754 ;
1755 = F978 ScreenAlignPixel = ScreenSetupPlotPixel.rshift_mask
1756 F973 .proc ScreenSetupPlotPixel
1757 ;;##TRACE "Folded pixel = $%02X" db(hold1)
1758 F973 20 82 F9 jsr ScreenSetupPixelAddr
1759
1760 ;preshift bit mask
1761 F976 A5 77 lda deltac
1762 F978 rshift_mask:
1763 F978 CA dex
1764 F979 30 04 bmi xmaskshift_done
1765 F97B xmaskshift_loop:
1766 F97B 4A lsr
1767 F97C CA dex
1768 F97D 10 FC bpl xmaskshift_loop
1769 F97F xmaskshift_done:
1770 F97F 85 6E sta bitmsk
1771
1772 ;;##TRACE "Initial bitmasks = $%02X $%02X" db(bitmsk) db(dmask)
1773 F981 60 rts
1774 .endp
1775
1776 ;==========================================================================
1777 ; Setup for pixel addressing.
1778 ;
1779 ; Entry:
1780 ; COLCRS, ROWCRS = position (ScreenSetupPixelAddr)
1781 ; OLDCOL, OLDROW = position (ScreenSetupPixelAddrOld)
1782 ;
1783 ; Exit:
1784 ; TOADR = screen row
1785 ; SHFAMT = byte offset within row
1786 ; X = number of bits from left side of byte to left side of pixel
1787 ;
1788 F982 .proc ScreenSetupPixelAddr
1789 ;compute initial address
1790 F982 A4 5A ldy oldrow
1791 F984 20 42 F9 jsr ScreenComputeToAddrX0
1792
1793 ;;##TRACE "Initial row address = $%04X" dw(toadr)
1794
1795 ;compute initial byte offset
1796 F987 A5 5C lda oldcol+1
1797 F989 A6 5B ldx oldcol
1798 F98B phase2:
1799 F98B 6A ror
1800 F98C 86 6F stx shfamt
1801 F98E A9 00 lda #0
1802 F990 A6 57 ldx dindex
1803 F992 BC D2 F9 ldy ScreenEncodingTab,x
1804 F995 F0 06 beq no_xshift
1805 F997 xshift_loop:
1806 F997 66 6F ror shfamt
1807 F999 6A ror
1808 F99A 88 dey
1809 F99B D0 FA bne xshift_loop
1810 F99D no_xshift:
1811 F99D 2A rol
1812 F99E 2A rol
1813 F99F 2A rol
1814 F9A0 2A rol
1815 F9A1 AA tax
1816
1817 ;;##TRACE "Initial row offset = $%02X" db(shfamt)
1818 F9A2 60 rts
1819 .endp
1820
1821 ;==========================================================================
1822 ; ScreenAdvancePosNonMode0
1823 ;
1824 F9A3 .proc ScreenAdvancePosNonMode0
1825 ;advance position
1826 F9A3 E6 55 inc colcrs
1827 F9A5 D0 02 E6 56 sne:inc colcrs+1
1828 F9A9 A6 57 ldx dindex
1829 F9AB BC 3B FE ldy ScreenPixelWidthIds,x
1830 F9AE BE CD F9 ldx ScreenPixelWidthsHi,y
1831 F9B1 E4 56 cpx colcrs+1
1832 F9B3 D0 0F bne graphics_no_wrap
1833 F9B5 BE C8 F9 ldx ScreenPixelWidthsLo,y
1834 F9B8 E4 55 cpx colcrs
1835 F9BA D0 08 bne graphics_no_wrap
1836
1837 F9BC graphics_eol:
1838 ;move to left side and then one row down -- note that this may
1839 ;push us into an invalid coordinate, which will result on an error
1840 ;on the next call if not corrected
1841 F9BC A0 00 ldy #0
1842 F9BE 84 55 sty colcrs
1843 F9C0 84 56 sty colcrs+1
1844 F9C2 E6 54 inc rowcrs
1845 F9C4 graphics_no_wrap:
1846 F9C4 A0 01 ldy #1
1847 F9C6 60 rts
1848 .endp
1849
1850 ;==========================================================================
1851 .if !_KERNEL_XLXE
1852 F9C7 _SCREEN_TABLES_1
Macro: _SCREEN_TABLES_1 [Source: source/Shared/screen.s]
3 F9C7 0A dta <10
4 F9C8 14 dta <20
5 F9C9 28 dta <40
6 F9CA 50 dta <80
7 F9CB A0 dta <160
8 F9CC 40 dta <320
12 F9CD 00 dta >20
13 F9CE 00 dta >40
14 F9CF 00 dta >80
15 F9D0 00 dta >160
16 F9D1 01 dta >320
20 F9D2 00 dta 0 ;gr.0 direct bytes
21 F9D3 00 dta 0 ;gr.1 direct bytes
22 F9D4 00 dta 0 ;gr.2 direct bytes
23 F9D5 02 dta 2 ;gr.3 two bits per pixel
24 F9D6 03 dta 3 ;gr.4 one bit per pixel
25 F9D7 02 dta 2 ;gr.5 two bits per pixel
26 F9D8 03 dta 3 ;gr.6 one bit per pixel
27 F9D9 02 dta 2 ;gr.7 two bits per pixel
28 F9DA 03 dta 3 ;gr.8 one bit per pixel
29 F9DB 01 dta 1 ;gr.9 four bits per pixel
30 F9DC 01 dta 1 ;gr.10 four bits per pixel
31 F9DD 01 dta 1 ;gr.11 four bits per pixel
32 F9DE 00 dta 0 ;gr.12 direct bytes
33 F9DF 00 dta 0 ;gr.13 direct bytes
34 F9E0 03 dta 3 ;gr.14 one bit per pixel
35 F9E1 02 dta 2 ;gr.15 two bits per pixel
39 F9E2 FF 0F 03 01 FF F0 + dta $ff, $0f, $03, $01, $ff, $f0, $c0, $80
Source: source/Shared/screen.s
1853 .endif
270 F9EA icl 'editor.s'
Source: source/Shared/editor.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Editor Handler
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 F9EA .proc EditorOpen
12 F9EA 20 B9 FD jsr ScreenResetLogicalLineMap
13 F9ED 8E FE 02 stx dspflg ;!! relies on X=0 from ScreenResetLogicalLineMap
14 F9F0 8E A2 02 stx escflg
15
16 ;we must force mode 0 here -- ACTION calls this with $0C in AUX2 and
17 ;expects mode 0 to be set
18 F9F3 4C F2 F3 jmp ScreenOpenMode0
19 .endp
20
21 ;==========================================================================
22 = E4C9 EditorClose = ScreenClose
23
24 ;==========================================================================
25 ;
26 ; === Forced read mode ===
27 ;
28 ; If bit 0 if AUX1 is set on the IOCB, it means to read in forced read
29 ; mode. In forced read mode, no keyboard input is fetched and instead
30 ; line read immediately commences, as if ENTER were pressed.
31 ;
32 ; Note that since AUX1 is tested on the IOCB used, it is possible to have
33 ; E: open on more than one IOCB with different forced read modes.
34 ;
35 F9F6 .proc EditorGetByte
36 ;check if we have anything left in the current line
37 F9F6 A5 6B lda bufcnt
38 F9F8 D0 06 bne have_line
39
40 ;nope, fetch a line
41 F9FA 20 16 FA jsr EditorGetLine
42 F9FD 10 01 bpl have_line
43 F9FF 60 rts
44
45 FA00 have_line:
46 ;swap to text context
47 FA00 20 0A F9 jsr EditorSwapToText
48
49 ;subtract off a char
50 FA03 C6 6B dec bufcnt
51
52 ;check if we're at the EOL
53 FA05 D0 09 bne have_char
54
55 ;yes, we're at the EOL -- print it and return it (this will re-enable
56 ;the cursor, too)
57 FA07 A9 9B lda #$9b
58 FA09 20 DF F5 jsr ScreenPutByte
59
60 FA0C A9 9B lda #$9b
61 FA0E D0 03 bne done
62
63 FA10 have_char:
64 ;read a char from the screen
65 FA10 20 9F F5 jsr ScreenGetByte
66 FA13 done:
67 FA13 4C 63 FD jmp EditorSwapToScreen
68 .endp
69
70 ;==========================================================================
71 ; This behavior is quite complex:
72 ; - The editor remembers the cursor position within the initial logical
73 ; line. Only contents beyond the initial position are returned. This
74 ; is true even if the cursor is moved out of the logical line and back
75 ; in again.
76 ; - Margins are not included.
77 ; - Trailing spaces at the end of a logical line are not returned even
78 ; if the cursor is after them.
79 ; - If the cursor is moved to another logical line, that logical line is
80 ; read instead. There is no memory of the line start for previous
81 ; logical lines, so if there was a prompt on that line it will be
82 ; picked up too.
83 ; - If the logical line length is exceeded, a beep sounds near the end
84 ; and after three lines (120ch) the logical line is terminated and a
85 ; new logical line is started. However, the previous logical line that
86 ; was overflowed is still returned. This still happens if the new
87 ; logical line extends to more than one physical line or even if
88 ; itself overflows (!). If the physical line is changed with up/down,
89 ; this memory is lost, but left/right don't do this.
90 ; - If a logical line extends exactly to the end of a physical line, an
91 ; extra blank line is printed on EOL.
92 ; - If a logical line extends exactly to the end of the screen, a cursor
93 ; out of bounds error results. (We currently do not implement this...
94 ; feature.)
95 ;
96 ; === The BUFSTR variable ===
97 ;
98 ; The BUFSTR variable is critical to the way that the get line algorithm
99 ; works. It actually consists of two bytes, the row followed by the column
100 ; of the origin of the line to be read. This is updated whenever a read
101 ; request arrives that starts a new line or whenever the cursor is moved
102 ; to a different logical line. This is how the screen editor knows to
103 ; read at the end of a prompt or from a different line that you have moved
104 ; to, and how it tracks that when scrolling occurs. It does not, however,
105 ; get updated when regular characters are typed, even when spilling to a
106 ; new logical line.
107 ;
108 ; === BUFCNT ===
109 ;
110 ; BUFCNT contains the number of characters left to return before we have
111 ; to get a new line: $00 means we will wait for keys, $01 is the EOL, and
112 ; >$01 returns a typed character. We need to follow this convention or
113 ; else the combination of S_VBXE.SYS + CON.SYS /E from SDX 4.46 acts
114 ; strangely on launch.
115 ;
116 FA16 .proc EditorGetLine
117 = 006D _start_x equ bufstr+1
118 = 006C _start_y equ bufstr
119
120 ;Set line buffer start to current position (NOT the start of the logical
121 ;line -- this is a special case).
122 FA16 20 0A F9 jsr EditorSwapToText
123 FA19 A5 55 85 6D mva colcrs _start_x
124 FA1D A5 54 85 6C mva rowcrs _start_y
125 FA21 20 63 FD jsr EditorSwapToScreen
126
127 ;check if forced read is enabled on the IOCB -- if so, assume we've gotten
128 ;an EOL
129 FA24 A5 2A lda icax1z
130 FA26 4A lsr
131 FA27 B0 25 bcs do_eol
132
133 FA29 read_loop:
134 ;get a character
135 FA29 20 66 FE jsr KeyboardGetByte
136 FA2C 10 01 bpl read_ok
137 FA2E read_error:
138 FA2E 60 rts
139
140 FA2F read_ok:
141 FA2F C9 9B cmp #$9b
142 FA31 F0 1D beq is_eol
143
144 ;echo the character
145 FA33 20 A8 FA jsr EditorPutByte
146 FA36 30 F6 bmi read_error
147
148 ;check if we've hit the warning point (logical pos 113)
149 FA38 A5 55 lda colcrs
150 FA3A C9 21 cmp #33
151 FA3C D0 EB bne read_loop
152
153 ;convert current row to logical start row
154 FA3E 20 4A FD jsr EditorGetCurLogicalRow
155
156 ;check if we're on the third row
157 FA41 18 clc
158 FA42 69 02 adc #2
159 FA44 C5 54 cmp rowcrs
160
161 ;if so, sound the bell
162 FA46 D0 E1 bne read_loop
163 FA48 20 5C FD jsr EditorBell
164
165 FA4B 4C 29 FA jmp read_loop
166
167 FA4E do_eol:
168 FA4E A9 9B lda #$9b
169 FA50 is_eol:
170 ;echo the character
171 FA50 20 A8 FA jsr EditorPutByte
172 FA53 30 D9 bmi read_error
173
174 ;swap to text screen context
175 FA55 20 0A F9 jsr EditorSwapToText
176
177 ;hide the cursor so we can scan text properly
178 FA58 20 BE F8 jsr ScreenHideCursor
179
180 ;compute address
181 FA5B A2 00 ldx #0
182 FA5D 86 63 stx logcol
183 FA5F A4 6C ldy _start_y
184 FA61 84 54 sty rowcrs
185 FA63 20 44 F9 jsr ScreenComputeToAddr
186
187 FA66 A4 6D ldy _start_x
188 FA68 char_loop:
189 FA68 E6 63 inc logcol
190 FA6A B1 66 lda (toadr),y
191 FA6C F0 04 beq blank
192 FA6E A5 63 85 6B mva logcol bufcnt
193 FA72 blank:
194 FA72 C4 53 cpy rmargn
195 FA74 C8 iny
196 FA75 90 F1 bcc char_loop
197 FA77 20 8A FD jsr EditorNextLineAddr
198
199 ;check if we're at the bottom of the screen
200 FA7A E6 54 inc rowcrs
201 FA7C A5 54 lda rowcrs
202 FA7E CD BF 02 cmp botscr
203 FA81 B0 0A bcs scan_scroll
204
205 ;check if we're at the end of the logical line
206 FA83 20 43 FD jsr EditorTestLogicalLineBit
207 FA86 D0 08 bne scan_done
208
209 FA88 A4 52 ldy lmargn
210 FA8A 4C 68 FA jmp char_loop
211
212 FA8D scan_scroll:
213 ;we're below the screen... need to scroll up
214 FA8D 20 BC FC jsr EditorDeleteLine0
215
216 FA90 scan_done:
217 ;adjust BUFCNT so it is the number of chars to read (scanned + EOL)
218 FA90 E6 6B inc bufcnt
219
220 ;mark this as the start of a new logical line, trimming off any extra
221 ;blank lines
222 FA92 A5 54 lda rowcrs
223 FA94 20 36 FD jsr EditorGetLogicalLineInfo
224 FA97 19 B2 02 ora logmap,y
225 FA9A 99 B2 02 sta logmap,y
226
227 ;reset cursor to line start, but leave the cursor off
228 FA9D A6 6D 86 55 mvx _start_x colcrs
229 FAA1 A4 6C 84 54 mvy _start_y rowcrs
230
231 ;swap back to main context and exit successfully
232 FAA5 4C 61 FD jmp EditorSwapToScreen_Y1
233 .endp
234
235 ;==========================================================================
236 ; This routine must NOT write BUFADR -- doing so breaks the DLT flasher.
237 ;
238 ; Behavior notes:
239 ; - Ctrl+1 (suspend display) does not affect control codes handled only
240 ; by E:. In particular, EOL, move up/down/left/right, ESC, insert, and
241 ; delete are not affected by it. CLEAR on the other hand, is, because
242 ; it's handled by S:.
243 ;
244 FAA8 .proc EditorPutByte
245 ;open the text screen if it is not open already
246 FAA8 A4 57 ldy dindex
247 FAAA F0 0C beq screenok
248 FAAC AC BF 02 ldy botscr
249 FAAF C0 04 cpy #4
250 FAB1 F0 05 beq screenok
251
252 FAB3 48 pha
253 FAB4 20 EE F3 jsr ScreenOpenGr0
254 FAB7 68 pla
255 FAB8 screenok:
256
257 ;swap to text context
258 FAB8 20 0A F9 jsr EditorSwapToText
259
260 ;hide the cursor -- this must be done before we suspend display on
261 ;Ctrl+1.
262 FABB 20 BE F8 jsr ScreenHideCursor
263
264 ;save off character to free up acc
265 FABE A8 tay
266
267 ;Check if [esc] is active
268 ;
269 ;Note that the ASL trick relies on ESCFLG being $80 when set; this
270 ;is in fact guaranteed by the spec in the OS Manual, Appendix L, B26.
271 ;
272 FABF 0E A2 02 asl escflg ;test and clear escape flag
273 FAC2 B0 1E bcs not_special
274
275 ;check if this might be a special character
276 FAC4 29 1F and #$1f
277 FAC6 C9 1B cmp #$1b
278 FAC8 90 18 bcc not_special
279
280 ;might be special, but not EOL... search the special char table
281 FACA A2 0E ldx #special_code_tab_end-special_code_tab-1
282 FACC 98 tya
283 FACD 20 A7 FC jsr EditorIsSpecial
284 FAD0 D0 10 bne not_special
285
286 FAD2 special_found:
287 ;check if display of control codes is desired; if so, we need to ignore this
288 FAD2 AD FE 02 lda dspflg
289 FAD5 D0 0B bne not_special
290
291 ;jump to routine
292 FAD7 20 53 FC jsr dispatch
293 FADA 20 B0 FC jsr EditorRecomputeCursorAddr
294 FADD 20 E5 FD jsr ScreenShowCursorAndXitOK
295 FAE0 10 06 bpl xit2 ;!! - unconditional jump
296
297 FAE2 not_special:
298 ;ok, just put the char to the screen
299 FAE2 8C FB 02 sty atachr
300 FAE5 20 F7 F5 jsr ScreenPutByte.not_clear
301 FAE8 xit2:
302 ;swap back to main context and exit
303 FAE8 4C 63 FD jmp EditorSwapToScreen
304
305 ;---------------
306 FAEB special_code_tab:
307 FAEB 1B dta $1b
308 FAEC 1C dta $1c
309 FAED 1D dta $1d
310 FAEE 1E dta $1e
311 FAEF 1F dta $1f
312 FAF0 7D dta $7d
313 FAF1 7E dta $7e
314 FAF2 7F dta $7f
315 FAF3 9C dta $9c
316 FAF4 9D dta $9d
317 FAF5 9E dta $9e
318 FAF6 9F dta $9f
319 FAF7 FD dta $fd
320 FAF8 FE dta $fe
321 FAF9 FF dta $ff
322 FAFA special_code_tab_end:
323 FAFA 9B dta $9b ;these are only for the K: check
324 FAFB 7C dta $7c
325 FAFC special_code_tab_end_2:
326
327 ;----------------
328
329 FAFC special_dispatch_lo_tab:
330 FAFC 0A dta <(special_escape-1)
331 FAFD 13 dta <(special_up-1)
332 FAFE 1D dta <(special_down-1)
333 FAFF B1 dta <(special_left-1)
334 FB00 BE dta <(special_right-1)
335 FB01 10 dta <(special_clear-1)
336 FB02 38 dta <(special_backspace-1)
337 FB03 77 dta <(special_tab-1)
338 FB04 C7 dta <(special_delete_line-1)
339 FB05 CD dta <(special_insert_line-1)
340 FB06 64 dta <(special_clear_tab-1)
341 FB07 5C dta <(special_set_tab-1)
342 FB08 59 dta <(special_bell-1)
343 FB09 D4 dta <(special_delete_char-1)
344 FB0A E0 dta <(special_insert_char-1)
345
346 .if [((special_escape-1)^(special_insert_char-1))&$ff00]
347 .error 'Special character routines cross a page boundary: ',special_escape,'-',special_insert_char
348 .endif
349
350 ;---------------
351 FB0B special_escape:
352 FB0B A9 80 8D A2 02 mva #$80 escflg
353 FB10 60 rts
354
355 ;---------------
356 FB11 special_clear:
357 FB11 4C 17 F8 jmp ScreenClear
358
359 ;---------------
360 FB14 special_up:
361 FB14 A6 54 ldx rowcrs
362 FB16 D0 03 bne isup2
363 FB18 AE BF 02 ldx botscr
364 FB1B isup2:
365 FB1B CA dex
366 FB1C 10 0A bpl vmoveexit
367
368 ;---------------
369 FB1E special_down:
370 FB1E A6 54 ldx rowcrs
371 FB20 E8 inx
372 FB21 EC BF 02 cpx botscr
373 FB24 90 02 A2 00 scc:ldx #0
374
375 FB28 vmoveexit:
376 FB28 86 54 stx rowcrs
377
378 ;check if we have moved into a different logical line -- if so,
379 ;we need to reset the read row
380 FB2A 8A txa
381 FB2B 20 4C FD jsr EditorPhysToLogicalRow
382 FB2E C5 6C cmp bufstr
383 FB30 F0 06 beq moveexit
384
385 ;we switched rows -- reset read row
386 FB32 85 6C sta bufstr
387 FB34 A5 52 85 6D mva lmargn bufstr+1
388
389 FB38 moveexit:
390 FB38 60 rts
391
392 ;---------------
393 FB39 special_backspace:
394 ;check if we are at the left column
395 FB39 A5 52 lda lmargn
396 FB3B C5 55 cmp colcrs
397 FB3D B0 0B bcs sbks_wrap
398
399 ;nope, we can just back up
400 FB3F C6 55 dec colcrs
401
402 ;recompute pos and clear character
403 FB41 sbks_recomp:
404 FB41 20 B0 FC jsr EditorRecomputeCursorAddr
405 FB44 A0 00 ldy #0
406 FB46 98 tya
407 FB47 91 5E sta (oldadr),y
408 FB49 sbks_xit:
409 FB49 60 rts
410
411 FB4A sbks_wrap:
412 ;check if we're at the start of the logical line
413 FB4A A5 54 lda rowcrs
414 FB4C 20 43 FD jsr EditorTestLogicalLineBit
415 FB4F D0 F8 bne sbks_xit
416
417 ;no, so we need to wrap to the right column of the prev line...
418 FB51 C6 54 dec rowcrs
419 FB53 A5 53 lda rmargn
420 FB55 85 55 sta colcrs
421
422 ;recompute everything and exit
423 FB57 4C 41 FB jmp sbks_recomp
424
425 ;----------------
426 FB5A special_bell:
427 FB5A 4C 5C FD jmp EditorBell
428
429 ;----------------
430 FB5D special_set_tab:
431 FB5D 20 71 FB jsr special_common_tab
432 FB60 1D A3 02 ora tabmap,x
433 FB63 D0 08 bne special_common_exit_tab
434
435 FB65 special_clear_tab:
436 FB65 20 71 FB jsr special_common_tab
437 FB68 49 FF eor #$ff
438 FB6A 3D A3 02 and tabmap,x
439 FB6D special_common_exit_tab:
440 FB6D 9D A3 02 sta tabmap,x
441 FB70 60 rts
442
443 FB71 special_common_tab:
444 FB71 20 6C FD jsr EditorGetLogicalColumn
445 FB74 A8 tay
446 FB75 4C 7B FD jmp EditorSetupTabIndex
447
448 ;--------------------------------------------------------------------------
449 ; Tab behavior:
450 ; - Moves cursor to the next tab position within the logical line.
451 ; - If there are no more tabs, moves cursor to beginning of next line.
452 ; This may cause a scroll.
453 ; - Tab does NOT adjust the read row.
454 ;
455 FB78 special_tab:
456 FB78 20 6C FD jsr EditorGetLogicalColumn
457 FB7B A8 tay
458 FB7C 8A txa
459 FB7D 38 sec
460 FB7E 65 54 adc rowcrs
461 FB80 85 54 sta rowcrs
462
463 ;scan forward until we find the next bit set, or we hit position 120
464 FB82 tab_scan_loop:
465 FB82 C8 iny
466 FB83 C0 78 cpy #120
467 FB85 B0 08 bcs tab_found
468 FB87 20 7B FD jsr EditorSetupTabIndex
469 FB8A 3D A3 02 and tabmap,x
470 FB8D F0 F3 beq tab_scan_loop
471 FB8F tab_found:
472 FB8F 84 55 sty colcrs
473 FB91 tab_adjust_row:
474 FB91 A5 55 lda colcrs
475 FB93 38 sec
476 FB94 E9 28 sbc #40 ;subtract a row worth of columns
477 FB96 90 19 bcc tab_adjust_done ;exit if <40
478 FB98 85 55 sta colcrs
479 FB9A E6 54 inc rowcrs ;next row
480 FB9C A5 54 lda rowcrs ;
481 FB9E CD BF 02 cmp botscr ;check if we're below the screen
482 FBA1 B0 07 bcs tab_adjust_scroll ;if so, do a scroll
483 FBA3 20 43 FD jsr EditorTestLogicalLineBit ;check if we're on a new log line
484 FBA6 F0 E9 beq tab_adjust_row ;if not, keep adjusting
485 FBA8 10 03 bpl tab_adjust_left ;position at beginning of new line
486
487 FBAA tab_adjust_scroll:
488 FBAA 20 BC FC jsr EditorDeleteLine0
489 FBAD tab_adjust_left:
490 FBAD hmove_to_lmargn:
491 ;move to left margin
492 FBAD A6 52 ldx lmargn
493 FBAF hmove_to_x:
494 FBAF 86 55 stx colcrs
495 FBB1 tab_adjust_done:
496 FBB1 60 rts
497
498 ;--------------------------------------------------------------------------
499 FBB2 special_left:
500 FBB2 A6 55 ldx colcrs
501 FBB4 F0 05 beq slft_to_right
502 FBB6 CA dex
503 FBB7 E4 52 cpx lmargn
504 FBB9 B0 F4 bcs hmove_to_x
505
506 ;move to right margin
507 FBBB slft_to_right:
508 FBBB A6 53 ldx rmargn
509 FBBD 90 F0 bcc hmove_to_x
510
511 ;--------------------------------------------------------------------------
512 FBBF special_right:
513 FBBF A6 55 ldx colcrs
514 FBC1 E4 53 cpx rmargn
515 FBC3 B0 E8 bcs hmove_to_lmargn
516
517 ;right one char
518 FBC5 E6 55 inc colcrs
519 FBC7 60 rts
520
521 ;--------------------------------------------------------------------------
522 ; Delete line behavior:
523 ; - The entire logical line that the cursor is in is deleted.
524 ; - The cursor is positioned at the beginning of the next logical line.
525 ;
526 FBC8 special_delete_line:
527 ;delete current logical line
528 FBC8 20 4A FD jsr EditorGetCurLogicalRow
529 FBCB 4C BE FC jmp EditorDeleteLine
530
531 ;----------------
532 FBCE special_insert_line:
533 ;insert a new logical line at this point; note that this may split
534 ;the current line
535 FBCE 38 sec
536 FBCF 20 5B F8 jsr ScreenInsertLine
537 FBD2 4C AD FB jmp tab_adjust_left
538
539 ;--------------------------------------------------------------------------
540 ; Delete character behavior:
541 ; - Erases the current character and drags in characters from the
542 ; remainder of the logical line, excluding the margins.
543 ; - If the last physical line is blank and not the only physical line in
544 ; the logical line, it is deleted and the logical line is shortened.
545 ; Only one line is removed even if the last two lines are blank. The
546 ; cursor does not move when this happens and may be shifted into the
547 ; next logical line. This also does not change the input line!
548 ;
549 FBD5 special_delete_char:
550 ;compute base address of current row (not char)
551 FBD5 A4 54 ldy rowcrs
552 FBD7 84 51 sty hold1
553 FBD9 20 42 F9 jsr ScreenComputeToAddrX0
554
555 ;begin shifting in the first column at the current pos
556 FBDC A4 55 ldy colcrs
557
558 ;delete chars to end
559 FBDE 4C 6C FC jmp delete_shift_loop_entry
560
561 ;--------------------------------------------------------------------------
562 ; Insert character behavior:
563 ; - Inserts a blank at the current position and shifts characters forward
564 ; within the margins.
565 ; - If the character shifted out of the end of the logical line is non-
566 ; blank, the logical line will be extended if possible. This can cause
567 ; a scroll. If the logical line is already three rows, the last
568 ; character is lost.
569 ;
570 FBE1 special_insert_char:
571 ;get logical line start
572 FBE1 20 4A FD jsr EditorGetCurLogicalRow
573
574 ;compute line at which we cannot add another physical line
575 FBE4 18 69 03 add #3
576 FBE7 85 76 sta deltar
577
578 ;compute address of row
579 FBE9 A4 54 ldy rowcrs
580 FBEB 84 51 sty hold1
581 FBED 20 42 F9 jsr ScreenComputeToAddrX0
582
583 FBF0 A4 55 ldy colcrs ;end shift at current column
584 FBF2 A2 00 ldx #0 ;insert blank character at start
585 FBF4 F0 04 beq insert_line_loop_entry
586
587 FBF6 insert_line_loop:
588 FBF6 A4 52 ldy lmargn ;end shift at left column
589 FBF8 A6 50 ldx tmpchr ;character to shift in (from last line)
590
591 FBFA insert_line_loop_entry:
592 FBFA 84 65 sty adress+1 ;stash shift origin
593 FBFC A4 53 ldy rmargn ;begin shift at right column
594 FBFE B1 66 lda (toadr),y ;get character being shifted out
595 FC00 85 50 sta tmpchr ;save it off to later shift in on the next row
596 FC02 insert_shift_loop:
597 FC02 88 dey
598 FC03 B1 66 lda (toadr),y
599 FC05 C8 iny
600 FC06 91 66 sta (toadr),y
601 FC08 88 dey
602 FC09 C4 65 cpy adress+1
603 FC0B D0 F5 bne insert_shift_loop
604
605 ;put character shifted out from previous line into beginning of this one
606 FC0D 8A txa
607 FC0E 91 66 sta (toadr),y
608
609 ;next row
610 FC10 E6 51 inc hold1
611
612 FC12 20 8A FD jsr EditorNextLineAddr
613
614 ;check if we're at the end of the logical line
615 FC15 A5 51 lda hold1
616 FC17 CD BF 02 cmp botscr
617 FC1A B0 05 bcs insert_crossed_lline
618 FC1C 20 43 FD jsr EditorTestLogicalLineBit
619 FC1F F0 D5 beq insert_line_loop
620 FC21 insert_crossed_lline:
621
622 ;check if we shifted out a non-blank character
623 FC21 A5 50 lda tmpchr
624 FC23 F0 2D beq insert_done
625
626 ;save current row
627 FC25 A5 54 lda rowcrs
628 FC27 48 pha
629
630 ;check if the logical line is already 3 rows -- if so, we cannot extend and
631 ;the last char goes into the bit bucket, but we still must scroll (!)
632 FC28 A6 51 ldx hold1
633 FC2A E4 76 cpx deltar
634 FC2C 08 php
635
636 ;move to the bottom line +1; we use ROWCRS so it stays updated with the scrolling
637 FC2D 86 54 stx rowcrs
638
639 ;check if we are at the bottom of the screen; if so we must scroll
640 FC2F A9 00 lda #0
641 FC31 85 76 sta deltar
642
643 FC33 EC BF 02 cpx botscr
644 FC36 90 03 bcc insert_no_scroll
645
646 ;scroll the screen
647 FC38 20 BC FC jsr EditorDeleteLine0
648
649 FC3B insert_no_scroll:
650 ;if we can't extend, we are done
651 FC3B 28 plp
652 FC3C B0 0E bcs insert_cant_extend
653
654 ;just insert a blank line at the end of this logical row to extend it
655 FC3E 20 5A F8 jsr ScreenInsertPhysLine
656
657 ;restore shifted character and put it in place
658 FC41 A4 54 ldy rowcrs
659 FC43 20 42 F9 jsr ScreenComputeToAddrX0
660 FC46 A5 50 lda tmpchr
661 FC48 A4 52 ldy lmargn
662 FC4A 91 66 sta (toadr),y
663 FC4C insert_cant_extend:
664
665 ;restore cursor row, adjusting for any scroll
666 FC4C 68 pla
667 FC4D 38 sec
668 FC4E E5 76 sbc deltar
669 FC50 85 54 sta rowcrs
670
671 FC52 insert_done:
672 FC52 60 rts
673
674 ;---------------------------------
675 FC53 dispatch:
676 FC53 A9 FB lda #>special_escape
677 FC55 48 pha
678 FC56 BD FC FA lda special_dispatch_lo_tab,x
679 FC59 48 pha
680 FC5A 60 rts
681
682 ;---------------------------------
683 FC5B delete_line_loop:
684 ;copy first character into right margin of previous row
685 FC5B A4 52 ldy lmargn
686 FC5D B1 66 lda (toadr),y
687 FC5F A4 53 ldy rmargn
688 FC61 91 68 sta (frmadr),y
689
690 ;start shifting new row at left margin
691 FC63 A4 52 ldy lmargn
692 FC65 delete_shift_loop:
693 FC65 C8 iny
694 FC66 B1 66 lda (toadr),y
695 FC68 88 dey
696 FC69 91 66 sta (toadr),y
697 FC6B C8 iny
698 FC6C delete_shift_loop_entry:
699 FC6C C4 53 cpy rmargn
700 FC6E D0 F5 bne delete_shift_loop
701
702 ;next line
703 FC70 20 8A FD jsr EditorNextLineAddr
704
705 ;check if the next row is a logical line start
706 FC73 A6 51 ldx hold1
707 FC75 E8 inx
708 FC76 EC BF 02 cpx botscr
709 FC79 B0 08 bcs delete_stop_shifting
710 FC7B 86 51 stx hold1
711 FC7D 8A txa
712 FC7E 20 43 FD jsr EditorTestLogicalLineBit
713
714 ;keep going if not
715 FC81 F0 D8 beq delete_line_loop
716
717 FC83 delete_stop_shifting:
718 ;blank the last character of the last line
719 FC83 A4 53 ldy rmargn
720 FC85 A9 00 lda #0
721 FC87 91 68 sta (frmadr),y
722
723 ;check if the last line is blank
724 FC89 delete_blank_test_loop:
725 FC89 B1 68 lda (frmadr),y
726 FC8B D0 19 bne delete_not_blank
727 FC8D 88 dey
728 FC8E C4 52 cpy lmargn
729 FC90 B0 F7 bcs delete_blank_test_loop
730
731 ;the last line is blank... check if it is a logical line start
732 FC92 C6 51 dec hold1
733 FC94 A5 51 lda hold1
734 FC96 20 43 FD jsr EditorTestLogicalLineBit
735
736 ;skip if so -- we can't delete the entire logical line
737 FC99 D0 0B bne delete_not_blank
738
739 ;delete this physical line... however, do not move the cursor and
740 ;do not change the read line even if the cursor hops to a new one
741 FC9B A5 55 lda colcrs
742 FC9D 48 pha
743 FC9E A5 51 lda hold1
744 FCA0 20 BE FC jsr EditorDeleteLine
745 FCA3 68 pla
746 FCA4 85 55 sta colcrs
747
748 FCA6 delete_not_blank:
749 ;re-show cursor and exit
750 FCA6 60 rts
751
752 .endp
753
754 ;==========================================================================
755 FCA7 .proc EditorIsSpecial
756 FCA7 special_binsearch:
757 FCA7 DD EB FA cmp EditorPutByte.special_code_tab,x
758 FCAA F0 03 beq special_found
759 FCAC CA dex
760 FCAD 10 F8 bpl special_binsearch
761 FCAF special_found:
762 FCAF 60 rts
763 .endp
764
765 ;==========================================================================
766 FCB0 .proc EditorRecomputeCursorAddr
767 FCB0 A6 55 ldx colcrs
768 FCB2 A4 54 ldy rowcrs
769 FCB4 20 2C F9 jsr ScreenComputeAddr
770 FCB7 86 5E stx oldadr
771 FCB9 85 5F sta oldadr+1
772 FCBB 60 rts
773 .endp
774
775 ;==========================================================================
776 ; Delete a logical line on screen, and scroll the remainder of the screen
777 ; upward.
778 ;
779 ; Inputs:
780 ; A = physical line row to delete
781 ;
782 ; Outputs:
783 ; DELTAR = number of lines scrolled
784 ;
785 = FCBE EditorDeleteLine = EditorDeleteLine0.use_line
786 FCBC .proc EditorDeleteLine0
787 FCBC A9 00 lda #0
788 FCBE use_line:
789 FCBE 85 51 sta hold1
790 FCC0 A2 00 ldx #0
791 FCC2 86 76 stx deltar
792
793 FCC4 scroll_loop:
794 ;compute base address and set that as destination
795 FCC4 A4 51 ldy hold1
796
797 .if _KERNEL_XLXE
798 sec
799 bne nofine
800 ldx fine
801 beq nofine
802 ldx #0
803 xloop:
804 lda rtclok+2
805 cmp:req rtclok+2
806 inx
807 stx vscrol
808 cpx #7
809 bne xloop
810 lda #32/2
811 cmp:rcc vcount
812 cmp:rcs vcount
813 nofine:
814 php ;C=0 for fine scroll, C=1 for coarse scroll
815 .endif
816
817 ;set TOADR to the line to be deleted
818 FCC6 20 42 F9 jsr ScreenComputeToAddrX0
819
820 FCC9 A6 51 ldx hold1
821 FCCB 10 0C bpl line_loop_start
822
823 FCCD line_loop:
824 ;bump line: FRMADR <- TOADR, TOADR += 40
825 FCCD 20 8A FD jsr EditorNextLineAddr
826
827 ;move line -- note that we are copying backwards (TOADR to FRMADR)!
828 FCD0 A0 27 ldy #39
829 FCD2 B1 66 91 68 88 10 + mva:rpl (toadr),y (frmadr),y-
830
831 FCD9 line_loop_start:
832 FCD9 E8 inx
833 FCDA EC BF 02 cpx botscr
834 FCDD D0 EE bne line_loop
835
836 ;clear the last line
837 FCDF A0 27 ldy #39
838 FCE1 A9 00 lda #0
839 FCE3 91 66 88 10 FB sta:rpl (toadr),y-
840
841 .if _KERNEL_XLXE
842 plp
843 bcs nofinescroll2
844 sta vscrol
845 nofinescroll2:
846 .endif
847
848 FCE8 20 1D FD jsr adjust_lines
849
850 ;delete bits out of the logical mask until we get to the next
851 ;logical line, computing the number of lines to scroll
852 FCEB A5 51 lda hold1
853 FCED 20 36 FD jsr EditorGetLogicalLineInfo
854 FCF0 BE 1A FD ldx update_table,y ;get number of masks to shift
855 FCF3 38 sec ;setup to add a new logical line at the end
856 FCF4 F0 09 beq do_mask ;jump to masking if we're on byte 2
857 FCF6 2E B4 02 rol logmap+2 ;shift byte 2
858 FCF9 CA dex ;
859 FCFA F0 03 beq do_mask ;jump to masking if we're on byte 1
860 FCFC 2E B3 02 rol logmap+1 ;shift byte 1
861 FCFF do_mask:
862 FCFF 85 64 sta adress ;stash mask
863 FD01 49 FF eor #$ff ;invert mask
864 FD03 39 B2 02 and logmap,y ;kill target bit
865 FD06 85 65 sta adress+1 ;stash modified mask
866 FD08 C6 64 dec adress ;form mask for LSBs below bit
867 FD0A 25 64 and adress ;isolate those bits
868 FD0C 65 65 adc adress+1 ;shift those up and the bit from the next byte in
869 FD0E 99 B2 02 sta logmap,y ;write to logmap
870
871 FD11 E6 76 inc deltar ;increment line count
872 FD13 E6 64 inc adress ;revert mask
873 FD15 24 64 bit adress ;test if we still have a logical line
874
875 ;loop back if we need to delete more physical lines
876 FD17 F0 AB beq scroll_loop
877
878 ;all done
879 FD19 60 rts
880
881 FD1A update_table:
882 FD1A 02 01 00 dta 2,1,0
883
884 FD1D adjust_lines:
885 FD1D A5 52 lda lmargn ;prep for line adjustments
886
887 ;adjust the read row if it is affected by the deletion
888 FD1F A2 6C ldx #<bufstr
889 FD21 20 26 FD jsr adjust_line
890
891 ;adjust the cursor row if it is affected by the deletion
892 FD24 A2 54 ldx #<rowcrs
893 FD26 adjust_line:
894 FD26 B4 00 ldy 0,x ;get row
895 FD28 C4 51 cpy hold1 ;compare against deletion pos
896 FD2A 90 07 bcc adjust_line_above ;nothing to do if it's above del range
897 FD2C D0 03 bne adjust_line_below ;skip col adjust if it's below del range
898 FD2E 95 01 sta 1,x ;within range - move cursor to left mgn
899 FD30 60 rts
900 FD31 adjust_line_below:
901 FD31 D6 00 dec 0,x
902 FD33 adjust_line_above:
903 FD33 60 rts
904 .endp
905
906 ;==========================================================================
907 = E4C9 EditorGetStatus = CIOExitSuccess
908 = E4CB EditorSpecial = CIOExitNotSupported
909 = E4CB EditorInit = CIOExitNotSupported
910
911 ;==========================================================================
912 ; Entry:
913 ; A = line
914 ;
915 ; Exit:
916 ; P = bit test status
917 ; A = bit mask
918 ; X = bit index
919 ; Y = mask index
920 ;
921 = FD34 EditorGetCurLogicalLineInfo = _EditorGetLogicalLineInfo
922 = FD36 EditorGetLogicalLineInfo = _EditorGetLogicalLineInfo.use_a
923 FD34 .proc _EditorGetLogicalLineInfo
924 FD34 A5 54 lda rowcrs
925 FD36 use_a:
926 FD36 48 pha
927 FD37 4A lsr
928 FD38 4A lsr
929 FD39 4A lsr
930 FD3A A8 tay
931 FD3B 68 pla
932 FD3C 29 07 and #7
933 FD3E AA tax
934 FD3F BD C1 E4 lda ReversedBitMasks,x
935 FD42 60 rts
936 .endp
937
938 ;==========================================================================
939 ; Test whether a physical line is the start of a logical line.
940 ;
941 ; Entry:
942 ; A = line
943 ;
944 ; Exit:
945 ; Z = 1 if so, 0 if not
946 ;
947 ; Modified:
948 ; all registers
949 ;
950 FD43 .proc EditorTestLogicalLineBit
951 FD43 20 36 FD jsr EditorGetLogicalLineInfo
952 FD46 39 B2 02 and logmap,y
953 FD49 60 rts
954 .endp
955
956 ;==========================================================================
957 ; Get the starting physical line for a logical line.
958 ;
959 ; Entry:
960 ; A = physical line
961 ;
962 ; Exit:
963 ; A = logical line start
964 ;
965 ; Modified:
966 ; ADRESS
967 ;
968 = FD4C EditorPhysToLogicalRow = EditorGetCurLogicalRow.use_line
969 FD4A .proc EditorGetCurLogicalRow
970 FD4A A5 54 lda rowcrs
971 FD4C use_line:
972 FD4C 85 64 sta adress
973 FD4E test_loop:
974 FD4E A5 64 lda adress
975 FD50 20 43 FD jsr EditorTestLogicalLineBit
976 FD53 D0 04 bne found
977 FD55 C6 64 dec adress
978 FD57 D0 F5 bne test_loop
979 FD59 found:
980 FD59 A5 64 lda adress
981 FD5B 60 rts
982 .endp
983
984 ;==========================================================================
985 FD5C .proc EditorBell
986 FD5C A0 00 ldy #0
987 FD5E 4C CC E4 jmp Bell
988 .endp
989
990 ;==========================================================================
991 FD61 .proc EditorSwapToScreen_Y1
992 FD61 A0 01 ldy #1
993 = FD63 .def :EditorSwapToScreen = *
994 FD63 84 64 sty adress
995 FD65 18 clc
996 FD66 20 0F F9 jsr ScreenSwap
997 FD69 A4 64 ldy adress
998 FD6B 60 rts
999 .endp
1000
1001 ;==========================================================================
1002 ; Compute the current logical column.
1003 ;
1004 ; Exit:
1005 ; A = column
1006 ; X = inverted row index (0-2 => $ff-$fd)
1007 ;
1008 FD6C .proc EditorGetLogicalColumn
1009 ;get starting row of logical line
1010 FD6C A5 54 lda rowcrs
1011 FD6E 20 4C FD jsr EditorPhysToLogicalRow
1012
1013 ;subtract off current row
1014 FD71 18 clc
1015 FD72 E5 54 sbc rowcrs
1016 FD74 AA tax
1017
1018 ;multiply negated difference by 40
1019 FD75 BD A0 FC lda EditorLineLengthTab-$fc,x
1020
1021 ;add in physical column
1022 FD78 65 55 adc colcrs
1023 FD7A 60 rts
1024 .endp
1025
1026 ;==========================================================================
1027 FD7B .proc EditorSetupTabIndex
1028 FD7B 98 tya
1029 FD7C 29 07 and #7
1030 FD7E AA tax
1031 FD7F BD C1 E4 lda ReversedBitMasks,x
1032 FD82 48 pha
1033 FD83 98 tya
1034 FD84 4A lsr
1035 FD85 4A lsr
1036 FD86 4A lsr
1037 FD87 AA tax
1038 FD88 68 pla
1039 FD89 60 rts
1040 .endp
1041
1042 ;==========================================================================
1043 ; Copy TOADR to FRMADR and add 40 to TOADR.
1044 ;
1045 FD8A .proc EditorNextLineAddr
1046 FD8A A5 66 lda toadr
1047 FD8C 85 68 sta frmadr
1048 FD8E 18 69 28 add #40
1049 FD91 85 66 sta toadr
1050 FD93 A5 67 lda toadr+1
1051 FD95 85 69 sta frmadr+1
1052 FD97 69 00 adc #0
1053 FD99 85 67 sta toadr+1
1054 FD9B 60 rts
1055 .endp
1056
1057 ;==========================================================================
1058 FD9C .proc EditorLineLengthTab
1059 FD9C 78 50 28 00 dta 120, 80, 40, 0
1060 .endp
1061
271
272 .ifdef _KERNEL_816
273 icl 'screenext816.s'
274 .else
275 FDA0 icl 'screenext.s'
Source: source/Shared/screenext.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Screen Handler extension routines
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 FDA0 ScreenEncodingOffsetTable:
12 FDA0 00 dta $00 ;4-bit
13 FDA1 10 dta $10 ;2-bit
14 FDA2 14 dta $14 ;1-bit
15
16 .if !_KERNEL_XLXE
17 FDA3 _SCREEN_TABLES_3
Macro: _SCREEN_TABLES_3 [Source: source/Shared/screen.s]
2 FDA3 00 11 22 33 44 55 + dta $00,$11,$22,$33,$44,$55,$66,$77,$88,$99,$aa,$bb,$cc,$dd,$ee,$ff
3 FDB3 00 55 AA FF dta $00,$55,$aa,$ff
4 FDB7 00 FF dta $00,$ff
Source: source/Shared/screenext.s
18 .endif
19
20 ;==========================================================================
21 ; ScreenFineScrollDLI
22 ;
23 ; This DLI routine is used to set the PF1 color to PF2 to kill junk that
24 ; would appear on the extra line added with vertical scrolling.
25 ;
26 .if _KERNEL_XLXE
27 .proc ScreenFineScrollDLI
28 pha
29 lda color2
30 eor colrsh
31 and drkmsk
32 sta colpf1
33 pla
34 rti
35 .endp
36 .endif
37
38 ;==========================================================================
39 ; ScreenResetLogicalLineMap
40 ;
41 ; Marks all lines as the start of logical lines.
42 ;
43 ; Exit:
44 ; X = 0
45 ;
46 FDB9 .proc ScreenResetLogicalLineMap
47 FDB9 A2 FF ldx #$ff
48 FDBB 8E B2 02 stx logmap
49 FDBE 8E B3 02 stx logmap+1
50 FDC1 8E B4 02 stx logmap+2
51
52 ;reset line read position
53 FDC4 E8 inx
54 FDC5 86 6C stx bufstr
55 FDC7 A5 52 lda lmargn
56 FDC9 85 6D sta bufstr+1
57
58 ;note - X=0 relied on here by EditorOpen
59 FDCB 60 rts
60 .endp
61
62 ;==========================================================================
63 ; ScreenSetLastPosition
64 ;
65 ; Copies COLCRS/ROWCRS to OLDCOL/OLDROW.
66 ;
67 FDCC .proc ScreenSetLastPosition
68 FDCC A2 02 ldx #2
69 FDCE loop:
70 FDCE B5 54 lda rowcrs,x
71 FDD0 95 5A sta oldrow,x
72 FDD2 CA dex
73 FDD3 10 F9 bpl loop
74 FDD5 60 rts
75 .endp
76
77 ;==========================================================================
78 ; ScreenAdvancePosMode0
79 ;
80 ; Advance to the next cursor position in reading order, for mode 0.
81 ;
82 ; Exit:
83 ; C = 1 if no wrap, 0 if wrapped
84 ;
85 ; Modified:
86 ; X
87 ;
88 ; Preserved:
89 ; A
90 ;
91 FDD6 .proc ScreenAdvancePosMode0
92 FDD6 E6 55 inc colcrs
93 FDD8 A6 53 ldx rmargn
94 FDDA E4 55 cpx colcrs
95 FDDC B0 06 bcs post_wrap
96 FDDE A6 52 ldx lmargn
97 FDE0 86 55 stx colcrs
98 FDE2 E6 54 inc rowcrs
99 FDE4 post_wrap:
100 FDE4 60 rts
101 .endp
102
103
104 ;==========================================================================
105 ; Output:
106 ; Y=1 for convenience
107 ;
108 ; (OLDADR) must point to the cursor location with OLDCHR even if the cursor
109 ; is hidden. This is required by SDX QUICKED.SYS, which always restores the
110 ; cursor.
111 ;
112 FDE5 .proc ScreenShowCursorAndXitOK
113 ;;##ASSERT dw(oldadr) >= dw(savmsc)
114 ;check if the cursor is enabled
115 FDE5 A0 00 ldy #0
116 FDE7 B1 5E lda (oldadr),y
117 FDE9 85 5D sta oldchr
118 FDEB AC F0 02 ldy crsinh
119 FDEE D0 04 bne cursor_inhibited
120 FDF0 49 80 eor #$80
121 FDF2 91 5E sta (oldadr),y
122 FDF4 cursor_inhibited:
123 FDF4 C8 iny
124 FDF5 60 rts
125 .endp
126
127 ;==========================================================================
128 ; Close screen (S:).
129 ;
130 ; This is a no-op in OS-B mode. In XL/XE mode, it reopens the device in
131 ; Gr.0 if fine scrolling is on, since this is necessary to clear the DLI.
132 ; This happens even if S: doesn't correspond to the text window. Only
133 ; the high bit of FINE is checked.
134 ;
135 .if !_KERNEL_XLXE
136 = E4C9 ScreenClose = CIOExitSuccess
137 .else
138 .proc ScreenClose
139 bit fine
140 bmi disable_fine_scrolling
141
142 ldy #1
143 rts
144
145 disable_fine_scrolling:
146 ;turn off DLI
147 mva #$40 nmien
148
149 ;restore vdslst
150 ldx #<IntExitHandler_None
151 lda #>IntExitHandler_None
152 jsr ScreenOpenGr0.write_vdslst
153
154 jmp ScreenOpenGr0
155 .endp
156 .endif
157
158 ;==========================================================================
159 .if !_KERNEL_XLXE
160 FDF6 _SCREEN_TABLES_2
Macro: _SCREEN_TABLES_2 [Source: source/Shared/screen.s]
23 FDF6 40 dta <($10000-$03C0) ;gr.0 960 bytes = 40*24 = 40*24
24 FDF7 80 dta <($10000-$0280) ;gr.1 640 bytes = 20*24 + 40*4 = 40*12 + 40*4
25 FDF8 70 dta <($10000-$0190) ;gr.2 400 bytes = 10*24 + 40*4 = 40*6 + 40*4
26 FDF9 70 dta <($10000-$0190) ;gr.3 400 bytes = 10*24 + 40*4 = 40*6 + 40*4
27 FDFA 80 dta <($10000-$0280) ;gr.4 640 bytes = 10*48 + 40*4 = 40*12 + 40*4
28 FDFB A0 dta <($10000-$0460) ;gr.5 1120 bytes = 20*48 + 40*4 = 40*24 + 40*4
29 FDFC E0 dta <($10000-$0820) ;gr.6 2080 bytes = 20*96 + 40*4 = 40*48 + 40*4
30 FDFD 60 dta <($10000-$0FA0) ;gr.7 4000 bytes = 40*96 + 40*4 = 40*96 + 40*4
31 FDFE 50 dta <($10000-$1EB0) ;gr.8 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
32 FDFF 50 dta <($10000-$1EB0) ;gr.9 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
33 FE00 50 dta <($10000-$1EB0) ;gr.10 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
34 FE01 50 dta <($10000-$1EB0) ;gr.11 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
35 FE02 A0 dta <($10000-$0460) ;gr.12 1120 bytes = 40*24 + 40*4 = 40*24 + 40*4
36 FE03 80 dta <($10000-$0280) ;gr.13 640 bytes = 40*12 + 40*4 = 40*12 + 40*4
37 FE04 60 dta <($10000-$0FA0) ;gr.14 4000 bytes = 20*192 + 40*4 = 40*96 + 40*4
38 FE05 50 dta <($10000-$1EB0) ;gr.15 7856 bytes = 40*192 + 40*4 + 16 = 40*192 + 40*4 + 16
42 FE06 FC dta >($10000-$03C0) ;gr.0
43 FE07 FD dta >($10000-$0280) ;gr.1
44 FE08 FE dta >($10000-$0190) ;gr.2
45 FE09 FE dta >($10000-$0190) ;gr.3
46 FE0A FD dta >($10000-$0280) ;gr.4
47 FE0B FB dta >($10000-$0460) ;gr.5
48 FE0C F7 dta >($10000-$0820) ;gr.6
49 FE0D F0 dta >($10000-$0FA0) ;gr.7
50 FE0E E1 dta >($10000-$1EB0) ;gr.8
51 FE0F E1 dta >($10000-$1EB0) ;gr.9
52 FE10 E1 dta >($10000-$1EB0) ;gr.10
53 FE11 E1 dta >($10000-$1EB0) ;gr.11
54 FE12 FB dta >($10000-$0460) ;gr.12
55 FE13 FD dta >($10000-$0280) ;gr.13
56 FE14 F0 dta >($10000-$0FA0) ;gr.14
57 FE15 E1 dta >($10000-$1EB0) ;gr.15
66 FE16 02 06 07 08 09 0A + dta $02,$06,$07,$08,$09,$0A,$0B,$1D,$3F,$7F,$BF,$FF,$04,$05,$1C,$3E
72 FE26 01 dta 1
73 FE27 01 dta 1
74 FE28 00 dta 0
75 FE29 01 dta 1
76 FE2A 02 dta 2
77 FE2B 02 dta 2
78 FE2C 03 dta 3
79 FE2D 03 dta 3
80 FE2E 04 dta 4
81 FE2F 04 dta 4
82 FE30 04 dta 4
83 FE31 04 dta 4
84 FE32 01 dta 1
85 FE33 00 dta 0
86 FE34 04 dta 4
87 FE35 04 dta 4
91 FE36 0C 18 30 60 C0 dta 12, 24, 48, 96, 192
95 FE3B 01 dta 1 ;gr.0 40 pixels
96 FE3C 00 dta 0 ;gr.1 20 pixels
97 FE3D 00 dta 0 ;gr.2 20 pixels
98 FE3E 01 dta 1 ;gr.3 40 pixels
99 FE3F 02 dta 2 ;gr.4 80 pixels
100 FE40 02 dta 2 ;gr.5 80 pixels
101 FE41 03 dta 3 ;gr.6 160 pixels
102 FE42 03 dta 3 ;gr.7 160 pixels
103 FE43 04 dta 4 ;gr.8 320 pixels
104 FE44 02 dta 2 ;gr.9 80 pixels
105 FE45 02 dta 2 ;gr.10 80 pixels
106 FE46 02 dta 2 ;gr.11 80 pixels
107 FE47 01 dta 1 ;gr.12 40 pixels
108 FE48 01 dta 1 ;gr.13 40 pixels
109 FE49 03 dta 3 ;gr.14 160 pixels
110 FE4A 03 dta 3 ;gr.15 160 pixels
Source: source/Shared/screenext.s
161 .endif
276 .endif
277
278 FE4B _KERNEL_REPORT_MODULE_SIZE 'Display routines', 0
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', 0, ')', ' ', 'Display routines'
1 $FE4B -> $0A5D($0000) Display routines
3 = FE4B .def ?@_kernel_lastpt = *
Source: source/main.xasm
279
280 .ifdef _KERNEL_816
281 icl 'keyboard816.s'
282 .else
283 FE4B icl 'keyboard.s'
Source: source/Shared/keyboard.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Keyboard Handler
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 ;==========================================================================
11 ; Oddly, the keyboard IRQs are not enabled from the keyboard init
12 ; routine. It's done by the Display Handler instead on open.
13 ;
14 FE4B .proc KeyboardInit
15 FE4B A2 FF ldx #$ff
16 FE4D 8E FC 02 stx ch
17 FE50 8E F2 02 stx ch1
18 FE53 E8 inx
19 FE54 8E F1 02 stx keydel
20 FE57 8E B6 02 stx invflg
21
22 ;turn on shift lock
23 FE5A A9 40 8D BE 02 mva #$40 shflok
24
25 ;set keyboard definition table pointer
26 .if _KERNEL_XLXE
27 mwa #KeyCodeToATASCIITable keydef
28 .endif
29 FE5F 60 rts
30 .endp
31
32 = E4C9 KeyboardOpen = CIOExitSuccess
33 = E4C9 KeyboardClose = CIOExitSuccess
34
35 ;==========================================================================
36 ; K: GET BYTE handler.
37 ;
38 ; Behavior:
39 ; - Exits with a Break error when break key is pressed.
40 ; - Ctrl-1 does not suspend input here (it is handled by S:/E:).
41 ; - Ctrl-3 returns an EOF error.
42 ; - Caps Lock sets caps mode on OS-A/B depending on Ctrl and Shift key
43 ; state. On the XL/XE OS, pressing Caps Lock alone will enable shift
44 ; lock if no lock is enabled and disable it otherwise.
45 ; - Shift/Control lock is applied by K:, but only on alpha keys.
46 ; - Inverse mode is also applied by K:. Control characters are excluded:
47 ; 1B-1F/7C-7F/9B-9F/FD-FF.
48 ; - Any Ctrl+Shift key code (>=$C0) produces a key click but is otherwise
49 ; ignored.
50 ;
51 FE60 .nowarn .proc _KeyboardGetByte
52 FE60 toggle_shift:
53 .if _KERNEL_XLXE
54 ;Caps Lock without Shift or Control is a toggle on the XL/XE line:
55 ; None -> Shifted
56 ; Shifted, Control -> None
57 ldx shflok
58 bne caps_off
59 ldy #$40
60 .endif
61 FE60 shift_ctrl_on:
62 FE60 caps_off:
63 FE60 98 tya
64 FE61 29 C0 and #$c0
65 FE63 write_shflok:
66 FE63 8D BE 02 sta shflok
67
68 = FE66 .def :KeyboardGetByte
69 FE66 waitForChar:
70 FE66 A2 FF ldx #$ff
71 FE68 waitForChar2:
72 FE68 A5 11 lda brkkey
73 FE6A F0 58 beq isBreak
74 FE6C AD FC 02 lda ch
75 FE6F C9 FF cmp #$ff
76 FE71 F0 F5 beq waitForChar2
77
78 ;invalidate char
79 FE73 8E FC 02 stx ch
80
81 ;do keyboard click (we do this even for ignored ctrl+shift+keys)
82 FE76 A0 0C ldy #12
83 FE78 20 CC E4 jsr Bell
84
85 ;ignore char if both ctrl and shift are pressed
86 FE7B C9 C0 cmp #$c0
87 FE7D B0 E7 bcs waitForChar
88
89 ;trap Ctrl-3 and return EOF
90 FE7F C9 9A cmp #$9a
91 FE81 F0 46 beq isCtrl3
92
93 ;translate char
94 FE83 A8 tay
95
96 .if _KERNEL_XLXE
97 lda (keydef),y
98 .else
99 FE84 B9 0C FF lda KeyCodeToATASCIITable,y
100 .endif
101
102 ;handle special keys (see keytable.s)
103 FE87 10 0E bpl valid_key
104 FE89 C9 81 cmp #$81
105 FE8B 90 D9 bcc waitForChar ;$80 - invalid
106 FE8D F0 2B beq isInverse ;$81 - inverse video
107 FE8F C9 83 cmp #$83
108 FE91 90 CD bcc toggle_shift ;$82 - caps lock
109 FE93 C9 85 cmp #$85
110 FE95 90 C9 bcc shift_ctrl_on ;$83 - shift caps lock / $84 - ctrl caps lock
111
112 FE97 valid_key:
113 ;check for alpha key
114 FE97 C9 61 cmp #'a'
115 FE99 90 0F bcc notAlpha
116 FE9B C9 7B cmp #'z'+1
117 FE9D B0 0B bcs notAlpha
118
119 ;check for shift/control lock
120 FE9F 2C BE 02 bit shflok
121 FEA2 70 04 bvs doShiftLock
122 FEA4 10 04 bpl notAlpha
123
124 ;do control lock logic
125 FEA6 29 1F and #$1f
126
127 FEA8 doShiftLock:
128 FEA8 29 DF and #$df
129
130 FEAA notAlpha:
131 ;check if we should apply inverse flag -- special characters are excluded
132 FEAA A2 10 ldx #EditorPutByte.special_code_tab_end_2-EditorPutByte.special_code_tab-1
133 FEAC 20 A7 FC jsr EditorIsSpecial
134 FEAF F0 03 beq skip_inverse
135
136 ;apply inverse flag
137 FEB1 4D B6 02 eor invflg
138 FEB4 skip_inverse:
139
140 ;return char
141 FEB4 8D FB 02 sta atachr ;required or CON.SYS (SDX 4.46) breaks
142 FEB7 A0 01 ldy #1
143 FEB9 60 rts
144
145 FEBA isInverse:
146 FEBA AD B6 02 lda invflg
147 FEBD 49 80 eor #$80
148 FEBF 8D B6 02 sta invflg
149 FEC2 B0 A2 bcs waitForChar ;!! - unconditional
150
151 FEC4 isBreak:
152 FEC4 86 11 stx brkkey
153 FEC6 A0 80 ldy #CIOStatBreak
154 FEC8 60 rts
155
156 FEC9 isCtrl3:
157 FEC9 A0 88 ldy #CIOStatEndOfFile
158 FECB 60 rts
159 .endp
160
161 ;==============================================================================
162 = E4CB KeyboardPutByte = CIOExitNotSupported
163 = E4C9 KeyboardGetStatus = CIOExitSuccess
164 = E4CB KeyboardSpecial = CIOExitNotSupported
165
166 ;==============================================================================
167 ; Keyboard IRQ
168 ;
169 ; HELP button ($11, $51, and $91):
170 ; - Affects SRTIMR, ATRACT, KEYDEL, and HELPFG
171 ; - Does NOT affect CH, CH1
172 ;
173 FECC .proc KeyboardIRQ
174 ;reset software repeat timer
175 .if _KERNEL_XLXE
176 mva krpdel srtimr
177 .else
178 FECC A9 30 8D 2B 02 mva #$30 srtimr
179 .endif
180
181 ;read new key
182 FED1 AD 09 D2 lda kbcode
183
184 .if _KERNEL_XLXE
185 ;check for HELP
186 and #$3f
187 cmp #$11
188 bne not_help
189 sta helpfg
190 beq xit2
191
192 not_help:
193 lda kbcode
194 .endif
195
196 ;check if it is the same as the prev key
197 FED4 CD F2 02 cmp ch1
198 FED7 D0 08 bne debounced
199
200 ;reject key if debounce timer is still running
201 FED9 AD F1 02 lda keydel
202 FEDC D0 16 bne xit
203 FEDE AD F2 02 lda ch1
204 FEE1 debounced:
205
206 ;check for Ctrl+1 to toggle display activity
207 FEE1 C9 9F cmp #$9f
208 FEE3 F0 11 beq is_suspend
209
210 ;store key
211 FEE5 8D FC 02 sta ch
212 FEE8 8D F2 02 sta ch1
213
214 ;reset attract
215 FEEB A9 00 85 4D mva #0 atract
216
217 FEEF xit2:
218 ;reset key delay
219 FEEF A9 03 8D F1 02 mva #3 keydel
220
221 FEF4 xit:
222 ;all done
223 FEF4 68 pla
224 FEF5 40 rti
225
226 FEF6 is_suspend:
227 ;toggle stop/start flag
228 FEF6 AD FF 02 lda ssflag
229 FEF9 49 FF eor #$ff
230 FEFB 8D FF 02 sta ssflag
231 FEFE B0 EF bcs xit2 ;!! carry set from cmp #$9f!
232 .endp
233
234 ;==============================================================================
235 FF00 .proc KeyboardBreakIRQ
236 FF00 A9 00 85 11 mva #0 brkkey
237
238 ;need to clear the suspend flag as BREAK automatically nukes a pending Ctrl+1
239 FF04 8D FF 02 sta ssflag
240
241 ;interestingly, the default break handler forces the cursor back on.
242 FF07 8D F0 02 sta crsinh
243
244 FF0A 68 pla
245 FF0B 40 rti
246 .endp
284 .endif
285
286 FF0C icl 'keytable.s'
Source: source/Shared/keytable.s
1 ; Altirra - Atari 800/800XL/5200 emulator
2 ; Modular Kernel ROM - Keyboard Scan Code Table
3 ; Copyright (C) 2008-2016 Avery Lee
4 ;
5 ; Copying and distribution of this file, with or without modification,
6 ; are permitted in any medium without royalty provided the copyright
7 ; notice and this notice are preserved. This file is offered as-is,
8 ; without any warranty.
9
10 FF0C KeyCodeToATASCIITable:
11 ;Special codes in this table (values important for compat):
12 ; $80 - invalid key
13 ; $81 - inverse video
14 ; $82 - caps lock
15 ; $83 - shift caps lock
16 ; $84 - control caps lock
17
18 ;lowercase
19 FF0C 6C 6A 3B 80 80 6B + dta $6C, $6A, $3B, $80, $80, $6B, $2B, $2A
20 FF14 6F 80 70 75 9B 69 + dta $6F, $80, $70, $75, $9B, $69, $2D, $3D
21 FF1C 76 80 63 80 80 62 + dta $76, $80, $63, $80, $80, $62, $78, $7A
22 FF24 34 80 33 36 1B 35 + dta $34, $80, $33, $36, $1B, $35, $32, $31
23 FF2C 2C 20 2E 6E 80 6D + dta $2C, $20, $2E, $6E, $80, $6D, $2F, $81
24 FF34 72 80 65 79 7F 74 + dta $72, $80, $65, $79, $7F, $74, $77, $71
25 FF3C 39 80 30 37 7E 38 + dta $39, $80, $30, $37, $7E, $38, $3C, $3E
26 FF44 66 68 64 80 82 67 + dta $66, $68, $64, $80, $82, $67, $73, $61
27
28 ;SHIFT
29 FF4C 4C 4A 3A 80 80 4B + dta $4C, $4A, $3A, $80, $80, $4B, $5C, $5E
30 FF54 4F 80 50 55 9B 49 + dta $4F, $80, $50, $55, $9B, $49, $5F, $7C
31 FF5C 56 80 43 80 80 42 + dta $56, $80, $43, $80, $80, $42, $58, $5A
32 FF64 24 80 23 26 1B 25 + dta $24, $80, $23, $26, $1B, $25, $22, $21
33 FF6C 5B 20 5D 4E 80 4D + dta $5B, $20, $5D, $4E, $80, $4D, $3F, $80
34 FF74 52 80 45 59 9F 54 + dta $52, $80, $45, $59, $9F, $54, $57, $51
35 FF7C 28 80 29 27 9C 40 + dta $28, $80, $29, $27, $9C, $40, $7D, $9D
36 FF84 46 48 44 80 83 47 + dta $46, $48, $44, $80, $83, $47, $53, $41
37
38 ;CTRL
39 FF8C 0C 0A 7B 80 80 0B + dta $0C, $0A, $7B, $80, $80, $0B, $1E, $1F
40 FF94 0F 80 10 15 9B 09 + dta $0F, $80, $10, $15, $9B, $09, $1C, $1D
41 FF9C 16 80 03 80 80 02 + dta $16, $80, $03, $80, $80, $02, $18, $1A
42 FFA4 80 80 9B 80 1B 80 + dta $80, $80, $9B, $80, $1B, $80, $FD, $80
43 FFAC 00 20 60 0E 80 0D + dta $00, $20, $60, $0E, $80, $0D, $80, $80
44 FFB4 12 80 05 19 9E 14 + dta $12, $80, $05, $19, $9E, $14, $17, $11
45 FFBC 80 80 80 80 FE 80 + dta $80, $80, $80, $80, $FE, $80, $7D, $FF
46 FFC4 06 08 04 80 84 07 + dta $06, $08, $04, $80, $84, $07, $13, $01
287 FFCC _KERNEL_REPORT_MODULE_SIZE 'Keyboard routines', 0
Macro: _KERNEL_REPORT_MODULE_SIZE [Source: source/main.xasm]
1 .echo ' ', *, ' -> ', *-?@_kernel_lastpt, '(', 0, ')', ' ', 'Keyboard routines'
1 $FFCC -> $0181($0000) Keyboard routines
3 = FFCC .def ?@_kernel_lastpt = *
Source: source/main.xasm
288
289 .if _KERNEL_XLXE
290 .echo 'Free space: ', $FFEE-*, ' bytes'
291 .else
292 .echo 'Free space: ', $FFFA-*, ' bytes'
292 Free space: $002E bytes
293 .endif
294
295 ;==============================================================================
296 ; version block (XL/XE)
297 ;==============================================================================
298
299 .ifdef _KERNEL_816
300 org $ffe4
301 dta a(IntDispatchNativeCop) ;$FFE4
302 dta a(IntDispatchNativeBreak) ;$FFE6
303 dta a(IntDispatchNativeAbort) ;$FFE8
304 dta a(IntDispatchNativeNmi) ;$FFEA
305 dta a(0) ;$FFEC
306 dta a(IntDispatchNativeIrq) ;$FFEE
307 dta $13 ;$FFF0
308 dta $02 ;$FFF1 option byte - !!CHECKED BY ARCHON
309 dta 'CX' ;$FFF2
310 dta a(IntDispatchCop) ;$FFF4
311 dta a(0) ;$FFF6
312 dta a(IntDispatchAbort) ;$FFF8
313 .elif _KERNEL_XLXE
314 org $ffee
315 dta $01,$01,$13
316 dta $02 ;option byte - !!CHECKED BY ARCHON
317 dta 'CX',$00,$00,$00
318 dta $00
319 dta a(0)
320 .endif
321
322 ;==============================================================================
323 ; reset vectors
324 ;==============================================================================
325 FFCC org $fffa
326 FFFA 85 E8 dta a(IntDispatchNMI)
327 FFFC F8 EF dta a(InitReset)
328 FFFE A2 E8 dta a(IntDispatchIRQ)
329
330 end
Reference in New Issue View Git Blame Copy Permalink