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;**** Special globals ****
11
12; Temporary variables that ANY routine might modify, so
13; only use them between routine calls.
14temp   = <$A
15temp2  = <$B
16temp3  = <$C
17addr   = <$E
18ptr = addr
19
20.segment "NVRAM"
21	; Beginning of variables not cleared at startup
22	nvram_begin:
23
24;****  Code segment setup ****
25
26.segment "RODATA"
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; Move code to $E200 ($200 bytes for text output)
34.segment "DMC"
35	.res $2200
36
37; Devcart corrupts byte at $E000 when powering off
38.segment "CODE"
39	nop
40
41;**** Common routines ****
42
43.include "macros.inc"
44.include "neshw.inc"
45.include "print.s"
46.include "delay.s"
47.include "crc.s"
48.include "testing.s"
49
50.ifdef NEED_CONSOLE
51	.include "console.s"
52.else
53	; Stubs so code doesn't have to care whether
54	; console exists
55	console_init:
56	console_show:
57	console_hide:
58	console_print:
59	console_flush:
60		rts
61.endif
62
63.ifndef CUSTOM_PRINT
64	.include "text_out.s"
65
66	print_char_:
67		jsr write_text_out
68		jmp console_print
69
70	stop_capture:
71		rts
72
73.endif
74
75;**** Shell core ****
76
77.ifndef CUSTOM_RESET
78	reset:
79		sei
80		jmp std_reset
81.endif
82
83
84; Sets up hardware then runs main
85run_shell:
86	sei
87	cld     ; unnecessary on NES, but might help on clone
88	ldx #$FF
89	txs
90	jsr init_shell
91	set_test $FF
92	jmp run_main
93
94
95; Initializes shell
96init_shell:
97	jsr clear_ram
98	jsr init_wait_vbl     ; waits for VBL once here,
99	jsr wait_vbl_optional ; so only need to wait once more
100	jsr init_text_out
101	jsr init_testing
102	jsr init_runtime
103	jsr console_init
104	rts
105
106
107; Runs main in consistent PPU/APU environment, then exits
108; with code 0
109run_main:
110	jsr pre_main
111	jsr main
112	lda #0
113	jmp exit
114
115
116; Sets up environment for main to run in
117pre_main:
118
119.ifndef BUILD_NSF
120	jsr disable_rendering
121	setb PPUCTRL,0
122	jsr clear_palette
123	jsr clear_nametable
124	jsr clear_nametable2
125	jsr clear_oam
126.endif
127
128	lda #$34
129	pha
130	lda #0
131	tax
132	tay
133	jsr wait_vbl_optional
134	plp
135	sta SNDMODE
136	rts
137
138
139.ifndef CUSTOM_EXIT
140	exit:
141.endif
142
143; Reports result and ends program
144std_exit:
145	sei
146	cld
147	ldx #$FF
148	txs
149	pha
150
151	setb SNDCHN,0
152	.ifndef BUILD_NSF
153		setb PPUCTRL,0
154	.endif
155
156	pla
157	pha
158	jsr report_result
159	;jsr clear_nvram ; TODO: was this needed for anything?
160	pla
161	jmp post_exit
162
163
164; Reports final result code in A
165report_result:
166	jsr :+
167	jmp play_byte
168
169:   jsr print_newline
170	jsr console_show
171
172	; 0: ""
173	cmp #1
174	bge :+
175	rts
176:
177	; 1: "Failed"
178	bne :+
179	print_str {"Failed",newline}
180	rts
181
182	; n: "Failed #n"
183:   print_str "Failed #"
184	jsr print_dec
185	jsr print_newline
186	rts
187
188;**** Other routines ****
189
190; Reports internal error and exits program
191internal_error:
192	print_str newline,"Internal error"
193	lda #255
194	jmp exit
195
196
197.import __NVRAM_LOAD__, __NVRAM_SIZE__
198
199; Clears $0-($100+S) and nv_ram_end-$7FF
200clear_ram:
201	lda #0
202
203	; Main pages
204	tax
205:   sta 0,x
206	sta $300,x
207	sta $400,x
208	sta $500,x
209	sta $600,x
210	sta $700,x
211	inx
212	bne :-
213
214	; Stack except that above stack pointer
215	tsx
216	inx
217:   dex
218	sta $100,x
219	bne :-
220
221	; BSS except nvram
222	ldx #<__NVRAM_SIZE__
223:   sta __NVRAM_LOAD__,x
224	inx
225	bne :-
226
227	rts
228
229
230; Clears nvram
231clear_nvram:
232	ldx #<__NVRAM_SIZE__
233	beq @empty
234	lda #0
235:   dex
236	sta __NVRAM_LOAD__,x
237	bne :-
238@empty:
239	rts
240
241
242; Prints filename and newline, if available, otherwise nothing.
243; Preserved: A, X, Y
244print_filename:
245	.ifdef FILENAME_KNOWN
246		pha
247		jsr print_newline
248		setw addr,filename
249		jsr print_str_addr
250		jsr print_newline
251		pla
252	.endif
253	rts
254
255.pushseg
256.segment "RODATA"
257	; Filename terminated with zero byte.
258	filename:
259		.ifdef FILENAME_KNOWN
260			.incbin "ram:nes_temp"
261		.endif
262		.byte 0
263.popseg
264
265
266;**** ROM-specific ****
267.ifndef BUILD_NSF
268
269.include "ppu.s"
270
271avoid_silent_nsf:
272play_byte:
273	rts
274
275; Loads ASCII font into CHR RAM
276.macro load_ascii_chr
277	bit PPUSTATUS
278	setb PPUADDR,$00
279	setb PPUADDR,$00
280	setb addr,<ascii_chr
281	ldx #>ascii_chr
282	ldy #0
283@page:
284	stx addr+1
285:   lda (addr),y
286	sta PPUDATA
287	iny
288	bne :-
289	inx
290	cpx #>ascii_chr_end
291	bne @page
292.endmacro
293
294; Disables interrupts and loops forever
295.ifndef CUSTOM_FOREVER
296forever:
297	sei
298	lda #0
299	sta PPUCTRL
300:   beq :-
301	.res $10,$EA    ; room for code to run loader
302.endif
303
304
305; Default NMI
306.ifndef CUSTOM_NMI
307	zp_byte nmi_count
308
309	nmi:
310		inc nmi_count
311		rti
312
313	; Waits for NMI. Must be using NMI handler that increments
314	; nmi_count, with NMI enabled.
315	; Preserved: X, Y
316	wait_nmi:
317		lda nmi_count
318	:   cmp nmi_count
319		beq :-
320		rts
321.endif
322
323
324; Default IRQ
325.ifndef CUSTOM_IRQ
326	irq:
327		bit SNDCHN  ; clear APU IRQ flag
328		rti
329.endif
330
331.endif
332