1; Common routines and runtime
2
3; Detect inclusion loops (otherwise ca65 goes crazy)
4.ifdef SHELL_INCLUDED
5	.error "shell.s included twice"
6	.end
7.endif
8SHELL_INCLUDED = 1
9
10; Temporary variables that ANY routine might modify, so
11; only use them between routine calls.
12temp   = <$A
13temp2  = <$B
14temp3  = <$C
15addr   = <$E
16ptr = addr
17
18; Move code to $E200 ($200 bytes for text output in devcarts
19; where WRAM is mirrored to $E000)
20.segment "CODE"
21	.res $2200
22
23; Put shell code after user code, so user code is in more
24; consistent environment
25.segment "CODE2"
26
27	; Any user code which runs off end might end up here,
28	; so catch that mistake.
29	nop ; in case there was three-byte opcode before this
30	nop
31	jmp internal_error
32
33;**** Common routines ****
34
35.include "macros.inc"
36.include "neshw.inc"
37.include "delay.s"
38.include "print.s"
39.include "crc.s"
40.include "testing.s"
41
42.ifdef NEED_CONSOLE
43	.include "console.s"
44.else
45	; Stubs so code doesn't have to care whether
46	; console exists
47	console_init:
48	console_show:
49	console_hide:
50	console_print:
51	console_flush:
52		rts
53.endif
54
55.ifndef CUSTOM_PRINT
56	.include "text_out.s"
57
58	print_char_:
59		jsr write_text_out
60		jmp console_print
61
62	stop_capture:
63		rts
64.endif
65
66;**** Shell core ****
67
68.ifndef CUSTOM_RESET
69	reset:
70		sei
71		jmp std_reset
72.endif
73
74
75; Sets up hardware then runs main
76run_shell:
77	sei
78	cld     ; unnecessary on NES, but might help on clone
79	ldx #$FF
80	txs
81	jsr init_shell
82	set_test $FF
83	jmp run_main
84
85
86; Initializes shell
87init_shell:
88	jsr clear_ram
89	jsr init_wait_vbl     ; waits for VBL once here,
90	jsr wait_vbl_optional ; so only need to wait once more
91	jsr init_text_out
92	jsr init_testing
93	jsr init_runtime
94	jsr console_init
95	rts
96
97
98; Runs main in consistent PPU/APU environment, then exits
99; with code 0
100run_main:
101	jsr pre_main
102	jsr main
103	lda #0
104	jmp exit
105
106
107; Sets up environment for main to run in
108pre_main:
109
110.ifndef BUILD_NSF
111	jsr disable_rendering
112	setb PPUCTRL,0
113	jsr clear_palette
114	jsr clear_nametable
115	jsr clear_nametable2
116	jsr clear_oam
117.endif
118
119	lda #$34
120	pha
121	lda #0
122	tax
123	tay
124	jsr wait_vbl_optional
125	plp
126	sta SNDMODE
127	rts
128
129
130.ifndef CUSTOM_EXIT
131	exit:
132.endif
133
134; Reports result and ends program
135std_exit:
136	sei
137	cld
138	ldx #$FF
139	txs
140
141	ldx #0
142	stx SNDCHN
143	.ifndef BUILD_NSF
144		stx PPUCTRL
145	.endif
146
147	jsr report_result
148	jmp post_exit
149
150
151; Reports final result code in A
152report_result:
153	jsr :+
154	jmp play_byte
155
156:   jsr print_newline
157	jsr console_show
158
159	; 0: ""
160	cmp #1
161	bge :+
162	rts
163:
164	; 1: "Failed"
165	bne :+
166	print_str {"Failed",newline}
167	rts
168
169	; n: "Failed #n"
170:   print_str "Failed #"
171	jsr print_dec
172	jsr print_newline
173	rts
174
175;**** Other routines ****
176
177; Reports internal error and exits program
178internal_error:
179	print_str newline,"Internal error"
180	lda #255
181	jmp exit
182
183
184.import __NVRAM_LOAD__, __NVRAM_SIZE__
185
186.macro fill_ram_ Begin, End
187	.local Neg_size
188	Neg_size = (Begin) - (End)
189	ldxy #(Begin) - <Neg_size
190	sty addr
191	stx addr+1
192	ldxy #Neg_size
193:   sta (addr),y
194	iny
195	bne :-
196	inc addr+1
197	inx
198	bne :-
199.endmacro
200
201; Clears 0 through ($100+S), $200 through __NVRAM_LOAD__-1, and
202; __NVRAM_LOAD__+__NVRAM_SIZE__ through $7FF
203clear_ram:
204	lda #0
205
206	bss_begin = $200
207
208	fill_ram_ bss_begin,__NVRAM_LOAD__
209	fill_ram_ __NVRAM_LOAD__+__NVRAM_SIZE__,$800
210
211	; Zero-page
212	tax
213:   sta 0,x
214	inx
215	bne :-
216
217	; Stack below S
218	tsx
219	inx
220:   dex
221	sta $100,x
222	bne :-
223
224	rts
225
226
227nv_res unused_nv_var ; to avoid size=0
228
229; Clears nvram
230clear_nvram:
231	lda #0
232	fill_ram_ __NVRAM_LOAD__,__NVRAM_LOAD__+__NVRAM_SIZE__
233	rts
234
235
236; Prints filename and newline, if available, otherwise nothing.
237; Preserved: A, X, Y
238print_filename:
239	.ifdef FILENAME_KNOWN
240		pha
241		jsr print_newline
242		setw addr,filename
243		jsr print_str_addr
244		jsr print_newline
245		pla
246	.endif
247	rts
248
249.pushseg
250.segment "RODATA"
251	; Filename terminated with zero byte.
252	filename:
253		.ifdef FILENAME_KNOWN
254			.incbin "ram:nes_temp"
255		.endif
256		.byte 0
257.popseg
258
259
260;**** ROM-specific ****
261.ifndef BUILD_NSF
262
263.include "ppu.s"
264
265avoid_silent_nsf:
266play_byte:
267	rts
268
269; Loads ASCII font into CHR RAM
270.macro load_ascii_chr
271	bit PPUSTATUS
272	setb PPUADDR,$00
273	setb PPUADDR,$00
274	setb addr,<ascii_chr
275	ldx #>ascii_chr
276	ldy #0
277@page:
278	stx addr+1
279:   lda (addr),y
280	sta PPUDATA
281	iny
282	bne :-
283	inx
284	cpx #>ascii_chr_end
285	bne @page
286.endmacro
287
288; Disables interrupts and loops forever
289.ifndef CUSTOM_FOREVER
290forever:
291	sei
292	lda #0
293	sta PPUCTRL
294:   beq :-
295	.res $10,$EA    ; room for code to run loader
296.endif
297
298
299; Default NMI
300.ifndef CUSTOM_NMI
301	zp_byte nmi_count
302
303	nmi:
304		inc nmi_count
305		rti
306
307	; Waits for NMI. Must be using NMI handler that increments
308	; nmi_count, with NMI enabled.
309	; Preserved: X, Y
310	wait_nmi:
311		lda nmi_count
312	:   cmp nmi_count
313		beq :-
314		rts
315.endif
316
317
318; Default IRQ
319.ifndef CUSTOM_IRQ
320	irq:
321		bit SNDCHN  ; clear APU IRQ flag
322		rti
323.endif
324
325.endif
326
327
328; Reports A in binary as high and low tones, with
329; leading low tone for reference. Omits leading
330; zeroes. Doesn't hang if no APU is present.
331; Preserved: A, X, Y
332play_hex:
333	pha
334
335	; Make low reference beep
336	clc
337	jsr @beep
338
339	; Remove high zero bits
340	sec
341:   rol a
342	bcc :-
343
344	; Play remaining bits
345	beq @zero
346:   jsr @beep
347	asl a
348	bne :-
349@zero:
350
351	delay_msec 300
352	pla
353	rts
354
355; Plays low/high beep based on carry
356; Preserved: A, X, Y
357@beep:
358	pha
359
360	; Set up square
361	lda #1
362	sta SNDCHN
363	sta $4001
364	sta $4003
365	adc #$FE    ; period=$100 if carry, $1FF if none
366	sta $4002
367
368	; Fade volume
369	lda #$0F
370:   ora #$30
371	sta $4000
372	delay_msec 8
373	sec
374	sbc #$31
375	bpl :-
376
377	; Silence
378	sta SNDCHN
379	delay_msec 160
380
381	pla
382	rts
383