Commit 2088769b8e5b5563f4ced3569ab42a47262c5315 - SixtyPical

+29

-1

doc/Emitting.markdown less more

+1

-1

eg/cinv.60p less more

+10

-19

eg/game.60p less more

33	33	jsr reset_position
34	34	jsr clear_screen
35	35	sei {
36		copy vector cinv to save_cinv
	36	copy cinv save_cinv
37	37	copy routine our_cinv to cinv
38	38	}
39	39	clc

41	41	}
42	42
43	43	routine our_cinv {
44		lda value
45		inc value
	44	lda #32
46	45	ldy #0
47	46	sta (position), y
48	47	jsr read_stick

52	51	jsr install_new_position
53	52	} else { }
54	53
	54	lda #81
	55	ldy #0
	56	sta (position), y
	57
55	58	jmp (save_cinv)
56	59	}
57	60
58	61	routine reset_position {
59		lda #$00
60		sta <position
61		lda #$04
62		sta >position
	62	copy #$0400 position
63	63	}
64	64
65	65	routine advance_pos {

73	73	}
74	74
75	75	routine install_new_position {
76		lda <new_position
77		sta <position
78		lda >new_position
79		sta >position
	76	copy new_position position
80	77	}
81	78
82	79	routine check_new_position_in_bounds {
83		lda #$07 ; just past bottom of screen
84		sta >compare_target
85		lda #$e8
86		sta <compare_target
	80	copy #$07e8 compare_target ; just past bottom of screen
87	81	jsr compare_new_pos
88	82
89	83	if bcs {
90	84	clc
91	85	} else {
92	86
93		lda #$04
94		sta >compare_target
95		lda #$00
96		sta <compare_target
	87	copy #$0400 compare_target
97	88	jsr compare_new_pos
98	89
99	90	if bcc {

+2

-0

src/SixtyPical/Checker.hs less more

+23

-6

src/SixtyPical/Emitter.hs less more

0	0	-- encoding: UTF-8
1	1
2	2	module SixtyPical.Emitter where
	3
	4	import Data.Bits
3	5
4	6	import SixtyPical.Model
5	7

67	69
68	70	emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y"
69	71	emitInstr p r (COPY (IndirectIndexed (NamedLocation st label) Y) A) = "lda (" ++ label ++ "), y"
	72
	73	emitInstr p r (COPY (NamedLocation (Just st1) src) (NamedLocation (Just st2) dst))
	74	\| (st1 == Vector && st2 == Vector) \|\| (st1 == Word && st2 == Word) =
	75	"lda " ++ src ++ "\n" ++
	76	" sta " ++ dst ++ "\n" ++
	77	" lda " ++ src ++ "+1\n" ++
	78	" sta " ++ dst ++ "+1"
	79
	80	emitInstr p r (COPY (Immediate v) (NamedLocation (Just st) dst))
	81	\| st == Byte =
	82	"lda #" ++ (show v) ++ "\n" ++
	83	" sta " ++ dst
	84	\| st == Word =
	85	let
	86	low = v .&. 255
	87	high = (shift v (-8)) .&. 255
	88	in
	89	"lda #" ++ (show low) ++ "\n" ++
	90	" sta " ++ dst ++ "\n" ++
	91	" lda #" ++ (show high) ++ "\n" ++
	92	" sta " ++ dst ++ "+1"
70	93
71	94	emitInstr p r (CMP A (NamedLocation st label)) = "cmp " ++ label
72	95	emitInstr p r (CMP X (NamedLocation st label)) = "cpx " ++ label

143	166	emitInstrs p r blk ++
144	167	" plp"
145	168
146		emitInstr p r (COPYVECTOR (NamedLocation (Just Vector) src) (NamedLocation (Just Vector) dst)) =
147		"lda " ++ src ++ "\n" ++
148		" sta " ++ dst ++ "\n" ++
149		" lda " ++ src ++ "+1\n" ++
150		" sta " ++ dst ++ "+1"
151
152	169	emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) =
153	170	"lda #<" ++ src ++ "\n" ++
154	171	" sta " ++ dst ++ "\n" ++

+10

-10

src/SixtyPical/Parser.hs less more

202	202	(try rol) <\|> (try ror) <\|>
203	203	(try sei) <\|> (try pha) <\|> (try php) <\|>
204	204	(try jmp) <\|> (try jsr) <\|>
205		(try copy_vector_statement) <\|>
206	205	(try copy_routine_statement) <\|>
	206	(try copy_general_statement) <\|>
207	207	if_statement <\|> repeat_statement <\|> nop
208	208
209	209	nop :: Parser Instruction

507	507	blk <- block
508	508	return (REPEAT 0 brch blk)
509	509
510		copy_vector_statement :: Parser Instruction
511		copy_vector_statement = do
	510	copy_general_statement :: Parser Instruction
	511	copy_general_statement = do
512	512	string "copy"
513	513	spaces
514		string "vector"
515		spaces
516		src <- locationName
517		string "to"
518		spaces
519		dst <- locationName
520		return (COPYVECTOR (NamedLocation Nothing src) (NamedLocation Nothing dst))
	514	src <- (try immediate <\|> try direct_location)
	515	dst <- direct_location
	516	return $ case (src, dst) of
	517	(Immediately s, Directly d) ->
	518	(COPY (Immediate s) (NamedLocation Nothing d))
	519	(Directly s, Directly d) ->
	520	(COPY (NamedLocation Nothing s) (NamedLocation Nothing d))
521	521
522	522	copy_routine_statement :: Parser Instruction
523	523	copy_routine_statement = do