Commit 16d6a54fb5e2b006122815ccc732aee11c4da149 - SixtyPical

+16

-0

doc/Checking.markdown less more

127	127	\| sta table, y
128	128	\| }
129	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
130	146
131	147	An address may be declared with `locate`, which is like `.alias` in an
132	148	assembler, with the understanding that the value will be treated "like an

+4

-4

src/SixtyPical/Checker.hs less more

30	30	where
31	31	checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) =
32	32	case lookupDecl p g of
33		Just (Assign _ (ByteTable _) _) -> j
34		Just (Reserve _ (ByteTable _) _) -> j
	33	Just (Assign _ (Table Byte _) _) -> j
	34	Just (Reserve _ (Table Byte _) _) -> j
35	35	Just _ -> (COPY A A)
36	36	Nothing -> (COPY A A)
37	37	checkInstr other = other

56	56	in
57	57	inconsistentTableSizes == 0
58	58	where
59		checkDecl (Reserve _ (ByteTable sz) []) acc = acc
60		checkDecl (Reserve _ (ByteTable sz) vals) acc =
	59	checkDecl (Reserve _ (Table _ sz) []) acc = acc
	60	checkDecl (Reserve _ (Table _ sz) vals) acc =
61	61	case sz == (length vals) of
62	62	True -> acc
63	63	False -> acc + 1

+7

-7

src/SixtyPical/Emitter.hs less more

29	29	\| typ == Word = name ++ ": .word " ++ (show val)
30	30	\| typ == Vector = name ++ ": .word " ++ (show val)
31	31
32		emitDecl p (Reserve name (ByteTable size) []) =
	32	emitDecl p (Reserve name (Table Byte size) []) =
33	33	".space " ++ name ++ " " ++ (show size)
34	34
35		emitDecl p (Reserve name (ByteTable size) vals) =
	35	emitDecl p (Reserve name (Table Byte size) vals) =
36	36	name ++ ": .byte " ++ (showList vals)
37	37	where
38	38	showList [] = ""

91	91	emitInstr p r (COPY X A) = "txa"
92	92	emitInstr p r (COPY Y A) = "tya"
93	93
94		emitInstr p r (COPY A (Indexed (NamedLocation (Just (ByteTable _)) label) X)) = "sta " ++ label ++ ", x"
95		emitInstr p r (COPY A (Indexed (NamedLocation (Just (ByteTable _)) label) Y)) = "sta " ++ label ++ ", y"
96
97		emitInstr p r (COPY (Indexed (NamedLocation (Just (ByteTable _)) label) X) A) = "lda " ++ label ++ ", x"
98		emitInstr p r (COPY (Indexed (NamedLocation (Just (ByteTable _)) label) Y) A) = "lda " ++ label ++ ", y"
	94	emitInstr p r (COPY A (Indexed (NamedLocation (Just (Table Byte _)) label) X)) = "sta " ++ label ++ ", x"
	95	emitInstr p r (COPY A (Indexed (NamedLocation (Just (Table Byte _)) label) Y)) = "sta " ++ label ++ ", y"
	96
	97	emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) X) A) = "lda " ++ label ++ ", x"
	98	emitInstr p r (COPY (Indexed (NamedLocation (Just (Table Byte _)) label) Y) A) = "lda " ++ label ++ ", y"
99	99
100	100	emitInstr p r (COPY A (IndirectIndexed (NamedLocation st label) Y)) = "sta (" ++ label ++ "), y"
101	101	emitInstr p r (COPY (IndirectIndexed (NamedLocation st label) Y) A) = "lda (" ++ label ++ "), y"

+1

-1

src/SixtyPical/Model.hs less more

22	22	data StorageType = Byte
23	23	\| Word
24	24	\| Vector
25		\| ByteTable DataValue
	25	\| Table StorageType DataValue
26	26	deriving (Show, Ord, Eq)
27	27
28	28	data StorageLocation = A

+8

-8

src/SixtyPical/Parser.hs less more

15	15	\| "assign" StorageType LocationName Literal
16	16	\| "external" RoutineName Address.
17	17	InitialValue ::= Literal \| StringLiteral \| "(" {Literal} ")".
18		StorageType ::= "byte" ["[" Literal "]"] \| "word" \| "vector".
	18	StorageType ::= ("byte" \| "word" \| "vector") ["[" Literal "]"].
19	19	Routine ::= "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
20	20	Block ::= "{" {Decl} {Command} "}".
21	21	Command ::= "if" Branch Block "else" Block

98	98	nspaces
99	99	return t
100	100
101		byte_table :: Parser StorageType
102		byte_table = do
103		string "byte"
104		nspaces
	101	table :: StorageType -> Parser StorageType
	102	table typ = do
105	103	string "["
106	104	nspaces
107	105	size <- literal_data_value
108	106	string "]"
109	107	nspaces
110		return $ ByteTable size
	108	return $ Table typ size
111	109
112	110	storage_type :: Parser StorageType
113		storage_type = (try $ byte_table) <\|> (storage "byte" Byte) <\|>
114		(storage "word" Word) <\|> (storage "vector" Vector)
	111	storage_type = do
	112	typ <- (storage "byte" Byte) <\|> (storage "word" Word) <\|>
	113	(storage "vector" Vector)
	114	option typ (table typ)
115	115
116	116	initial_value :: Parser [DataValue]
117	117	initial_value =

+2

-2

src/SixtyPical/Transformer.hs less more

123	123	in
124	124	case (typeRx == typeRy, typeRx, typeRy) of
125	125	(True, _, _) -> constructor rx ry
126		(_, Byte, (ByteTable _)) -> constructor rx ry
127		(_, (ByteTable _), Byte) -> constructor rx ry
	126	(_, Byte, (Table Byte _)) -> constructor rx ry
	127	(_, (Table Byte _), Byte) -> constructor rx ry
128	128	_ -> error ("incompatible types '" ++ (show typeRx) ++ "' and '" ++ (show typeRy) ++ "'")
129	129	resolve (NamedLocation Nothing name) =
130	130	case lookupDecl p name of