git @ Cat's Eye Technologies SixtyPical / f92056d
REBOOT the entire language & implementation as version 0.2-PRE. Chris Pressey 6 years ago
41 changed file(s) with 1907 addition(s) and 4253 deletion(s). Raw diff Collapse all Expand all
00 *.o
11 *.hi
2 bin/*
2 *.pyc
11
22 *.o
33 *.hi
4 bin/*
4 *.pyc
11 ==========
22
33 SixtyPical is a very low-level programming language, similar to 6502 assembly,
4 with static analysis through type-checking and abstract interpretation.
4 with static analysis through abstract interpretation.
5
6 In practice, this means it catches things like
7
8 * you forgot to clear carry before adding something to the accumulator
9 * a subroutine that you call trashes a register you thought was preserved
10
11 and suchlike.
512
613 It is a **work in progress**, currently at the **proof-of-concept** stage.
714
8 It is expected that a common use case for SixtyPical would be retroprogramming
9 for the Commodore 64 and other 6502-based computers such as the VIC-20, the
10 Apple ][+, and the NES.
15 The current version is 0.2-PRE. It is a complete reboot of SixtyPical 0.1.
16 The reference implementation is written in Python instead of Haskell.
17 The language is much simpler — we're going to try to get the analysis
18 completely right before adding more sophisticated and useful features.
1119
12 Many SixtyPical instructions map precisely to 6502 opcodes. However, SixtyPical
13 is not an assembly language: the programmer does not have total control over
14 the layout of code and data in memory. Some 6502 opcodes have no SixtyPical
15 equivalent, while some have an equivalent that acts in a slightly different
16 (but intuitively related) way. And some commands are unique to SixtyPical.
20 Documentation:
1721
18 `sixtypical` is the reference implementation of SixtyPical. It is written in
19 Haskell. It can currently parse and check a SixtyPical program, and can
20 emit an Ophis assembler listing for it.
21
22 SixtyPical itself is distributed under a BSD-style open-source license, while
23 the example SixtyPical programs in the `eg` directory are in the public domain.
24 See the file `LICENSE` for more information.
25
26 Quick Start
27 -----------
28
29 If you have `ghc`, Ophis, and VICE 2.4 installed, clone this repo, `cd` into it,
30 and run
31
32 ./loadngo.sh eg/game.60p
33
34 The Big Idea(s)
35 ---------------
36
37 ### Typed Addresses ###
38
39 SixtyPical distinguishes several kinds of addresses: those that hold a byte,
40 those that hold a word (in low-byte-high-byte sequence), those that are the
41 beginning of a table of bytes, and vectors (those that hold a word pointer to a
42 machine-language routine.) It prevents the program from accessing them in
43 certain ways. For example, these are illegal:
44
45 reserve byte lives
46 reserve word score
47 routine do_it {
48 lda score // no! can't treat word as if it were a byte
49 lda lives, x // no! can't treat a byte as if it were a table
50 }
51
52 ### Abstract Interpretation ###
53
54 SixtyPical tries to prevent the program from using data that has no meaning.
55
56 The instructions of a routine are analyzed using abstract interpretation.
57 One thing we specifically do is determine which registers and memory locations
58 are *not* affected by the routine. For example, the following:
59
60 routine do_it {
61 lda #0
62 jsr update_score
63 sta vic_border_colour // uh... what do we know about reg A here?
64 }
65
66 ...is illegal *unless* one of the following is true:
67
68 * the A register is declared to be a meaningful output of `update_score`
69 * `update_score` was analyzed and determined to not change the value of the
70 A register
71
72 The first case must be done with an explicit declaration on `update_score`.
73 The second case will be be inferred using abstract interpretation of the code
74 of `update_score`.
75
76 ### Structured Programming ###
77
78 SixtyPical eschews labels for code and instead organizes code into _blocks_.
79
80 Instead of the assembly-language subroutine, SixtyPical provides the _routine_
81 as the abstraction for a reusable sequence of code. A routine may be called,
82 or may be included inline, by another routine. The body of a routine is a
83 block.
84
85 Along with routines, you get `if`, `repeat`, and `with` constructs which take
86 blocks. The `with` construct takes an instruction like `sei` and implicitly
87 (and unavoidably) inserts the corresponding `cli` at the end of the block.
88
89 Abstract interpretation extends to `if` blocks. The two incoming contexts are
90 merged, and any storage locations poisoned in either context are considered
91 poisoned in the result context. (A similar case applies to `repeat` and
92 `with`, but these are different too as there is only one block and it is always
93 executed at least once.)
94
95 Declarations can have block scope. Such declarations may only be used within
96 the block in which they are declared. `reserve`d storage inside a block is not,
97 however, like a local variable (or `auto` in C); rather, it is more like a
98 `static` in C, except the value at that address is not guaranteed to be
99 retained between invokations of the block. This is intended to be used for
100 temporary storage. In addition, if analysis of the call graph indicates that
101 two such temporary addresses are never used simultaneously, they may be merged
102 to the same address. (This is, however, not yet implemented, and may not be
103 implemented for a while.)
104
105 ### Pseudo-Instructions ###
106
107 Along with instructions which map to the 6502 instruction set, SixtyPical
108 supplies some instructions which are slightly more abstract and powerful.
109 For lack of a better term, I'm calling them "pseudo-instructions" here.
110 (But I would really like a better term.)
111
112 In a macro assembler, these pseudo-instructions would be implemented with
113 macros. However, macros, being textual-substitution-based, are a pain to
114 analyze. By providing the functions as built-in instructions, we can
115 easily work them into the type system. Also, there are some macros that are
116 so common and useful that it makes sense for them to be built-ins, with
117 standardized, prescriptive names.
118
119 Such pseudo-instructions are:
120
121 * `copy`, which copies a value from one storage location to another.
122 This is a typesafe way to copy 16-bit `word`s and `vector`s.
123 In the future, it may handle 8-bit values and immediate values too.
124 * `save`, which is not yet implemented. Intended to be used in `with`
125 blocks when you want to save a value but you don't want to use the
126 stack. Pairs well with block-level temporary `reserve`d addresses.
127
128 ### "It's a Partial Solution" ###
129
130 SixtyPical does not attempt to force your typed, abstractly interpreted
131 program to be absolutely watertight. In assembly language on an 8-bit
132 microprocessor, you will sometimes _need_ to do dangerous and tricky things,
133 like self-modifying code and cycle-counting, in order to accomplish a
134 sophisticated effect, like a raster interrupt trick.
135
136 For that reason, `sixtypical` does not attempt to emit a fully-formed
137 Ophis assembler source. Instead, it expects you to mix its output with
138 some raw Ophis assembler to make a complete program. This "mixin" may contain
139 as much unchecked assembler code as you like. An example is provided in the
140 `lib` directory which adds a prelude that makes the resulting program
141 runnable from Commodore BASIC 2.0 and stores uninitialized data at `$C000`.
142
143 In addition, various checks are not attempted (such as tracking the usage
144 of an indirect indexed table) and other checks may be subverted (for example
145 by `assign`ing two variables with two different types of storage at the same
146 address.)
147
148 In summary, SixtyPical helps you write a very-nearly-assembly-level program
149 which is a bit more "solid" than raw assembly, but it still expects you to
150 know what you're doing down there.
151
152 For More Information
153 --------------------
154
155 For more information, see the docs (which are written in the form of
156 [Falderal](http://catseye.tc/node/Falderal) literate test suites. If you
157 have `falderal` on your executable search path, you can run the tests with
158 `./test.sh`.)
159
160 * [Checking](https://github.com/catseye/SixtyPical/blob/master/doc/Checking.markdown)
161 * [Analyzing](https://github.com/catseye/SixtyPical/blob/master/doc/Analyzing.markdown)
162 * [Emitting](https://github.com/catseye/SixtyPical/blob/master/doc/Emitting.markdown)
163 * [Instruction Support](https://github.com/catseye/SixtyPical/blob/master/doc/Instruction_Support.markdown)
164
165 Internals
166 ---------
167
168 Some (OK, a lot) of the Haskell code is kind of gross and non-idiomatic.
169 The parser, in particular, could not be described as "elegant". There
170 could definitely be more higher-order functions defined and used. At the
171 same time, I'm really not a fan of pointless style — I prefer it when things
172 are written out explicitly and pedantically. Still, there are places where
173 an added `foldr` or two would not be unwelcome...
174
175 The 6502 semantics, which are arguably RISC-like (load/store architecture)
176 are translated into an intermediate representation which is arguably CISC-like.
177 For example, `lda`, `sta`, `ldx`, and `tax` all become kinds of `COPY`
178 internally. This internal instruction set is much smaller than the 6502's,
179 and thus is usually easier to analyze. It would also be easier to adapt to
180 other instruction sets, such as the Z80 or the 8086.
181
182 Notes
183 -----
184
185 This is not quite the right place for this, but I need to write it down
186 somewhere:
187
188 6502 machine code supports an indirect `jmp`, but not an indirect `jsr`.
189 But an indirect `jsr` is very easy to simulate with an indirect `jmp`.
190 Instead of
191
192 launch:
193 copy whatever to vector
194 jsr (vector)
195 ...
196
197 Just say
198
199 launch:
200 copy whatever to vector
201 jsr indirect_jsr
202 ...
203
204 indirect_jsr:
205 jmp (vector)
206
207 Then the `rts` at the end of your routine pointed to by `vector` will
208 return you to where you `jsr`ed.
209
210 Because the above is so easy to write, SixtyPical will probably not support
211 a `jsr (vector)` form (unless it would somehow make analysis easier, but
212 it probably won't.)
213
214 TODO
215 ----
216
217 * Addressing modes — indexed mode on more instructions
218 * Rename and lift temporaries in nested blocks
219 * Tail-recursion optimization
220 * `word 100` to promote an otherwise 8-bit literal to a 16-bit value
221 * `jmp routine`
222 * Enforce that `jmp`s come at ends of blocks(?)
223 * `outputs` on externals
224 * Routine is a kind of StorageLocation? (Location)?
225 * Test that `pha` restores the A register
226 * Test poisonining of flags
227 * Test output of flags
22 * [doc/SixtyPical.md](SixtyPical.md) — the spec
23 * [tests/SixtyPical Execution.md](SixtyPical Execution.md) —
24 literate test suite for running SixtyPical programs
25 * [tests/SixtyPical Analysis.md](SixtyPical Analysis.md) —
26 literate test suite for statically analyzing SixtyPical programs
0 #!/usr/bin/env python
1
2 """Usage: sixtypical [OPTIONS] FILES
3
4 Analyzes and/or executes and/or compiles a Sixtypical program.
5 """
6
7 from os.path import realpath, dirname, join
8 import sys
9
10 sys.path.insert(0, join(dirname(realpath(sys.argv[0])), '..', 'src'))
11
12 # ----------------------------------------------------------------- #
13
14 import codecs
15 from optparse import OptionParser
16 import sys
17 import traceback
18
19 from sixtypical.parser import Parser
20 from sixtypical.evaluator import eval_program
21 from sixtypical.analyzer import analyze_program
22
23
24 if __name__ == '__main__':
25 optparser = OptionParser(__doc__.strip())
26
27 optparser.add_option("--analyze",
28 action="store_true", dest="analyze", default=False,
29 help="")
30 optparser.add_option("--compile",
31 action="store_true", dest="compile", default=False,
32 help="")
33 optparser.add_option("--traceback",
34 action="store_true", dest="traceback", default=False,
35 help="")
36 optparser.add_option("--execute",
37 action="store_true", dest="execute", default=False,
38 help="")
39
40 (options, args) = optparser.parse_args(sys.argv[1:])
41
42 for filename in args:
43 text = open(filename).read()
44 p = Parser(text)
45 program = p.program()
46
47 if options.analyze:
48 try:
49 analyze_program(program)
50 except Exception as e:
51 if options.traceback:
52 raise
53 else:
54 traceback.print_exception(e.__class__, e, None)
55 sys.exit(1)
56 print 'ok'
57
58 if options.execute:
59 context = eval_program(program)
60 for key, value in sorted(context.iteritems()):
61 print "%s: %s" % (key, value)
+0
-23
build.sh less more
0 #!/bin/sh
1
2 PROG=sixtypical
3
4 if [ x`which ghc` = x -a x`which runhugs` = x ]; then
5 echo "Neither ghc nor runhugs found on search path."
6 exit 1
7 fi
8
9 mkdir -p bin
10
11 if [ x`which ghc` = x -o ! x$USE_HUGS = x ]; then
12 # create script to run with Hugs
13 cat >bin/$PROG <<'EOF'
14 #!/bin/sh
15 THIS=`realpath $0`
16 DIR=`dirname $THIS`/../src
17 runhugs $DIR/Main.hs $*
18 EOF
19 chmod 755 bin/$PROG
20 else
21 cd src && ghc --make Main.hs -o ../bin/$PROG
22 fi
+0
-3
clean.sh less more
0 #!/bin/sh
1
2 rm -f src/*.hi src/*.o src/*/*.hi src/*/*.o
+0
-372
doc/Analyzing.markdown less more
0 Analyzing SixtyPical Programs
1 =============================
2
3 -> Tests for functionality "Analyze SixtyPical program"
4
5 -> Functionality "Analyze SixtyPical program" is implemented by
6 -> shell command "bin/sixtypical analyze %(test-body-file)"
7
8 Analysis determines what storage locations have been modified by a
9 routine.
10
11 | reserve byte score
12 | routine main {
13 | lda #4
14 | sta score
15 | }
16 = main ([])
17 = A: UpdatedWith (Immediate 4)
18 = NamedLocation Nothing "score": UpdatedWith A
19
20 A routine cannot expect registers which a called routine does not
21 preserve, to be preserved. We say the called routine "poisons" those
22 registers.
23
24 | assign byte border_colour 4000
25 | reserve byte score
26 | routine update_score
27 | {
28 | lda #8
29 | sta score
30 | }
31 | routine main {
32 | lda #4
33 | jsr update_score
34 | sta border_colour
35 | }
36 ? routine 'main' does not preserve 'A'
37
38 But if a called routine does preserve those registers, the caller can
39 continue to use them after calling the routine.
40
41 | assign byte border_colour 4000
42 | reserve byte score
43 | routine update_score
44 | {
45 | ldx score
46 | inx
47 | stx score
48 | }
49 | routine main {
50 | lda #4
51 | jsr update_score
52 | sta border_colour
53 | }
54 = main ([])
55 = A: UpdatedWith (Immediate 4)
56 = X: PoisonedWith (Immediate 1)
57 = NamedLocation Nothing "border_colour": UpdatedWith A
58 = NamedLocation Nothing "score": PoisonedWith X
59 =
60 = update_score ([])
61 = X: UpdatedWith (Immediate 1)
62 = NamedLocation Nothing "score": UpdatedWith X
63
64 Not only registers, but also named variables, can be poisoned by a called
65 routine.
66
67 | reserve byte score
68 | routine update_score
69 | {
70 | lda #8
71 | sta score
72 | }
73 | routine main {
74 | jsr update_score
75 | lda score
76 | }
77 ? routine 'main' does not preserve 'NamedLocation Nothing "score"'
78
79 Of course, the difference between poisoning and intentionally modifying a
80 storage location is a matter of intent. The solution to the above is to
81 explicitly notate `update_score` as an "output" of the routine.
82
83 | assign byte border_colour 4000
84 | reserve byte score
85 | routine update_score outputs (score)
86 | {
87 | lda #8
88 | sta score
89 | }
90 | routine main {
91 | ldx score
92 | jsr update_score
93 | ldx score
94 | }
95 = main ([])
96 = A: PoisonedWith (Immediate 8)
97 = X: UpdatedWith (NamedLocation Nothing "score")
98 = NamedLocation Nothing "score": UpdatedWith A
99 =
100 = update_score ([NamedLocation Nothing "score"])
101 = A: UpdatedWith (Immediate 8)
102 = NamedLocation Nothing "score": UpdatedWith A
103
104 Routines can name registers as outputs.
105
106 | reserve byte score
107 | routine update_score
108 | {
109 | lda #8
110 | }
111 | routine main {
112 | jsr update_score
113 | sta score
114 | }
115 ? routine 'main' does not preserve 'A'
116
117 | reserve byte score
118 | routine update_score outputs (.a)
119 | {
120 | lda #8
121 | }
122 | routine main {
123 | jsr update_score
124 | sta score
125 | }
126 = main ([])
127 = A: UpdatedWith (Immediate 8)
128 = NamedLocation Nothing "score": UpdatedWith A
129 =
130 = update_score ([A])
131 = A: UpdatedWith (Immediate 8)
132
133 If a location is poisoned in either branch of an `if`, it is poisoned
134 after the `if`. Note there are several tests for this.
135
136 | reserve byte score
137 | routine update_score
138 | {
139 | if beq {
140 | lda #8
141 | } else {
142 | ldx #8
143 | }
144 | }
145 | routine main {
146 | lda #4
147 | jsr update_score
148 | sta score
149 | }
150 ? routine 'main' does not preserve 'A'
151
152 | reserve byte score
153 | routine update_score
154 | {
155 | if beq {
156 | ldx #8
157 | } else {
158 | lda #8
159 | }
160 | }
161 | routine main {
162 | lda #4
163 | jsr update_score
164 | sta score
165 | }
166 ? routine 'main' does not preserve 'A'
167
168 | reserve byte score
169 | routine update_score
170 | {
171 | lda #4
172 | sta score
173 | }
174 | routine main {
175 | lda #4
176 | if beq {
177 | jsr update_score
178 | } else {
179 | ldx #3
180 | }
181 | sta score
182 | }
183 ? routine 'main' does not preserve 'A'
184
185 | reserve byte score
186 | routine update_score
187 | {
188 | lda #4
189 | sta score
190 | }
191 | routine main {
192 | lda #4
193 | if beq {
194 | ldx #3
195 | } else {
196 | jsr update_score
197 | }
198 | sta score
199 | }
200 ? routine 'main' does not preserve 'A'
201
202 | reserve byte score
203 | routine update_score
204 | {
205 | ldx #4
206 | stx score
207 | }
208 | routine main {
209 | lda #4
210 | if beq {
211 | jsr update_score
212 | } else {
213 | ldx #4
214 | }
215 | sta score
216 | }
217 = main ([])
218 = A: UpdatedWith (Immediate 4)
219 = X: PoisonedWith (Immediate 4)
220 = NamedLocation Nothing "score": UpdatedWith A
221 =
222 = update_score ([])
223 = X: UpdatedWith (Immediate 4)
224 = NamedLocation Nothing "score": UpdatedWith X
225
226 | assign word position $fb
227 | reserve byte value
228 |
229 | routine reset_position {
230 | lda #$00
231 | sta <position
232 | lda #$04
233 | sta >position
234 | }
235 |
236 | routine main {
237 | inc value
238 | lda value
239 | ldy #0
240 | sta (position), y
241 | if beq {
242 | jsr reset_position
243 | } else {
244 | }
245 | }
246 = main ([])
247 = A: PoisonedWith (Immediate 4)
248 = Y: UpdatedWith (Immediate 0)
249 = IndirectIndexed (NamedLocation Nothing "position") Y: UpdatedWith A
250 = NamedLocation Nothing "position": PoisonedWith A
251 = NamedLocation Nothing "value": UpdatedWith (Immediate 1)
252 =
253 = reset_position ([])
254 = A: UpdatedWith (Immediate 4)
255 = NamedLocation Nothing "position": UpdatedWith A
256
257 | assign word position $fb
258 | reserve byte value
259 |
260 | routine reset_position {
261 | lda #$00
262 | sta <position
263 | lda #$04
264 | sta >position
265 | }
266 |
267 | routine main {
268 | inc value
269 | lda value
270 | ldy #0
271 | sta (position), y
272 | if beq {
273 | jsr reset_position
274 | } else {
275 | }
276 | sta value
277 | }
278 ? routine 'main' does not preserve 'A'
279
280 | assign word position $fb
281 | reserve byte value
282 |
283 | routine reset_position {
284 | lda #$00
285 | sta <position
286 | lda #$04
287 | sta >position
288 | }
289 |
290 | routine main {
291 | inc value
292 | lda value
293 | ldy #0
294 | sta (position), y
295 | jsr reset_position
296 | if beq {
297 | } else {
298 | sta value
299 | }
300 | }
301 ? routine 'main' does not preserve 'A'
302
303 A storage location poisoned in a `repeat` continues to be poisoned
304 after the `repeat`.
305
306 | reserve byte value
307 |
308 | routine blah {
309 | lda #123
310 | }
311 | routine main {
312 | lda #33
313 | ldy #255
314 | repeat bne {
315 | jsr blah
316 | dey
317 | }
318 | sta value
319 | }
320 ? routine 'main' does not preserve 'A'
321
322 Oh, here's a tricky one. The accumulator isn't poisoned on the first run
323 through the `repeat`, but it **is** on the second run through. We handle
324 this simply by abstractly interpreting the `repeat`'s block twice — the
325 second time in the context of having already interpreted it once.
326
327 | reserve byte value
328 |
329 | routine blah {
330 | lda #123
331 | }
332 | routine main {
333 | lda #33
334 | ldy #255
335 | repeat bne {
336 | sta value
337 | jsr blah
338 | dey
339 | }
340 | }
341 ? routine 'main' does not preserve 'A'
342
343 Poisoning a high byte or low byte of a word poisons the whole word.
344
345 | reserve word score
346 | reserve byte temp
347 | routine update_score
348 | {
349 | ldx #4
350 | stx <score
351 | }
352 | routine main {
353 | jsr update_score
354 | lda >score
355 | sta temp
356 | }
357 ? routine 'main' does not preserve 'NamedLocation Nothing "score"'
358
359 | reserve word score
360 | reserve byte temp
361 | routine update_score
362 | {
363 | ldx #4
364 | stx >score
365 | }
366 | routine main {
367 | jsr update_score
368 | lda <score
369 | sta temp
370 | }
371 ? routine 'main' does not preserve 'NamedLocation Nothing "score"'
+0
-450
doc/Checking.markdown less more
0 Checking SixtyPical Programs
1 ============================
2
3 -> Tests for functionality "Parse SixtyPical program"
4
5 -> Functionality "Parse SixtyPical program" is implemented by
6 -> shell command "bin/sixtypical parse %(test-body-file)"
7
8 -> Tests for functionality "Check SixtyPical program"
9
10 -> Functionality "Check SixtyPical program" is implemented by
11 -> shell command "bin/sixtypical check %(test-body-file)"
12
13 Some Basic Syntax
14 -----------------
15
16 `main` must be present.
17
18 | routine main {
19 | nop
20 | }
21 = True
22
23 | routine frog {
24 | nop
25 | }
26 ? missing 'main' routine
27
28 Each instruction need not appear on its own line. (Although you probably
29 still want to write in that style, for consistency with assembly code.)
30
31 | routine main {
32 | nop lda #1 ldx #1 nop
33 | }
34 = True
35
36 Javascript-style block and line comments are both supported.
37 They may appear anywhere whitespace may appear.
38
39 | reserve byte lives /* fnord */
40 | assign byte gdcol 647 // fnord
41 | external blastoff 4 // fnnnnnnnnnnnnnnnnfffffffff
42 |
43 | routine /* hello */ main {
44 | /* this routine does everything you need. */
45 | lda #1 // we assemble the fnord using
46 | ldx #1 // multiple lorem ipsums which
47 | ldy #1
48 | lda #1 /* we
49 | found under the bridge by the old mill yesterday */
50 | ldx #1
51 | }
52 = True
53
54 Addresses
55 ---------
56
57 An address may be declared with `reserve`, which is like `.data` or `.bss`
58 in an assembler. This is an address into the program's data. It is global
59 to all routines.
60
61 | reserve byte lives
62 | routine main {
63 | lda #3
64 | sta lives
65 | }
66 | routine died {
67 | dec lives
68 | }
69 = True
70
71 An address declared with `reserve` may be given an initial value.
72
73 | reserve byte lives : 3
74 | routine main {
75 | sta lives
76 | }
77 | routine died {
78 | dec lives
79 | }
80 = True
81
82 A byte table declared with `reserve` may be given an initial value consisting
83 of a sequence of bytes.
84
85 | reserve byte[4] table : (0 $40 $10 20)
86 | routine main {
87 | ldy #0
88 | lda table, y
89 | }
90 | routine died {
91 | sta table, y
92 | }
93 = True
94
95 A byte table declared with `reserve` may be given an initial value consisting
96 of a sequence of bytes represented as a character string.
97
98 | reserve byte[4] table : "What"
99 | routine main {
100 | ldy #0
101 | lda table, y
102 | }
103 | routine died {
104 | sta table, y
105 | }
106 = True
107
108 When a byte table declared with `reserve` is given an initial value consisting
109 of a sequence of bytes, it must be the same length as the table is declared.
110
111 | reserve byte[4] table : (0 $40 $10 20 60 70 90)
112 | routine main {
113 | ldy #0
114 | lda table, y
115 | }
116 | routine died {
117 | sta table, y
118 | }
119 ? initial table incorrect size
120
121 | reserve byte[4] table : "Hello, world!"
122 | routine main {
123 | ldy #0
124 | lda table, y
125 | }
126 | routine died {
127 | sta table, y
128 | }
129 ? initial table incorrect size
130
131 We can also define word and vector tables. These are each stored as two
132 byte tables, one table of low bytes and one table of high bytes.
133
134 | reserve word[100] words
135 | reserve vector[100] vectors
136 | routine main {
137 | lda #$04
138 | sta <words
139 | // sta <words, y
140 | lda #$00
141 | sta >words
142 | // sta >words, y
143 | // copy routine main to vectors, y
144 | }
145 = True
146
147 An address may be declared with `assign`, which is like `.alias` in an
148 assembler, with the understanding that the value will be treated "like an
149 address." This is generally an address into the operating system or hardware
150 (e.g. kernal routine, I/O port, etc.)
151
152 | assign byte screen $0400
153 | routine main {
154 | lda #0
155 | sta screen
156 | }
157 = True
158
159 The body of a routine may not refer to an address literally. It must use
160 a symbol that was declared previously with `reserve` or `assign`.
161
162 | routine main {
163 | lda #0
164 | sta $0400
165 | }
166 ? unexpected
167
168 | assign byte screen $0400
169 | routine main {
170 | lda #0
171 | sta screen
172 | }
173 = True
174
175 Test for many combinations of `reserve` and `assign`.
176
177 | reserve byte lives
178 | assign byte gdcol 647
179 | reserve word score
180 | assign word memstr 641
181 | reserve vector v
182 | assign vector cinv 788
183 | reserve byte[16] frequencies
184 | assign byte[256] screen 1024
185 | routine main {
186 | nop
187 | }
188 = True
189
190 `reserve` may be block-level.
191
192 | routine main {
193 | reserve byte lives
194 | lda lives
195 | }
196 = True
197
198 Block-level declarations are only visible in the block in which they are
199 declared.
200
201 | routine main {
202 | reserve byte lives
203 | lda #3
204 | sta lives
205 | }
206 | routine died {
207 | dec lives
208 | }
209 ? undeclared location 'lives'
210
211 A block-level `reserve` may not supply an initial value.
212
213 | routine main {
214 | reserve byte lives : 3
215 | lda lives
216 | }
217 ? block-level 'lives' cannot supply initial value
218
219 A program may declare an `external`.
220
221 | external blastoff 49152
222 | routine main {
223 | jsr blastoff
224 | }
225 = True
226
227 All declarations (`reserve`s and `assign`s) must come before any `routines`.
228
229 | routine main {
230 | lda score
231 | }
232 | reserve word score
233 ? expecting "routine"
234
235 All locations used in all routines must be declared first.
236
237 | reserve byte score
238 | routine main {
239 | lda score
240 | cmp screen
241 | }
242 ? undeclared location
243
244 Even in inner blocks.
245
246 | reserve byte score
247 | assign byte screen 1024
248 | routine main {
249 | lda score
250 | cmp screen
251 | if beq {
252 | lda score
253 | } else {
254 | lda fnord
255 | }
256 | }
257 ? undeclared location
258
259 Block-level declarations are visible in inner blocks.
260
261 | routine main {
262 | reserve byte lives
263 | with sei {
264 | if beq {
265 | lda #3
266 | repeat bne {
267 | sta lives
268 | }
269 | } else {
270 | sta lives
271 | }
272 | }
273 | }
274 = True
275
276 A block-level `reserve` may not supply an initial value.
277
278 | routine main {
279 | reserve byte lives : 3
280 | lda lives
281 | }
282 ? block-level 'lives' cannot supply initial value
283
284 All routines jsr'ed to must be defined, or external.
285
286 | routine main {
287 | jsr blastoff
288 | }
289 ? undeclared routine
290
291 No duplicate location names in declarations.
292
293 | reserve word score
294 | assign word score 4000
295 | routine main {
296 | nop
297 | }
298 ? duplicate location name
299
300 No duplicate routine names.
301
302 | routine main {
303 | nop
304 | }
305 | routine main {
306 | txa
307 | }
308 ? duplicate routine name
309
310 No duplicate routine names, including externals.
311
312 | external main 7000
313 | routine main {
314 | nop
315 | }
316 ? duplicate routine name
317
318 We can jump indirectly through a vector.
319
320 | reserve vector blah
321 | routine main {
322 | jmp (blah)
323 | }
324 = True
325
326 We can't jump indirectly through a word.
327
328 | reserve word blah
329 | routine main {
330 | jmp (blah)
331 | }
332 ? jmp to non-vector
333
334 We can't jump indirectly through a byte.
335
336 | assign byte screen 1024
337 | routine main {
338 | jmp (screen)
339 | }
340 ? jmp to non-vector
341
342 We can absolute-indexed a byte table.
343
344 | assign byte[256] screen 1024
345 | routine main {
346 | sta screen, x
347 | }
348 = True
349
350 We cannot absolute-indexed a byte.
351
352 | assign byte screen 1024
353 | routine main {
354 | sta screen, x
355 | }
356 ? indexed access of non-table
357
358 We cannot absolute-indexed a word.
359
360 | assign word screen 1024
361 | routine main {
362 | sta screen, x
363 | }
364 ? indexed access of non-table
365
366 We cannot absolute access a word.
367
368 | assign word screen 1024
369 | routine main {
370 | ldx screen
371 | }
372 ? incompatible types 'Word' and 'Byte'
373
374 No, not even with `ora`.
375
376 | assign word screen 1024
377 | routine main {
378 | ora screen
379 | }
380 ? incompatible types 'Byte' and 'Word'
381
382 Instead, we have to do this.
383
384 | assign word screen 1024
385 | routine main {
386 | lda <screen
387 | lda >screen
388 | }
389 = True
390
391 We cannot absolute access a vector.
392
393 | assign vector screen 1024
394 | routine main {
395 | lda screen
396 | }
397 ? incompatible types 'Vector' and 'Byte'
398
399 ### Addresses ###
400
401 An address knows what kind of data is stored at the address:
402
403 * `byte`: an 8-bit byte. not part of a word. not to be used as an address.
404 (could be an index though.)
405 * `word`: a 16-bit word. not to be used as an address.
406 * `vector`: a 16-bit address of a routine. Only a handful of operations
407 are supported on vectors:
408
409 * copying the contents of one vector to another
410 * copying the address of a routine into a vector
411 * jumping indirectly to a vector (i.e. to the code at the address
412 contained in the vector (and this can only happen at the end of a
413 routine (NYI))
414 * `jsr`'ing indirectly to a vector (which is done with a fun
415 generated trick (NYI))
416
417 * `byte [SIZE]`: a series of `SIZE` `byte`s contiguous in memory starting
418 from the address. This is the only kind of address that can be used in
419 indexed addressing. `SIZE` has a minimum of 1 and a maximum of 256.
420
421 ### Blocks ###
422
423 Each routine is a block. It may be composed of inner blocks, if those
424 inner blocks are attached to certain instructions.
425
426 SixtyPical does not have instructions that map literally to the 6502 branch
427 instructions. Instead, it has an `if` construct, with two blocks (for the
428 "then" and `else` parts), and the branch instructions map to conditions for
429 this construct.
430
431 Similarly, there is a `repeat` construct. The same branch instructions can
432 be used in the condition to this construct. In this case, they branch back
433 to the top of the `repeat` loop.
434
435 The abstract states of the machine at each of the different block exits are
436 merged during analysis. If any register or memory location is treated
437 inconsistently (e.g. updated in one branch of the test, but not the other,)
438 that register cannot subsequently be used without a declaration to the effect
439 that we know what's going on. (This is all a bit fuzzy right now.)
440
441 There is also no `rts` instruction. It is included at the end of a routine,
442 but only when the routine is used as a subroutine. Also, if the routine
443 ends by `jsr`ing another routine, it reserves the right to do a tail-call
444 or even a fallthrough.
445
446 There are also _with_ instructions, which are associated with three opcodes
447 that have natural symmetrical opcodes: `pha`, `php`, and `sei`. These
448 instructions take a block. The natural symmetrical opcode is inserted at
449 the end of the block.
+0
-456
doc/Emitting.markdown less more
0 Emitting Ophis from SixtyPical Programs
1 =======================================
2
3 -> Tests for functionality "Emit ASM for SixtyPical program"
4
5 -> Functionality "Emit ASM for SixtyPical program" is implemented by
6 -> shell command "bin/sixtypical emit %(test-body-file)"
7
8 Emitting an `if`.
9
10 | assign byte screen $0400
11 | routine main {
12 | lda screen
13 | cmp screen
14 | if beq {
15 | tax
16 | } else {
17 | tay
18 | }
19 | sta screen
20 | }
21 = main:
22 = lda screen
23 = cmp screen
24 = BEQ _label_1
25 = tay
26 = jmp _past_1
27 = _label_1:
28 = tax
29 = _past_1:
30 = sta screen
31 = rts
32 =
33 = .data
34 = .alias screen 1024
35
36 Emitting a `repeat`.
37
38 | assign byte screen 1024
39 | reserve byte four : $04
40 | routine main {
41 | ldy four
42 | repeat bne {
43 | inc screen
44 | dey
45 | cpy four
46 | }
47 | sty screen
48 | }
49 = main:
50 = ldy four
51 =
52 = _repeat_1:
53 = inc screen
54 = dey
55 = cpy four
56 = BNE _repeat_1
57 = sty screen
58 = rts
59 =
60 = four: .byte 4
61 = .data
62 = .alias screen 1024
63
64 Nested ifs.
65
66 | routine main {
67 | if beq {
68 | if bcc {
69 | lda #0
70 | } else {
71 | if bvs {
72 | lda #1
73 | } else {
74 | lda #2
75 | }
76 | }
77 | } else {
78 | lda #3
79 | }
80 | }
81 = main:
82 = BEQ _label_3
83 = lda #3
84 = jmp _past_3
85 = _label_3:
86 = BCC _label_2
87 = BVS _label_1
88 = lda #2
89 = jmp _past_1
90 = _label_1:
91 = lda #1
92 = _past_1:
93 = jmp _past_2
94 = _label_2:
95 = lda #0
96 = _past_2:
97 = _past_3:
98 = rts
99
100 Installing an interrupt handler (at the Kernal level, i.e. with CINV)
101
102 | assign byte screen 1024
103 | assign vector cinv 788
104 | reserve vector save_cinv
105 |
106 | routine main {
107 | with sei {
108 | copy cinv save_cinv
109 | copy routine our_cinv to cinv
110 | }
111 | }
112 |
113 | routine our_cinv {
114 | inc screen
115 | jmp (save_cinv)
116 | }
117 = main:
118 = sei
119 = lda cinv
120 = sta save_cinv
121 = lda cinv+1
122 = sta save_cinv+1
123 = lda #<our_cinv
124 = sta cinv
125 = lda #>our_cinv
126 = sta cinv+1
127 = cli
128 = rts
129 =
130 = our_cinv:
131 = inc screen
132 = jmp (save_cinv)
133 = rts
134 =
135 = .data
136 = .alias screen 1024
137 = .alias cinv 788
138 = .space save_cinv 2
139
140 Copy command: immediate -> byte
141
142 | reserve byte position
143 | routine main {
144 | copy #23 position
145 | }
146 = main:
147 = lda #23
148 = sta position
149 = rts
150 =
151 = .data
152 = .space position 1
153
154 Copy command: immediate -> word
155
156 | reserve word position
157 | routine main {
158 | copy #$0400 position
159 | }
160 = main:
161 = lda #0
162 = sta position
163 = lda #4
164 = sta position+1
165 = rts
166 =
167 = .data
168 = .space position 2
169
170 Copy command: byte-sized immediate -> word
171
172 Disabled for now.
173
174 | reserve word position
175 | routine main {
176 | copy #1 position
177 | }
178 = main:
179 = lda #1
180 = sta position
181 = lda #0
182 = sta position+1
183 = rts
184 =
185 = .data
186 = .space position 2
187
188 Copy command: word -> word
189
190 | reserve word position1
191 | reserve word position2
192 | routine main {
193 | copy position1 position2
194 | }
195 = main:
196 = lda position1
197 = sta position2
198 = lda position1+1
199 = sta position2+1
200 = rts
201 =
202 = .data
203 = .space position1 2
204 = .space position2 2
205
206 Copy command: word -> word indexed
207
208 | reserve word loc
209 | reserve word[4] locs
210 | routine main {
211 | ldy #0
212 | copy loc locs, y
213 | }
214 = main:
215 = ldy #0
216 = lda loc
217 = sta locs_lo, y
218 = lda loc+1
219 = sta locs_hi, y
220 = rts
221 =
222 = .data
223 = .space loc 2
224 = .space locs_lo 4
225 = .space locs_hi 4
226
227 Copy command: word INDEXED -> word
228
229 | reserve word loc
230 | reserve word[4] locs
231 | routine main {
232 | ldx #0
233 | copy locs, x loc
234 | }
235 = main:
236 = ldx #0
237 = lda locs_lo, x
238 = sta loc
239 = lda locs_hi, x
240 = sta loc+1
241 = rts
242 =
243 = .data
244 = .space loc 2
245 = .space locs_lo 4
246 = .space locs_hi 4
247
248 Copy command: byte -> indexed word table -> error.
249
250 | reserve byte bbb
251 | reserve word[4] locs
252 | routine main {
253 | ldx #0
254 | copy bbb locs, x
255 | }
256 ? incompatible types 'Byte' and 'Table Word 4'
257
258 Copy command: byte -> low byte of indexed word table
259
260 | reserve byte bbb
261 | reserve word[4] locs
262 | routine main {
263 | ldx #0
264 | copy bbb <locs, x
265 | }
266 = main:
267 = ldx #0
268 = lda bbb
269 = sta locs_lo, x
270 = rts
271 =
272 = .data
273 = .space bbb 1
274 = .space locs_lo 4
275 = .space locs_hi 4
276
277 Copy command: byte -> high byte of indexed word table
278
279 | reserve byte bbb
280 | reserve word[4] locs
281 | routine main {
282 | ldx #0
283 | copy bbb >locs, x
284 | }
285 = main:
286 = ldx #0
287 = lda bbb
288 = sta locs_hi, x
289 = rts
290 =
291 = .data
292 = .space bbb 1
293 = .space locs_lo 4
294 = .space locs_hi 4
295
296 Copy command: low byte of indexed word table -> byte
297
298 | reserve byte bbb
299 | reserve word[4] locs
300 | routine main {
301 | ldx #0
302 | copy <locs, x bbb
303 | }
304 = main:
305 = ldx #0
306 = lda locs_lo, x
307 = sta bbb
308 = rts
309 =
310 = .data
311 = .space bbb 1
312 = .space locs_lo 4
313 = .space locs_hi 4
314
315 Copy command: high byte of indexed word table -> byte
316
317 | reserve byte bbb
318 | reserve word[4] locs
319 | routine main {
320 | ldx #0
321 | copy >locs, x bbb
322 | }
323 = main:
324 = ldx #0
325 = lda locs_hi, x
326 = sta bbb
327 = rts
328 =
329 = .data
330 = .space bbb 1
331 = .space locs_lo 4
332 = .space locs_hi 4
333
334 `main` is always emitted first.
335
336 | reserve word position
337 | routine foo {
338 | inx
339 | }
340 | routine main {
341 | jsr foo
342 | jsr foo
343 | }
344 = main:
345 = jsr foo
346 = jsr foo
347 = rts
348 =
349 = foo:
350 = inx
351 = rts
352 =
353 = .data
354 = .space position 2
355
356 Reserving and assigning byte tables.
357
358 | reserve byte[16] frequencies
359 | assign byte[256] screen $0400
360 | routine main {
361 | lda #0
362 | ldy #0
363 | sta frequencies, y
364 | sta screen, y
365 | }
366 = main:
367 = lda #0
368 = ldy #0
369 = sta frequencies, y
370 = sta screen, y
371 = rts
372 =
373 = .data
374 = .space frequencies 16
375 = .alias screen 1024
376
377 Reserving things with initial values.
378
379 | reserve byte lives : 3
380 | reserve word screen : $0400
381 | reserve byte[8] frequencies : (0 1 2 4 5 8 9 10)
382 | reserve byte[13] message : "Hello, world!"
383 | routine main {
384 | }
385 = main:
386 = rts
387 =
388 = lives: .byte 3
389 = screen: .word 1024
390 = frequencies: .byte 0, 1, 2, 4, 5, 8, 9, 10
391 = message: .byte 72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33
392
393 Temporary storage, in the form of block-local declarations. Note that these
394 temporaries are not unioned yet, but they could be.
395
396 | routine a {
397 | reserve byte foo
398 | reserve word bar
399 | lda foo
400 | sta >bar
401 | }
402 | routine b {
403 | reserve byte baz
404 | reserve word quuz
405 | lda baz
406 | sta <quuz
407 | }
408 | routine main {
409 | jsr a
410 | jsr b
411 | }
412 = main:
413 = jsr a
414 = jsr b
415 = rts
416 =
417 = a:
418 = lda _temp_1
419 = sta _temp_2+1
420 = rts
421 =
422 = b:
423 = lda _temp_3
424 = sta _temp_4
425 = rts
426 =
427 = .data
428 = .space _temp_3 1
429 = .space _temp_4 2
430 = .space _temp_1 1
431 = .space _temp_2 2
432
433 Declaring and calling an external routine.
434
435 | external chrout 65490
436 | routine main {
437 | lda #72
438 | jsr chrout
439 | lda #73
440 | jsr chrout
441 | lda #13
442 | jsr chrout
443 | }
444 = main:
445 = lda #72
446 = jsr chrout
447 = lda #73
448 = jsr chrout
449 = lda #13
450 = jsr chrout
451 = rts
452 =
453 = .data
454 = .alias chrout 65490
455
+0
-320
doc/Instruction_Support.markdown less more
0 SixtyPical: Instruction Support
1 ===============================
2
3 Unsupported Opcodes
4 -------------------
5
6 6502 opcodes with no language-level equivalent instructions in SixtyPical
7 are `brk`, `cli`, `pla`, `plp`, `rti`, `rts`, `tsx`, `txs`. These may be
8 inserted into the output program as a SixtyPical → 6502 compiler sees fit,
9 however.
10
11 Note to self, the `pl` opcodes *do* change flags.
12
13 Instruction Support so far
14 --------------------------
15
16 A `X` indicates unsupported.
17
18 Funny syntax indicates use of a special form.
19
20 In these, `absolute` must be a `reserve`d or `assign`d address.
21 `immediate` must be a literal decimal or hexadecimal number
22 (or in future, a declared constant.)
23
24 adc #immediate
25 adc absolute
26
27 and #immediate
28 and absolute
29
30 asl
31 asl absolute
32
33 if bcc { block } else { block }
34
35 if bcs { block } else { block }
36
37 if beq { block } else { block }
38
39 bit absolute
40
41 if bmi { block } else { block }
42
43 if bne { block } else { block }
44
45 if bpl { block } else { block }
46
47 if bvc { block } else { block }
48
49 if bvs { block } else { block }
50
51 clc
52
53 cld
54
55 clv
56
57 cmp #immediate
58 cmp absolute
59
60 cpx #immediate
61 cpx absolute
62
63 cpy #immediate
64 cpy absolute
65
66 dec absolute
67
68 dex
69
70 dey
71
72 eor #immediate
73 eor absolute
74
75 inc absolute
76
77 inx
78
79 iny
80
81 jsr routine
82
83 jmp (vector)
84
85 lda #immediate
86 lda absolute
87 lda absolute, x
88 lda absolute, y
89 lda (absolute), y
90
91 ldx #immediate
92 ldx absolute
93
94 ldy #immediate
95 ldy absolute
96
97 lsr
98 lsr absolute
99
100 nop
101
102 ora #immediate
103 ora absolute
104
105 pha { block }
106
107 php { block }
108
109 rol
110 rol absolute
111
112 ror
113 ror absolute
114
115 sbc #immediate
116 sbc absolute
117
118 sec
119
120 sed
121
122 sei { block }
123
124 sta absolute
125 sta absolute, x
126 sta absolute, y
127 sta (absolute), y
128
129 stx absolute
130
131 sty absolute
132
133 tax
134
135 tay
136
137 txa
138
139 tya
140
141 Tests
142 -----
143
144 Should be merged with the above nicely someday.
145
146 -> Tests for functionality "Emit ASM for SixtyPical program"
147
148 Big test for parsing and emitting instructions.
149
150 | reserve word vword
151 | reserve byte vbyte
152 | assign byte[256] table 1024
153 | routine main {
154 | lda #4
155 | ldx #0
156 | ldy #$FF
157 | lda vbyte
158 | lda table, x
159 | lda table, y
160 | lda (vword), y
161 | lda <vword
162 | lda >vword
163 | inc vbyte
164 | tax
165 | inx
166 | dex
167 | stx vbyte
168 | tay
169 | iny
170 | dey
171 | sty vbyte
172 | cmp vbyte
173 | cmp #30
174 | cmp <vword
175 | cmp >vword
176 | ldx vbyte
177 | cpx vbyte
178 | cpx #31
179 | txa
180 | ldy vbyte
181 | cpy vbyte
182 | cpy #32
183 | tya
184 | sta vbyte
185 | sta table, x
186 | sta table, y
187 | sta (vword), y
188 | sta <vword
189 | sta >vword
190 | dec vbyte
191 | clc
192 | cld
193 | clv
194 | sec
195 | sed
196 | adc #8
197 | adc vbyte
198 | and #8
199 | and vbyte
200 | sbc #8
201 | sbc vbyte
202 | ora #8
203 | ora vbyte
204 | }
205 = main:
206 = lda #4
207 = ldx #0
208 = ldy #255
209 = lda vbyte
210 = lda table, x
211 = lda table, y
212 = lda (vword), y
213 = lda vword
214 = lda vword+1
215 = inc vbyte
216 = tax
217 = inx
218 = dex
219 = stx vbyte
220 = tay
221 = iny
222 = dey
223 = sty vbyte
224 = cmp vbyte
225 = cmp #30
226 = cmp vword
227 = cmp vword+1
228 = ldx vbyte
229 = cpx vbyte
230 = cpx #31
231 = txa
232 = ldy vbyte
233 = cpy vbyte
234 = cpy #32
235 = tya
236 = sta vbyte
237 = sta table, x
238 = sta table, y
239 = sta (vword), y
240 = sta vword
241 = sta vword+1
242 = dec vbyte
243 = clc
244 = cld
245 = clv
246 = sec
247 = sed
248 = adc #8
249 = adc vbyte
250 = and #8
251 = and vbyte
252 = sbc #8
253 = sbc vbyte
254 = ora #8
255 = ora vbyte
256 = rts
257 =
258 = .data
259 = .space vword 2
260 = .space vbyte 1
261 = .alias table 1024
262
263 | reserve word vword
264 | reserve byte vbyte
265 | assign byte[256] table 1024
266 | routine main {
267 | asl .a
268 | asl vbyte
269 | lsr .a
270 | lsr vbyte
271 | rol .a
272 | rol vbyte
273 | ror .a
274 | ror vbyte
275 | bit vbyte
276 | eor #5
277 | eor vbyte
278 | }
279 = main:
280 = asl
281 = asl vbyte
282 = lsr
283 = lsr vbyte
284 = rol
285 = rol vbyte
286 = ror
287 = ror vbyte
288 = bit vbyte
289 = eor #5
290 = eor vbyte
291 = rts
292 =
293 = .data
294 = .space vword 2
295 = .space vbyte 1
296 = .alias table 1024
297
298 | routine main {
299 | with pha {
300 | with sei {
301 | with php {
302 | lda #0
303 | }
304 | lda #1
305 | }
306 | lda #2
307 | }
308 | }
309 = main:
310 = pha
311 = sei
312 = php
313 = lda #0
314 = plp
315 = lda #1
316 = cli
317 = lda #2
318 = pla
319 = rts
0 Sixtypical
1 ==========
2
3 Sixtypical is a simplified version of [Sixtypical][].
4
5 This is a complete reboot of the previous design and implementation, which
6 was semantically a mess due to the way it was built.
7 This aims to be a simpler design which gets the static semantics right first,
8 and only then is extended to be more practical.
9
10 Types
11 -----
12
13 There are two TYPES in Sixtypical:
14
15 * bit (2 possible values)
16 * byte (256 possible values)
17
18 Memory locations
19 ----------------
20
21 The primary concept in Sixtypical is the MEMORY LOCATION. At any given point
22 in time during execution, each memory location is either UNINITIALIZED or
23 INITIALIZED. At any given point in the program text, too, each memory
24 location is either uninitialized or initialized. Where-ever it is one or
25 the other during execution, it is the same in the corresponding place in
26 the program text; thus, it is a static property.
27
28 (There is actually a third state, WRITTEN, which indicates that the memory
29 location is not only initialized, but also that it has been written to in
30 the current routine.)
31
32 There are four general kinds of memory location. The first three are
33 pre-defined and built-in.
34
35 ### Registers ###
36
37 Each of these hold a byte. They are initially uninitialized.
38
39 a
40 x
41 y
42
43 ### Flags ###
44
45 Each of these hold a bit. They are initially uninitialized.
46
47 c (carry)
48 z (zero)
49 v (overflow)
50 n (negative)
51
52 ### Constants ###
53
54 It may be strange to think of constants as memory locations, but keep in mind
55 that a memory location in Sixtypical need not map to a memory location in the
56 underlying hardware. All constants are read-only. Each is
57 initially initialized with the value that corresponds with its name.
58
59 They come in bit and byte types. There are two bit constants,
60
61 off
62 on
63
64 and two-hundred and fifty-six byte constants,
65
66 0
67 1
68 ...
69 255
70
71 ### User-defined ###
72
73 There may be any number of user-defined memory locations. They are defined
74 by giving the type, which must be `byte`, and the name.
75
76 byte pos
77
78 Routines
79 --------
80
81 Every routine must list all the memory locations it READS from, i.e. its
82 INPUTS, and all the memory locations it WRITES to, whether they are OUTPUTS
83 or merely TRASHED. Every memory location that is not written to is PRESERVED.
84
85 routine foo
86 inputs a, score
87 outputs x
88 trashes y {
89 ...
90 }
91
92 Routines may call only routines previously defined in the program source.
93 Thus, recursive routines are not allowed.
94
95 There must be one routine called `main`. This routine is executed when
96 the program is run.
97
98 Instructions
99 ------------
100
101 ### ld ###
102
103 ld <dest-memory-location>, <src-memory-location>
104
105 Reads from src and writes to dest.
106
107 * It is illegal if dest is not a register.
108 * It is illegal if dest does not occur in the WRITES list of the current
109 routine.
110 * It is illegal if src is not of same type as dest (i.e., is not a byte.)
111 * It is illegal if src is uninitialized.
112 * It is illegal if src does not either:
113 * be a constant, or
114 * occur in the READS list of the current routine, or
115 * occur in the WRITES list of the current routine AND
116 that location has previously been written inside this routine.
117
118 After execution, dest is considered initialized. The flags `z` and `n` may be
119 changed by this instruction, and they are considered initialized after it has
120 executed.
121
122 Some combinations, such as `ld x, y`, are illegal because they do not map to
123 underlying opcodes.
124
125 Notes:
126
127 ld a, 123 → LDA #123
128 ld a, lives → LDA LIVES
129 ld x, 123 → LDX #123
130 ld x, lives → LDX LIVES
131 ld y, 123 → LDY #123
132 ld y, lives → LDY LIVES
133 ld x, a → TAX
134 ld y, a → TAY
135 ld a, x → TXA
136 ld a, y → TYA
137
138 ### st ###
139
140 st <src-memory-location>, <dest-memory-location>
141
142 Reads from src and writes to dest.
143
144 * It is illegal if dest is a register or if dest is read-only.
145 * It is illegal if dest does not occur in the WRITES list of the current
146 routine.
147 * It is illegal if src is not of same type as dest.
148 * It is illegal if src is uninitialized.
149 * It is illegal if src does not either:
150 * be a constant, or
151 * occur in the READS list of the current routine, or
152 * occur in the WRITES list of the current routine AND
153 that location has previously been written inside this routine.
154
155 After execution, dest is considered initialized. No flags are
156 changed by this instruction (unless of course dest is a flag.)
157
158 Notes:
159
160 st a, lives → STA LIVES
161 st x, lives → STX LIVES
162 st y, lives → STY LIVES
163 st on, c → SEC
164 st off, c → CLC
165
166 ### add dest, src ###
167
168 add <dest-memory-location>, <src-memory-location>
169
170 Adds the contents of src to dest and stores the result in dest.
171
172 * It is illegal if src OR dest OR c is uninitialized.
173 * It is illegal if dest is read-only.
174 * It is illegal if dest does not occur in the WRITES AND READS lists
175 of the current routine.
176 * It is illegal if src does not either:
177 * be a constant, or
178 * occur in the READS list of the current routine, or
179 * occur in the WRITES list of the current routine AND
180 that location has previously been written inside this routine.
181
182 Affects n, z, c, and v flags.
183
184 dest continues to be initialized afterwards.
185
186 Notes:
187
188 add a, delta → ADC DELTA
189 add a, 1 → ADC #1
190
191 ### inc ###
192
193 TODO: these do not honour carry!
194
195 inc x → INX
196 inc y → INY
197 inc lives → INC LIVES
198
199 ### sub ###
200
201 sub <dest-memory-location>, <src-memory-location>
202
203 Subtracts the contents of src from dest and stores the result in dest.
204
205 The constraints and effects are exactly the same as for `add`.
206
207 Notes:
208
209 sub a, delta → SBC DELTA
210 sub a, 1 → SBC #1
211
212 ### dec ###
213
214 TODO: these do not honour carry!
215
216 dec x → DEX
217 dec y → DEY
218 dec lives → DEC LIVES
219
220 ### cmp ###
221
222 cmp <dest-memory-location>, <src-memory-location>
223
224 Subtracts the contents of src from dest, but does not store the result.
225
226 The constraints and effects are the same as for `sub`, except that `c`
227 need not be initialized before executing `cmp`, and the `v` flag is
228 unaffected.
229
230 Notes:
231
232 cmp a, delta → CMP DELTA
233 cmp a, 1 → CMP #1
234 cmp x, 1 → CPX #1
235 cmp y, 1 → CPY #1
236
237 ### and ###
238
239 and <dest-memory-location>, <src-memory-location>
240
241 "AND"s the contents of src with dest and stores the result in dest.
242
243 The constraints are the same as for `cmp`, except that the `c` flag
244 is not affected. i.e. only `n` and `z` flags are affected.
245
246 Notes:
247
248 and a, 8 → AND #8
249
250 ### or ###
251
252 or <dest-memory-location>, <src-memory-location>
253
254 "OR"s the contents of src with dest and stores the result in dest.
255
256 The constraints and effects are exactly the same as for `and`.
257
258 Notes:
259
260 or a, 8 → ORA #8
261
262 ### xor ###
263
264 xor <dest-memory-location>, <src-memory-location>
265
266 "XOR"s the contents of src with dest and stores the result in dest.
267
268 The constraints and effects are exactly the same as for `and`.
269
270 Notes:
271
272 xor a, 8 → EOR #8
273
274 ### shl ###
275
276 shl <dest-memory-location>
277
278 Shifts the dest left one bit position. The rightmost position becomes `c`,
279 and `c` becomes the bit that was shifted off the left.
280
281 * It is illegal if dest is a register besides `a`.
282 * It is illegal if dest is read-only.
283 * It is illegal if dest OR c is uninitialized.
284 * It is illegal if dest does not occur in the WRITES AND READS lists
285 of the current routine.
286
287 Notes:
288
289 shl a → ROL A
290 shl lives → ROL LIVES
291
292 ### shr ###
293
294 shr <dest-memory-location>
295
296 Shifts the dest right one bit position. The leftmost position becomes `c`,
297 and `c` becomes the bit that was shifted off the right.
298
299 Constraints are exactly the same as for `shl`.
300
301 Notes:
302
303 shr a → ROR A
304 shr lives → ROR LIVES
305
306 ### call ###
307
308 call <routine-name>
309
310 Just before the call,
311
312 * It is illegal if any of the memory locations in the routine's READS list is
313 uninitialized.
314
315 Just after the call,
316
317 * All memory locations listed as TRASHED in the routine's WRITES list are
318 considered uninitialized.
319
320 Notes:
321
322 call routine → JSR ROUTINE
323
324 ### if ###
325
326 if (bit) {
327 true-branch
328 } else {
329 false-branch
330 }
331
332 _bit_ is usually one of the flags, z or c.
333
334 Notes:
335
336 BEQ Branch on Result Zero
337 BMI Branch on Result Minus
338 BNE Branch on Result not Zero
339 BPL Branch on Result Plus
340 BCC Branch on Carry Clear
341 BCS Branch on Carry Set
342 BVC Branch on Overflow Clear
343 BVS Branch on Overflow Set
344
345
346 - - - -
347
348 Grammar
349 -------
350
351 Program ::= {Defn} {Routine}.
352 Defn ::= "byte" NewIdent.
353 Routine ::= "routine" NewIdent
354 ["inputs" LocExprs] ["outputs" LocExprs] ["trashes" LocExprs]
355 Block.
356 LocExprs::= LocExpr {"," LocExpr}.
357 LocExpr ::= Register | Flag | Const | DefnIdent.
358 Register::= "a" | "x" | "y".
359 Flag ::= "c" | "z" | "n" | "v".
360 Const ::= "0" ... "255".
361 Block ::= "{" {Instr} "}".
362 Instr ::= "ld" LocExpr "," LocExpr
363 | "st" LocExpr "," LocExpr
364 | "add" LocExpr "," LocExpr
365 | "sub" LocExpr "," LocExpr
366 | "cmp" LocExpr "," LocExpr
367 | "and" LocExpr "," LocExpr
368 | "or" LocExpr "," LocExpr
369 | "xor" LocExpr "," LocExpr
370 | "shl" LocExpr
371 | "shr" LocExpr
372 | "inc" LocExpr
373 | "dec" LocExpr
374 | "call" RoutineIdent
375 | "if" LocExpr Block ["else" Block].
376
377
378 ### 6502 instructions unsupported ###
379
380 ASL Shift Left One Bit (Memory or Accumulator)
381 LSR Shift Right One Bit (Memory or Accumulator)
382
383 BIT Test Bits in Memory with Accumulator
384 BRK Force Break
385
386 CLD Clear Decimal Mode
387 CLI Clear interrupt Disable Bit
388 CLV Clear Overflow Flag
389
390 NOP No Operation
391
392 JMP Jump to New Location // but may be generated as part of `if`
393
394 PHA Push Accumulator on Stack
395 PHP Push Processor Status on Stack
396 PLA Pull Accumulator from Stack
397 PLP Pull Processor Status from Stack
398
399 RTI Return from Interrupt
400 RTS Return from Subroutine
401
402 SED Set Decimal Mode
403 SEI Set Interrupt Disable Status
404
405 TSX Transfer Stack Pointer to Index X
406 TXS Transfer Index X to Stack Pointer
0 routine add_four
1 inputs a
2 outputs a
3 {
4 add a, 4
5 }
0 routine add_four
1 inputs a
2 outputs a
3 trashes c
4 {
5 st off, c
6 add a, 4
7 }
+0
-15
eg/cinv.60p less more
0 assign byte screen 1024
1 assign vector cinv 788
2 reserve vector save_cinv
3
4 routine main {
5 with sei {
6 copy cinv save_cinv
7 copy routine our_cinv to cinv
8 }
9 }
10
11 routine our_cinv {
12 inc screen
13 jmp (save_cinv)
14 }
+0
-110
eg/demo.60p less more
0 assign byte[256] screen $0400
1 assign byte[256] screen2 1274
2 assign byte[256] screen3 1524
3 assign byte[256] screen4 1774
4
5 assign byte[256] colormap 55296
6 assign byte[256] colormap2 55546
7 assign byte[256] colormap3 55796
8 assign byte[256] colormap4 56046
9
10 assign byte vic_border 53280
11 assign byte[4] vic_bg 53281
12
13 assign vector cinv 788
14 reserve vector save_cinv
15
16 assign word position $fb
17
18 reserve byte value
19
20 reserve word m
21 reserve word n
22
23 routine reset_position {
24 lda #$00
25 sta <position
26 lda #$04
27 sta >position
28 }
29
30 routine increment_pos {
31 clc
32 lda <position
33 adc #1
34 sta <position
35 lda >position
36 adc #0
37 sta >position
38 }
39
40 routine compare_16_bit {
41 lda >m
42 cmp >n
43 if beq {
44 lda <m
45 cmp <n
46 } else {
47 }
48 }
49
50 routine compare_pos {
51 lda <position
52 sta <m
53 lda >position
54 sta >m
55 lda #$07
56 sta >n
57 lda #$e8
58 sta <n
59 jsr compare_16_bit
60 }
61
62 routine clear_screen {
63 ldy #0
64 repeat bne {
65 lda #1
66 sta colormap, y
67 sta colormap2, y
68 sta colormap3, y
69 sta colormap4, y
70
71 lda #32
72 sta screen, y
73 sta screen2, y
74 sta screen3, y
75 sta screen4, y
76
77 iny
78 cpy #250
79 }
80 }
81
82 routine our_cinv {
83 inc value
84 lda value
85 ldy #0
86 sta (position), y
87 jsr increment_pos
88 jsr compare_pos
89 if beq {
90 jsr reset_position
91 } else {
92 }
93 jmp (save_cinv)
94 }
95
96 routine main {
97 lda #5
98 sta vic_border
99 lda #0
100 sta vic_bg
101 jsr reset_position
102 jsr clear_screen
103 with sei {
104 copy cinv save_cinv
105 copy routine our_cinv to cinv
106 }
107 clc
108 repeat bcc { }
109 }
0 byte lives
1
2 routine main
3 inputs lives
4 outputs lives
5 trashes a, x
6 {
7 ld a, 0
8 st a, lives
9 ld x, lives
10 st off, c
11 add x, 1
12 st x, lives
13 }
+0
-365
eg/game.60p less more
0 assign byte[256] screen $0400
1 assign byte[256] screen2 1274
2 assign byte[256] screen3 1524
3 assign byte[256] screen4 1774
4
5 assign byte[256] colormap 55296
6 assign byte[256] colormap2 55546
7 assign byte[256] colormap3 55796
8 assign byte[256] colormap4 56046
9
10 assign byte vic_border 53280
11 assign byte[4] vic_bg 53281
12
13 assign byte joy2 $dc00
14
15 assign vector cinv 788
16
17 /* --------- */
18
19 reserve vector save_cinv
20
21 // these are zero-page so that we can use them as indirect addresses
22 // through which we write to screen memory
23 assign word position $fb
24 assign word new_position $fd
25
26 reserve word delta
27 reserve byte value
28 reserve word compare_target
29
30 reserve word[16] actor_pos
31 reserve word[16] actor_delta
32 reserve vector[16] actor_logic
33
34 reserve vector dispatch_state
35 reserve vector dispatch_logic
36
37 reserve byte[18] press_fire_msg: "PRESS`FIRE`TO`PLAY"
38
39 // could be routine-local, if they were truly static
40 reserve byte button_down: 0
41
42 /******************************************
43 * Utility routines for manipulating/checking the current actor's
44 * position and delta.
45 ******************************************/
46
47 routine reverse_delta {
48 lda #40
49 cmp <delta
50 if beq {
51 // copy #-40 delta
52 lda #216
53 sta <delta
54 lda #255
55 sta >delta
56 } else {
57 // copy #40 delta
58 lda #40
59 sta <delta
60 lda #0
61 sta >delta
62 }
63 }
64
65 routine calculate_new_position outputs (new_position) {
66 clc
67 lda <position
68 adc <delta
69 sta <new_position
70 lda >position
71 adc >delta
72 sta >new_position
73 }
74
75 routine compare_new_pos outputs (.c) {
76 lda >new_position
77 cmp >compare_target
78 if beq {
79 lda <new_position
80 cmp <compare_target
81 } else {
82 }
83 }
84
85 routine check_new_position_in_bounds outputs (.c) {
86 copy #$07e8 compare_target // just past bottom of screen
87 jsr compare_new_pos
88
89 if bcs {
90 clc
91 } else {
92
93 copy #$0400 compare_target
94 jsr compare_new_pos
95
96 if bcc {
97 clc
98 } else {
99 sec
100 }
101 }
102 }
103
104 /******************************************
105 * Utility routines for dealing with the current actor's logic routine.
106 ******************************************/
107
108 routine indirect_jsr_logic {
109 jmp (dispatch_logic)
110 }
111
112 routine read_stick outputs (delta) {
113 lda #0
114 sta <delta
115 sta >delta
116 ldx joy2
117 txa
118 and #1 // up
119 if beq {
120 lda #216 // -40
121 sta <delta
122 lda #255
123 sta >delta
124 } else {
125 txa
126 and #2 // down
127 if beq {
128 lda #40
129 sta <delta
130 } else {
131 txa
132 and #4 // left
133 if beq {
134 lda #255 // -1
135 sta <delta
136 sta >delta
137 } else {
138 txa
139 and #8 // right
140 if beq {
141 lda #1
142 sta <delta
143 } else { }
144 }
145 }
146 }
147 }
148
149 routine check_fire outputs (.z) {
150 ldx joy2
151 txa
152 and #16
153 }
154
155 /********************
156 *** Actor Logics ***
157 ********************/
158
159 routine logic_player {
160 jsr read_stick
161 jsr calculate_new_position
162 jsr check_new_position_in_bounds
163 if bcs {
164 ldy #0
165 lda (new_position), y
166 cmp #32
167 if beq {
168 lda #32
169 ldy #0
170 sta (position), y
171 copy new_position position
172 lda #81
173 ldy #0
174 sta (position), y
175 } else {
176 // copy routine state_game_over to dispatch_state
177 }
178 } else { }
179 }
180
181 routine logic_obstacle {
182 jsr calculate_new_position
183 jsr check_new_position_in_bounds
184 if bcs {
185 ldy #0
186 lda (new_position), y
187 cmp #32
188 if beq {
189 lda #32
190 ldy #0
191 sta (position), y
192 copy new_position position
193 lda #82
194 ldy #0
195 sta (position), y
196 } else {
197 copy routine state_game_over to dispatch_state
198 }
199 } else {
200 jsr reverse_delta
201 }
202 }
203
204 /******************************************
205 * Utility routines used in dealing with the game state.
206 ******************************************/
207
208 routine clear_screen {
209 ldy #0
210 repeat bne {
211 lda #1
212 sta colormap, y
213 sta colormap2, y
214 sta colormap3, y
215 sta colormap4, y
216
217 lda #32
218 sta screen, y
219 sta screen2, y
220 sta screen3, y
221 sta screen4, y
222
223 iny
224 cpy #250
225 }
226 }
227
228 // You can repeatedly (i.e. as part of actor logic or an IRQ handler)
229 // call this routine.
230 // Upon return, if carry is set, the button was pressed then released.
231
232 routine check_button outputs (.c) {
233 lda button_down
234 if beq {
235 lda joy2
236 and #$10
237 if beq {
238 lda #1
239 sta button_down
240 } else { }
241 clc
242 } else {
243 lda joy2
244 and #$10
245 if bne {
246 lda #0
247 sta button_down
248 sec
249 } else {
250 clc
251 }
252 }
253 }
254
255 routine init_game {
256 ldy #0
257 ldx #0
258 repeat bne {
259 copy #$04 >actor_pos, y
260 txa
261 copy .a <actor_pos, y
262 inx
263 inx
264 inx
265 inx
266 inx
267 inx
268 inx
269
270 // sigh
271 // copy #$0001 actor_delta, y
272 copy #00 >actor_delta, y
273 copy #40 <actor_delta, y
274
275 cpy #0
276 if beq {
277 copy routine logic_player to actor_logic, y
278 } else {
279 copy routine logic_obstacle to actor_logic, y
280 }
281
282 iny
283 cpy #16
284 }
285 }
286
287 /*******************
288 *** Game States ***
289 *******************/
290
291 routine state_title_screen {
292 lda #5
293 sta vic_border
294 lda #0
295 sta vic_bg
296 ldy #0
297 repeat bne {
298 lda press_fire_msg, y
299 sec
300 sbc #64 // yuck
301 sta screen, y
302 iny
303 cpy #18
304 }
305 jsr check_button
306 if bcs {
307 jsr clear_screen
308 jsr init_game
309 copy routine state_play_game to dispatch_state
310 } else { }
311 jmp (save_cinv)
312 }
313
314 routine state_game_over {
315 inc vic_border
316 jsr check_button
317 if bcs {
318 jsr clear_screen
319 copy routine state_title_screen to dispatch_state
320 } else { }
321 jmp (save_cinv)
322 }
323
324 routine state_play_game {
325 reserve byte save_x
326 ldx #0
327 repeat bne {
328 stx save_x
329
330 copy actor_pos, x position
331 copy actor_delta, x delta
332 copy actor_logic, x dispatch_logic
333
334 jsr indirect_jsr_logic
335
336 ldx save_x
337 copy position actor_pos, x
338 copy delta actor_delta, x
339
340 inx
341 cpx #16
342 }
343 jmp (save_cinv)
344 }
345
346 /*************************
347 * Main Game Loop Driver *
348 *************************/
349
350 routine our_cinv {
351 jmp (dispatch_state)
352 }
353
354 routine main {
355 jsr clear_screen
356 copy routine state_title_screen to dispatch_state
357
358 with sei {
359 copy cinv save_cinv
360 copy routine our_cinv to cinv
361 }
362 clc
363 repeat bcc { }
364 }
+0
-13
eg/hello-world.60p less more
0 reserve byte[13] message: "HELLO, WORLD!"
1 external chrout 65490
2 routine main {
3 ldy #0
4 repeat bne {
5 lda message, y
6 jsr chrout
7 iny
8 cpy #13
9 }
10 lda #13
11 jsr chrout
12 }
0 routine foo
1 inputs a
2 outputs a
3 {
4 cmp a, 42
5 if z {
6 ld a, 7
7 } else {
8 ld a, 23
9 }
10 }
+0
-10
eg/screen1.60p less more
0 assign byte screen 1024
1 routine main {
2 ldy #0
3 repeat bne {
4 inc screen
5 dey
6 cpy #0
7 }
8 sty screen
9 }
+0
-7
eg/screen2.60p less more
0 assign byte screen 1024
1 routine main {
2 repeat bcc {
3 inc screen
4 clc
5 }
6 }
+0
-14
eg/screen3.60p less more
0 assign byte[256] screen 1024
1 reserve byte value
2 routine main {
3 lda #0
4 sta value
5 ldx #0
6 repeat bne {
7 lda value
8 inc value
9 sta screen, x
10 inx
11 cpx #80
12 }
13 }
+0
-9
lib/basic_header.oph less more
0 .charmap 'A, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26
1 .charmap 'a, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26
2 .org 0
3 .word $0801
4 .data
5 .org $c000
6 .text
7 .org $0801
8 .byte $10, $08, $c9, $07, $9e, $32, $30, $36, $31, $00, $00, $00
+0
-8
loadngo.sh less more
0 #!/bin/sh
1
2 ./build.sh || exit 1
3 bin/sixtypical emit $1 > tmp.oph || exit 1
4 cat lib/basic_header.oph tmp.oph > tmp2.oph || exit 1
5 ophis tmp2.oph -o tmp.prg || exit 1
6 x64 -joydev2 1 tmp.prg
7 rm -f tmp.oph tmp2.oph tmp.prg
+0
-48
src/Main.hs less more
0 -- encoding: UTF-8
1
2 module Main where
3
4 import System.IO
5 import System.Environment
6 import System.Exit
7
8 import SixtyPical.Model
9 import SixtyPical.Parser (parseProgram)
10 import SixtyPical.Checker (checkAndTransformProgram)
11 import SixtyPical.Analyzer (analyzeProgram)
12 import SixtyPical.Context (ppAnalysis)
13 import SixtyPical.Emitter (emitProgram)
14
15 -- -- -- -- driver -- -- -- --
16
17 usage = do
18 putStrLn "Usage: sixtypical (parse|check|analyze|emit) filename.60p"
19 exitWith $ ExitFailure 1
20
21 main = do
22 args <- getArgs
23 case args of
24 [verb, filename] -> do
25 programText <- readFile filename
26 case (verb, parseProgram programText) of
27 ("parse", Right program) -> do
28 putStrLn $ show $ program
29 ("check", Right program) -> do
30 case checkAndTransformProgram program of
31 Just newprog ->
32 putStrLn $ programSummary newprog
33 ("analyze", Right program) ->
34 case checkAndTransformProgram program of
35 Just newprog ->
36 ppAnalysis newprog (analyzeProgram newprog)
37 ("emit", Right program) ->
38 case checkAndTransformProgram program of
39 Just newprog ->
40 case (length (show (analyzeProgram newprog)) < 9999999) of
41 True ->
42 putStr $ emitProgram newprog
43 (_, Left problem) -> do
44 hPutStrLn stderr (show problem)
45 exitWith $ ExitFailure 1
46 (_, _) -> usage
47 _ -> usage
+0
-176
src/SixtyPical/Analyzer.hs less more
0 -- encoding: UTF-8
1
2 module SixtyPical.Analyzer where
3
4 import qualified Data.Map as Map
5
6 import SixtyPical.Model
7 import SixtyPical.Context
8
9 -- -- -- -- abstract interpreter -- -- -- --
10
11 analyzeProgram program@(Program decls routines) =
12 checkRoutines routines Map.empty
13 where
14 checkRoutines [] progCtx = progCtx
15 checkRoutines (rout@(Routine name outputs _) : routs) progCtx =
16 let
17 routCtx = Map.empty
18 routAnalysis = checkRoutine rout progCtx routCtx
19 progCtx' = Map.insert name routAnalysis progCtx
20 in
21 checkRoutines routs progCtx'
22
23 checkRoutine (Routine name outputs instrs) progCtx routCtx =
24 checkBlock name instrs progCtx routCtx
25
26 checkBlock nm (Block decls instrs) progCtx routCtx =
27 checkInstrs nm instrs progCtx routCtx
28
29 checkInstrs nm [] progCtx routCtx = routCtx
30 checkInstrs nm (instr:instrs) progCtx routCtx =
31 let
32 routCtx' = checkInstr nm instr progCtx routCtx
33 in
34 checkInstrs nm instrs progCtx routCtx'
35
36 -- -- -- -- -- -- -- -- -- -- -- --
37
38 checkInstr nm (COPY src dst) progCtx routCtx =
39 updateRoutCtxPoison nm dst (UpdatedWith src) routCtx
40 checkInstr nm (DELTA dst val) progCtx routCtx =
41 updateRoutCtxPoison nm dst (UpdatedWith (Immediate val)) routCtx
42 checkInstr nm (ADD dst src) progCtx routCtx =
43 updateRoutCtxPoison nm dst (UpdatedWith src) routCtx
44 checkInstr nm (SUB dst src) progCtx routCtx =
45 updateRoutCtxPoison nm dst (UpdatedWith src) routCtx
46
47 checkInstr nm (AND dst src) progCtx routCtx =
48 updateRoutCtxPoison nm dst (UpdatedWith src) routCtx
49 checkInstr nm (OR dst src) progCtx routCtx =
50 updateRoutCtxPoison nm dst (UpdatedWith src) routCtx
51 checkInstr nm (XOR dst src) progCtx routCtx =
52 updateRoutCtxPoison nm dst (UpdatedWith src) routCtx
53
54 checkInstr nm (JSR name) progCtx routCtx =
55 case lookupRoutine program name of
56 Just calledRout ->
57 case Map.lookup name progCtx of
58 Just calledRoutCtx ->
59 mergeRoutCtxs nm routCtx calledRoutCtx calledRout
60 Nothing ->
61 error ("can't call routine '" ++ name ++ "' before it is defined")
62 Nothing ->
63 -- it must be an external.
64 -- TODO: merge in any poisoning/outputs that are declared
65 -- on the external. for now,
66 routCtx
67
68 checkInstr nm (CMP reg addr) progCtx routCtx =
69 -- TODO: mark Carry bit as "touched" here
70 routCtx
71 checkInstr nm (IF _ branch b1 b2) progCtx routCtx =
72 let
73 routCtx1 = checkBlock nm b1 progCtx routCtx
74 routCtx2 = checkBlock nm b2 progCtx routCtx
75 in
76 mergeAlternateRoutCtxs nm routCtx1 routCtx2
77 checkInstr nm (REPEAT _ branch blk) progCtx routCtx =
78 -- we analyze the block twice, to simulate it being
79 -- repeated. (see tests for a test case on this.)
80 let
81 routCtx' = checkBlock nm blk progCtx routCtx
82 routCtx'' = checkBlock nm blk progCtx routCtx'
83 in
84 routCtx''
85
86 -- TODO -- THESE ARE WEAK --
87 checkInstr nm (WITH _ blk) progCtx routCtx =
88 checkBlock nm blk progCtx routCtx
89
90 checkInstr nm (BIT dst) progCtx routCtx =
91 updateRoutCtxPoison nm dst (UpdatedWith (Immediate 0)) routCtx
92
93 checkInstr nm (SHR dst flg) progCtx routCtx =
94 updateRoutCtxPoison nm dst (UpdatedWith flg) routCtx
95 checkInstr nm (SHL dst flg) progCtx routCtx =
96 updateRoutCtxPoison nm dst (UpdatedWith flg) routCtx
97
98 checkInstr nm (COPYROUTINE name dst) progCtx routCtx =
99 updateRoutCtxPoison nm dst (UpdatedWith (Immediate 7)) routCtx
100
101 checkInstr nm (JMPVECTOR dst) progCtx routCtx =
102 routCtx
103
104 checkInstr nm NOP progCtx routCtx =
105 routCtx
106
107 checkInstr nm instr _ _ = error (
108 "Internal error: sixtypical doesn't know how to " ++
109 "analyze '" ++ (show instr) ++ "' in '" ++ nm ++ "'")
110
111 --
112 -- Utility function:
113 -- Take 2 routine contexts -- the current routine and a routine that was just
114 -- JSR'ed to (immediately previously) -- and merge them to create a new
115 -- context for the current routine.
116 --
117 -- This can't, by itself, cause a poisoning error.
118 -- So we use a weaker version of updateRoutCtx to build the merged context.
119 --
120 mergeRoutCtxs nm routCtx calledRoutCtx calledRout@(Routine name outputs _) =
121 let
122 -- go through all the Usages in the calledRoutCtx
123 -- insert any that were updated, into routCtx
124 poison location usage routCtxAccum =
125 case usage of
126 UpdatedWith ulocation ->
127 case location `elem` outputs of
128 True ->
129 updateRoutCtx nm location usage routCtxAccum
130 False ->
131 updateRoutCtx nm location (PoisonedWith ulocation) routCtxAccum
132 PoisonedWith ulocation ->
133 updateRoutCtx nm location usage routCtxAccum
134 in
135 foldrWithKey (poison) routCtx calledRoutCtx
136 where
137 -- for Hugs Sep2006, which doesn't have Map.foldrWithKey
138 foldrWithKey f z = foldr (uncurry f) z . Map.toAscList
139
140 --
141 -- Utility function:
142 -- Take 2 routine contexts -- one from each branch of an `if` -- and merge
143 -- them to create a new context for the remainder of the routine.
144 --
145 -- We use a weaker version of updateRoutCtx to build the merged context.
146 -- We do this because accessing a poisoned storage location from either
147 -- of the branch contexts is not an error at the merge point -- we simply
148 -- make the storage location poisoned in the resulting context. (If the
149 -- poisoned location is accessed subsequently to the merge point, that is
150 -- of course still an error.)
151 --
152 mergeAlternateRoutCtxs nm routCtx1 routCtx2 =
153 let
154 -- go through all the Usages in routCtx2
155 -- insert any that were updated, into routCtx1
156 poison location usage2 routCtxAccum =
157 case Map.lookup location routCtx1 of
158 Nothing ->
159 updateRoutCtx nm location usage2 routCtxAccum
160 Just usage1 ->
161 -- it exists in both routCtxs.
162 -- if it is poisoned in either, it's poisoned here.
163 -- otherwise, it is OK to differ.
164 let
165 newUsage = case (usage1, usage2) of
166 (PoisonedWith _, _) -> usage1
167 (_, PoisonedWith _) -> usage2
168 _ -> usage1 -- or 2. doesn't matter.
169 in
170 updateRoutCtx nm location newUsage routCtxAccum
171 in
172 foldrWithKey (poison) routCtx1 routCtx2
173 where
174 -- for Hugs Sep2006, which doesn't have Map.foldrWithKey
175 foldrWithKey f z = foldr (uncurry f) z . Map.toAscList
+0
-86
src/SixtyPical/Checker.hs less more
0 -- encoding: UTF-8
1
2 module SixtyPical.Checker where
3
4 import SixtyPical.Model
5 import SixtyPical.Transformer
6
7 allTrue = foldl (&&) True
8
9 trueOrDie message test =
10 if test then True else error message
11
12 isUnique [] = True
13 isUnique (x:xs) = (not (x `elem` xs)) && isUnique xs
14
15 -- --
16
17 noDuplicateDecls program =
18 isUnique $ declaredLocationNames program
19
20 noDuplicateRoutines program =
21 isUnique $ declaredRoutineNames program
22
23 -- wow. efficiency is clearly our watchword
24 -- (and sarcasm is our backup watchword)
25 noIndexedAccessOfNonTables p@(Program decls routines) =
26 let
27 mappedProgram = mapProgramRoutines (checkInstr) p
28 in
29 mappedProgram == p
30 where
31 checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) =
32 case lookupDecl p g of
33 Just (Assign _ (Table _ _) _) -> j
34 Just (Reserve _ (Table _ _) _) -> j
35 Just _ -> (COPY A A)
36 Nothing -> (COPY A A)
37 checkInstr other = other
38
39 noUseOfUndeclaredRoutines p@(Program decls routines) =
40 let
41 undeclaredRoutines = foldProgramRoutines (checkInstr) 0 p
42 in
43 undeclaredRoutines == 0
44 where
45 routineNames = declaredRoutineNames p
46 -- TODO also check COPYROUTINE here
47 checkInstr j@(JSR routName) acc =
48 case routName `elem` routineNames of
49 True -> acc
50 False -> error ("undeclared routine '" ++ routName ++ "'") -- acc + 1
51 checkInstr other acc = acc
52
53 consistentInitialTableSizes p@(Program decls routines) =
54 let
55 inconsistentTableSizes = foldProgramDecls (checkDecl) 0 p
56 in
57 inconsistentTableSizes == 0
58 where
59 checkDecl (Reserve _ (Table _ sz) []) acc = acc
60 checkDecl (Reserve _ (Table _ sz) vals) acc =
61 case sz == (length vals) of
62 True -> acc
63 False -> acc + 1
64 checkDecl _ acc = acc
65
66 -- - - - - - -
67
68 checkAndTransformProgram :: Program -> Maybe Program
69 checkAndTransformProgram program =
70 if
71 trueOrDie ("missing 'main' routine: " ++ show program) (routineDeclared "main" program) &&
72 trueOrDie "duplicate location name" (noDuplicateDecls program) &&
73 trueOrDie "duplicate routine name" (noDuplicateRoutines program) &&
74 trueOrDie "undeclared routine" (noUseOfUndeclaredRoutines program) &&
75 trueOrDie "indexed access of non-table" (noIndexedAccessOfNonTables program) &&
76 trueOrDie "initial table incorrect size" (consistentInitialTableSizes program)
77 then
78 let
79 program' = numberProgramLoops program
80 program'' = renameBlockDecls program'
81 program''' = liftBlockDecls program''
82 program'''' = fillOutNamedLocationTypes program'''
83 in
84 Just program''''
85 else Nothing
+0
-93
src/SixtyPical/Context.hs less more
0 -- encoding: UTF-8
1
2 module SixtyPical.Context where
3
4 -- contexts for abstract interpretation.
5
6 import qualified Data.Map as Map
7
8 import SixtyPical.Model
9
10 --
11 -- The result of analyzing an instruction (or a block) is a map from
12 -- all relevant StorageLocations to how those StorageLocations were
13 -- used in that code (a Usage.)
14 --
15 -- If a StorageLocation is missing from the map, we can assume that
16 -- that code does not affect that StorageLocation (it is "retained".)
17 --
18
19 data Usage = PoisonedWith StorageLocation
20 | UpdatedWith StorageLocation
21 | NotChanged
22 deriving (Show, Ord, Eq)
23
24 type RoutineContext = Map.Map StorageLocation Usage
25
26 type ProgramContext = Map.Map RoutineName RoutineContext
27
28 untypedLocation (HighByteOf x) =
29 untypedLocation x
30 untypedLocation (LowByteOf x) =
31 untypedLocation x
32 untypedLocation (Indexed table index) =
33 untypedLocation table
34 untypedLocation (IndirectIndexed word index) =
35 IndirectIndexed (untypedLocation word) index
36 untypedLocation (NamedLocation _ name) =
37 NamedLocation Nothing name
38 untypedLocation x = x
39
40 updateRoutCtxPoison :: String -> StorageLocation -> Usage -> RoutineContext -> RoutineContext
41 updateRoutCtxPoison nm dst (UpdatedWith src) routCtx =
42 let
43 s = untypedLocation src
44 d = untypedLocation dst
45 in
46 case Map.lookup s routCtx of
47 Just (PoisonedWith _) ->
48 error ("routine '" ++ nm ++ "' does not preserve '" ++
49 (show s) ++ "' (in context: " ++ (show routCtx) ++ ")")
50 _ ->
51 Map.insert d (UpdatedWith s) routCtx
52 updateRoutCtxPoison nm dst (PoisonedWith src) routCtx =
53 Map.insert (untypedLocation dst) (PoisonedWith $ untypedLocation src) routCtx
54
55 updateRoutCtx nm dst (UpdatedWith src) routCtx =
56 let
57 s = untypedLocation src
58 d = untypedLocation dst
59 in
60 Map.insert d (UpdatedWith s) routCtx
61 updateRoutCtx nm dst (PoisonedWith src) routCtx =
62 Map.insert (untypedLocation dst) (PoisonedWith $ untypedLocation src) routCtx
63
64 -- pretty printing
65
66 ppAnalysis :: Program -> ProgramContext -> IO ()
67 ppAnalysis program progCtx =
68 let
69 li = Map.toList progCtx
70 in do
71 ppRoutines program li
72
73 ppRoutines program [] = return ()
74 ppRoutines program ((name, routCtx):rest) =
75 let
76 Just (Routine rname outputs _) = lookupRoutine program name
77 in do
78 putStrLn (rname ++ " (" ++ (show outputs) ++ ")")
79 ppRoutine routCtx
80 putStrLn ""
81 ppRoutines program rest
82
83 ppRoutine routCtx =
84 let
85 li = Map.toList routCtx
86 in do
87 ppUsages li
88
89 ppUsages [] = return ()
90 ppUsages ((loc, usage):rest) = do
91 putStrLn $ (" " ++ (show loc) ++ ": " ++ (show usage))
92 ppUsages rest
+0
-281
src/SixtyPical/Emitter.hs less more
0 -- encoding: UTF-8
1
2 module SixtyPical.Emitter where
3
4 import Data.Bits
5
6 import SixtyPical.Model
7
8 emitProgram p@(Program decls routines) =
9 let
10 mains = filter (\(Routine name _ _) -> name == "main") routines
11 allElse = filter (\(Routine name _ _) -> name /= "main") routines
12 initializedDecls = filter (\d -> isInitializedDecl d) decls
13 uninitializedDecls = filter (\d -> not $ isInitializedDecl d) decls
14 in
15 emitRoutines p mains ++
16 emitRoutines p allElse ++
17 emitDecls p initializedDecls ++
18 (case uninitializedDecls of
19 [] -> ""
20 _ -> ".data\n" ++ emitDecls p uninitializedDecls)
21
22 emitDecls _ [] = ""
23 emitDecls p (decl:decls) =
24 emitDecl p decl ++ "\n" ++ emitDecls p decls
25
26 emitDecl p (Assign name _ addr) = ".alias " ++ name ++ " " ++ (show addr)
27 emitDecl p (Reserve name typ [val])
28 | typ == Byte = name ++ ": .byte " ++ (show val)
29 | typ == Word = name ++ ": .word " ++ (show val)
30 | typ == Vector = name ++ ": .word " ++ (show val)
31
32 emitDecl p (Reserve name (Table Byte size) []) =
33 ".space " ++ name ++ " " ++ (show size)
34
35 emitDecl p (Reserve name (Table Byte size) vals) =
36 name ++ ": .byte " ++ (showList vals)
37 where
38 showList [] = ""
39 showList [val] = show val
40 showList (val:vals) = (show val) ++ ", " ++ (showList vals)
41
42 emitDecl p (Reserve name (Table typ size) [])
43 | typ == Word || typ == Vector =
44 ".space " ++ name ++ "_lo " ++ (show size) ++ "\n" ++
45 ".space " ++ name ++ "_hi " ++ (show size)
46
47 emitDecl p (Reserve name typ [])
48 | typ == Byte = ".space " ++ name ++ " 1"
49 | typ == Word = ".space " ++ name ++ " 2"
50 | typ == Vector = ".space " ++ name ++ " 2"
51
52 emitDecl p (External name addr) = ".alias " ++ name ++ " " ++ (show addr)
53 emitDecl p d = error (
54 "Internal error: sixtypical doesn't know how to " ++
55 "emit assembler code for '" ++ (show d) ++ "'")
56
57 emitRoutines _ [] = ""
58 emitRoutines p (rout:routs) =
59 emitRoutine p rout ++ "\n" ++ emitRoutines p routs
60
61 emitRoutine p r@(Routine name _ block) =
62 name ++ ":\n" ++ emitBlock p r block ++ " rts\n"
63
64 emitBlock p r (Block decls instrs) =
65 emitInstrs p r instrs
66
67 emitInstrs _ _ [] = ""
68 emitInstrs p r (instr:instrs) =
69 " " ++ emitInstr p r instr ++ "\n" ++ emitInstrs p r instrs
70
71 emitInstr p r (COPY (Immediate val) A) = "lda #" ++ (show val)
72 emitInstr p r (COPY (Immediate val) X) = "ldx #" ++ (show val)
73 emitInstr p r (COPY (Immediate val) Y) = "ldy #" ++ (show val)
74
75 emitInstr p r (COPY (Immediate 0) FlagC) = "clc"
76 emitInstr p r (COPY (Immediate 0) FlagD) = "cld"
77 emitInstr p r (COPY (Immediate 0) FlagV) = "clv"
78 emitInstr p r (COPY (Immediate 1) FlagC) = "sec"
79 emitInstr p r (COPY (Immediate 1) FlagD) = "sed"
80
81 emitInstr p r (COPY A (NamedLocation st label)) = "sta " ++ label
82 emitInstr p r (COPY X (NamedLocation st label)) = "stx " ++ label
83 emitInstr p r (COPY Y (NamedLocation st label)) = "sty " ++ label
84 emitInstr p r (COPY (NamedLocation st label) A) = "lda " ++ label
85 emitInstr p r (COPY (NamedLocation st label) X) = "ldx " ++ label
86 emitInstr p r (COPY (NamedLocation st label) Y) = "ldy " ++ label
87
88 emitInstr p r (COPY (LowByteOf (NamedLocation st label)) A) = "lda " ++ label
89 emitInstr p r (COPY (HighByteOf (NamedLocation st label)) A) = "lda " ++ label ++ "+1"
90
91 emitInstr p r (COPY A (LowByteOf (NamedLocation st label))) = "sta " ++ label
92 emitInstr p r (COPY A (HighByteOf (NamedLocation st label))) = "sta " ++ label ++ "+1"
93
94 emitInstr p r (COPY A X) = "tax"
95 emitInstr p r (COPY A Y) = "tay"
96 emitInstr p r (COPY X A) = "txa"
97 emitInstr p r (COPY Y A) = "tya"
98
99 emitInstr p r (COPY A (Indexed (NamedLocation (Just (Table Byte _)) label) X)) = "sta " ++ label ++ ", x"
100 emitInstr p r (COPY A (Indexed (NamedLocation (Just (Table Byte _)) label) Y)) = "sta " ++ label ++ ", y"
101
102 emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) X) A) = "lda " ++ label ++ ", x"
103 emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) Y) A) = "lda " ++ label ++ ", y"
104
105 emitInstr p r (COPY (NamedLocation (Just st1) src) (Indexed (NamedLocation (Just (Table st2 _)) dst) reg))
106 | (st1 == Vector && st2 == Vector) || (st1 == Word && st2 == Word) =
107 "lda " ++ src ++ "\n" ++
108 " sta " ++ dst ++ "_lo, " ++ (regName reg) ++ "\n" ++
109 " lda " ++ src ++ "+1\n" ++
110 " sta " ++ dst ++ "_hi, " ++ (regName reg)
111
112 emitInstr p r (COPY (NamedLocation (Just Byte) src)
113 (LowByteOf (Indexed (NamedLocation (Just (Table Word _)) dst) reg))) =
114 "lda " ++ src ++ "\n" ++
115 " sta " ++ dst ++ "_lo, " ++ (regName reg)
116
117 emitInstr p r (COPY (NamedLocation (Just Byte) src)
118 (HighByteOf (Indexed (NamedLocation (Just (Table Word _)) dst) reg))) =
119 "lda " ++ src ++ "\n" ++
120 " sta " ++ dst ++ "_hi, " ++ (regName reg)
121
122 emitInstr p r (COPY (Immediate value)
123 (LowByteOf (Indexed (NamedLocation (Just (Table Word _)) dst) reg))) =
124 "lda #" ++ (show value) ++ "\n" ++
125 " sta " ++ dst ++ "_lo, " ++ (regName reg)
126
127 emitInstr p r (COPY (Immediate value)
128 (HighByteOf (Indexed (NamedLocation (Just (Table Word _)) dst) reg))) =
129 "lda #" ++ (show value) ++ "\n" ++
130 " sta " ++ dst ++ "_hi, " ++ (regName reg)
131
132 emitInstr p r (COPY A
133 (LowByteOf (Indexed (NamedLocation (Just (Table Word _)) dst) reg))) =
134 "sta " ++ dst ++ "_lo, " ++ (regName reg)
135
136 emitInstr p r (COPY A
137 (HighByteOf (Indexed (NamedLocation (Just (Table Word _)) dst) reg))) =
138 "sta " ++ dst ++ "_hi, " ++ (regName reg)
139
140 emitInstr p r (COPY (LowByteOf (Indexed (NamedLocation (Just (Table Word _)) src) reg))
141 (NamedLocation (Just Byte) dst)) =
142 "lda " ++ src ++ "_lo, " ++ (regName reg) ++ "\n" ++
143 " sta " ++ dst
144
145 emitInstr p r (COPY (HighByteOf (Indexed (NamedLocation (Just (Table Word _)) src) reg))
146 (NamedLocation (Just Byte) dst)) =
147 "lda " ++ src ++ "_hi, " ++ (regName reg) ++ "\n" ++
148 " sta " ++ dst
149
150 emitInstr p r (COPY (Indexed (NamedLocation (Just (Table st1 _)) src) reg) (NamedLocation (Just st2) dst))
151 | (st1 == Vector && st2 == Vector) || (st1 == Word && st2 == Word) =
152 "lda " ++ src ++ "_lo, " ++ (regName reg) ++ "\n" ++
153 " sta " ++ dst ++ "\n" ++
154 " lda " ++ src ++ "_hi, " ++ (regName reg) ++ "\n" ++
155 " sta " ++ dst ++ "+1"
156
157 emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y"
158 emitInstr p r (COPY (IndirectIndexed (NamedLocation st label) Y) A) = "lda (" ++ label ++ "), y"
159
160 emitInstr p r (COPY (NamedLocation (Just st1) src) (NamedLocation (Just st2) dst))
161 | (st1 == Vector && st2 == Vector) || (st1 == Word && st2 == Word) =
162 "lda " ++ src ++ "\n" ++
163 " sta " ++ dst ++ "\n" ++
164 " lda " ++ src ++ "+1\n" ++
165 " sta " ++ dst ++ "+1"
166
167 emitInstr p r (COPY (Immediate v) (NamedLocation (Just st) dst))
168 | st == Byte =
169 "lda #" ++ (show v) ++ "\n" ++
170 " sta " ++ dst
171 | st == Word =
172 let
173 low = v .&. 255
174 high = (shift v (-8)) .&. 255
175 in
176 "lda #" ++ (show low) ++ "\n" ++
177 " sta " ++ dst ++ "\n" ++
178 " lda #" ++ (show high) ++ "\n" ++
179 " sta " ++ dst ++ "+1"
180
181 emitInstr p r (CMP A (NamedLocation st label)) = "cmp " ++ label
182 emitInstr p r (CMP X (NamedLocation st label)) = "cpx " ++ label
183 emitInstr p r (CMP Y (NamedLocation st label)) = "cpy " ++ label
184
185 emitInstr p r (CMP A (Immediate val)) = "cmp #" ++ (show val)
186 emitInstr p r (CMP X (Immediate val)) = "cpx #" ++ (show val)
187 emitInstr p r (CMP Y (Immediate val)) = "cpy #" ++ (show val)
188
189 emitInstr p r (CMP A (LowByteOf (NamedLocation st label))) = "cmp " ++ label
190 emitInstr p r (CMP A (HighByteOf (NamedLocation st label))) = "cmp " ++ label ++ "+1"
191
192 emitInstr p r (ADD A (NamedLocation st label)) = "adc " ++ label
193 emitInstr p r (ADD A (Immediate val)) = "adc #" ++ (show val)
194
195 emitInstr p r (ADD A (LowByteOf (NamedLocation st label))) = "adc " ++ label
196 emitInstr p r (ADD A (HighByteOf (NamedLocation st label))) = "adc " ++ label ++ "+1"
197
198 emitInstr p r (AND A (NamedLocation st label)) = "and " ++ label
199 emitInstr p r (AND A (Immediate val)) = "and #" ++ (show val)
200
201 emitInstr p r (SUB A (NamedLocation st label)) = "sbc " ++ label
202 emitInstr p r (SUB A (Immediate val)) = "sbc #" ++ (show val)
203
204 emitInstr p r (OR A (NamedLocation st label)) = "ora " ++ label
205 emitInstr p r (OR A (Immediate val)) = "ora #" ++ (show val)
206
207 emitInstr p r (XOR A (NamedLocation st label)) = "eor " ++ label
208 emitInstr p r (XOR A (Immediate val)) = "eor #" ++ (show val)
209
210 emitInstr p r (SHL A (Immediate 0)) = "asl"
211 emitInstr p r (SHL (NamedLocation st label) (Immediate 0)) = "asl " ++ label
212 emitInstr p r (SHR A (Immediate 0)) = "lsr"
213 emitInstr p r (SHR (NamedLocation st label) (Immediate 0)) = "lsr " ++ label
214 emitInstr p r (SHL A FlagC) = "rol"
215 emitInstr p r (SHL (NamedLocation st label) FlagC) = "rol " ++ label
216 emitInstr p r (SHR A FlagC) = "ror"
217 emitInstr p r (SHR (NamedLocation st label) FlagC) = "ror " ++ label
218
219 emitInstr p r (BIT (NamedLocation st label)) = "bit " ++ label
220
221 emitInstr p r (DELTA X 1) = "inx"
222 emitInstr p r (DELTA X (-1)) = "dex"
223 emitInstr p r (DELTA Y 1) = "iny"
224 emitInstr p r (DELTA Y (-1)) = "dey"
225 emitInstr p r (DELTA (NamedLocation st label) 1) = "inc " ++ label
226 emitInstr p r (DELTA (NamedLocation st label) (-1)) = "dec " ++ label
227
228 emitInstr p r (IF iid branch b1 b2) =
229 (show branch) ++ " _label_" ++ (show iid) ++ "\n" ++
230 emitBlock p r b2 ++
231 " jmp _past_" ++ (show iid) ++ "\n" ++
232 "_label_" ++ (show iid) ++ ":\n" ++
233 emitBlock p r b1 ++
234 "_past_" ++ (show iid) ++ ":"
235
236 emitInstr p r (REPEAT iid branch blk) =
237 "\n_repeat_" ++ (show iid) ++ ":\n" ++
238 emitBlock p r blk ++
239 " " ++ (show branch) ++ " _repeat_" ++ (show iid)
240
241 emitInstr p r (WITH SEI blk) =
242 "sei\n" ++
243 emitBlock p r blk ++
244 " cli"
245
246 emitInstr p r (WITH (PUSH A) blk) =
247 "pha\n" ++
248 emitBlock p r blk ++
249 " pla"
250
251 emitInstr p r (WITH (PUSH AllFlags) blk) =
252 "php\n" ++
253 emitBlock p r blk ++
254 " plp"
255
256 emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =
257 "lda #<" ++ src ++ "\n" ++
258 " sta " ++ dst ++ "\n" ++
259 " lda #>" ++ src ++ "\n" ++
260 " sta " ++ dst ++ "+1"
261
262 emitInstr p r (COPYROUTINE src (Indexed (NamedLocation (Just (Table Vector _)) dst) reg)) =
263 "lda #<" ++ src ++ "\n" ++
264 " sta " ++ dst ++ "_lo, " ++ (regName reg) ++ "\n" ++
265 " lda #>" ++ src ++ "\n" ++
266 " sta " ++ dst ++ "_hi, " ++ (regName reg)
267
268 emitInstr p r (JMPVECTOR (NamedLocation (Just Vector) dst)) =
269 "jmp (" ++ dst ++ ")"
270
271 emitInstr p r (JSR routineName) =
272 "jsr " ++ routineName
273
274 emitInstr p r i = error (
275 "Internal error: sixtypical doesn't know how to " ++
276 "emit assembler code for '" ++ (show i) ++ "'")
277
278
279 regName X = "x"
280 regName Y = "y"
+0
-204
src/SixtyPical/Model.hs less more
0 -- encoding: UTF-8
1
2 module SixtyPical.Model where
3
4 -- -- -- -- machine model -- -- -- --
5
6 type DataValue = Int -- LET'S ASSUME THIS IS AT LEAST 8 BITS
7 type Address = Int -- LET'S ASSUME THIS IS AT LEAST 16 BITS
8
9 type InternalID = Int -- for numbering labels for if/repeat
10
11 type LocationName = String
12
13 -- We do not include the PC as it of course changes constantly.
14 -- We do not include the stack pointer, as it should not change over
15 -- the lifetime of a single routine. (Always pop what you pushed.)
16 -- Ditto the I flag. (always enable interrupts after disabling them.)
17 -- We do not include the B flag, because for us, BRK is game over, man.
18
19 -- One of these should never refer to the program code. We can only police
20 -- this up to a point.
21
22 data StorageType = Byte
23 | Word
24 | Vector
25 | Table StorageType DataValue
26 deriving (Show, Ord, Eq)
27
28 data StorageLocation = A
29 | Y
30 | X
31 | FlagN
32 | FlagV
33 | FlagD
34 | FlagZ
35 | FlagC
36 | AllFlags -- for PHP
37 | Immediate DataValue
38 | Indirect StorageLocation
39 | Indexed StorageLocation StorageLocation
40 | IndirectIndexed StorageLocation StorageLocation