Commit aacfb02375b74713a0d88faceca6ac59700125fd - SixtyPical

+2

-1

README.markdown less more

121	121	TODO
122	122	----
123	123
124		* Initial values for reserved, incl. tables
	124	* Initial values for reserved tables
125	125	* give length for tables, must be there for reserved, if no init val
126	126	* Character tables ("strings" to everybody else)
	127	* Put uninitialized `reserve`d data in uninitialized data segment
127	128	* Addressing modes — indexed mode on more instructions
128	129	* `jsr (vector)`
129	130	* `jmp routine`

+11

-0

doc/Checking.markdown less more

61	61	\| reserve byte lives
62	62	\| routine main {
63	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 {
64	75	\| sta lives
65	76	\| }
66	77	\| routine died {

+6

-6

doc/Emitting.markdown less more

35	35	Emitting a `repeat`.
36	36
37	37	\| assign byte screen 1024
38		\| reserve byte zero
	38	\| reserve byte four : $04
39	39	\| routine main {
40		\| ldy zero
	40	\| ldy four
41	41	\| repeat bne {
42	42	\| inc screen
43	43	\| dey
44		\| cpy zero
	44	\| cpy four
45	45	\| }
46	46	\| sty screen
47	47	\| }
48	48	= main:
49		= ldy zero
	49	= ldy four
50	50	=
51	51	= _repeat_1:
52	52	= inc screen
53	53	= dey
54		= cpy zero
	54	= cpy four
55	55	= BNE _repeat_1
56	56	= sty screen
57	57	= rts
58	58	=
59	59	= .alias screen 1024
60		= zero: .byte 0
	60	= four: .byte 4
61	61
62	62	Nested ifs.
63	63

+1

-1

src/SixtyPical/Checker.hs less more

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

+9

-3

src/SixtyPical/Emitter.hs less more

19	19	emitDecl p decl ++ "\n" ++ emitDecls p decls
20	20
21	21	emitDecl p (Assign name _ addr) = ".alias " ++ name ++ " " ++ (show addr)
22		emitDecl p (Reserve name Byte) = name ++ ": .byte 0"
23		emitDecl p (Reserve name Word) = name ++ ": .word 0"
24		emitDecl p (Reserve name Vector) = name ++ ": .word 0"
	22	emitDecl p (Reserve name typ value)
	23	\| typ == Byte = name ++ ": .byte " ++ val
	24	\| typ == Word = name ++ ": .word " ++ val
	25	\| typ == Vector = name ++ ": .word " ++ val
	26	where
	27	val = case value of
	28	(Just v) -> (show v)
	29	Nothing -> "0"
	30
25	31	emitDecl p (External name addr) = ".alias " ++ name ++ " " ++ (show addr)
26	32	emitDecl p d = error (
27	33	"Internal error: sixtypical doesn't know how to " ++

+4

-4

src/SixtyPical/Model.hs less more

46	46	-- -- -- -- program model -- -- -- --
47	47
48	48	data Decl = Assign LocationName StorageType Address -- .alias
49		\| Reserve LocationName StorageType -- .word, .byte
	49	\| Reserve LocationName StorageType (Maybe DataValue) -- .word, .byte
50	50	\| External RoutineName Address
51	51	deriving (Show, Ord, Eq)
52	52

92	92	getRoutineName (Routine name _ _) = name
93	93
94	94	getDeclLocationName (Assign name _ _) = name
95		getDeclLocationName (Reserve name _) = name
	95	getDeclLocationName (Reserve name _ _) = name
96	96
97	97	getDeclLocationType (Assign _ t _) = t
98		getDeclLocationType (Reserve _ t) = t
	98	getDeclLocationType (Reserve _ t _) = t
99	99
100	100	isLocationDecl (Assign _ _ _) = True
101		isLocationDecl (Reserve _ _) = True
	101	isLocationDecl (Reserve _ _ _) = True
102	102	isLocationDecl _ = False
103	103
104	104	declaredLocationNames (Program decls _) =

+28

-32

src/SixtyPical/Parser.hs less more

10	10	{-
11	11
12	12	Toplevel := {Decl} {Routine}.
13		Decl := "reserve" StorageType LocationName
14		\| "assign" StorageType LocationName Address
	13	Decl := "reserve" StorageType LocationName [":" Literal]
	14	\| "assign" StorageType LocationName Literal
15	15	\| "external" RoutineName Address.
16		StorageType := "byte" \| "word" \| "vector".
	16	StorageType := "byte" \| "word" \| "byte table" \| "vector".
17	17	Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
18	18	Block := "{" {Command} "}".
19	19	Command := "if" Branch Block "else" Block

67	67	nspaces
68	68	sz <- storage_type
69	69	name <- location_name
70		return $ Reserve name sz
	70	value <- option Nothing (do{ string ":";
	71	nspaces;
	72	x <- literal_data_value;
	73	return $ Just x })
	74	return $ Reserve name sz value
71	75
72	76	assign :: Parser Decl
73	77	assign = do

75	79	nspaces
76	80	sz <- storage_type
77	81	name <- location_name
78		addr <- address
	82	addr <- literal_address
79	83	return $ Assign name sz addr
80	84
81	85	external :: Parser Decl

83	87	string "external"
84	88	nspaces
85	89	name <- routineName
86		addr <- address
	90	addr <- literal_address
87	91	return $ External name addr
88	92
89	93	get_storage "byte" = Byte

195	199	immediate :: Parser AddressingModality
196	200	immediate = do
197	201	string "#"
198		v <- data_value
	202	v <- literal_data_value
199	203	return $ Immediately v
200	204
201	205	addressing_mode :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction

584	588	name <- location_name
585	589	return (NamedLocation Nothing name)
586	590
587		address = hex_address <\|> decimal_address
588
589		hex_address :: Parser Address
590		hex_address = do
	591	literal_address = do
	592	a <- literal_value
	593	return (a :: Address)
	594
	595	literal_data_value = do
	596	a <- literal_value
	597	return (a :: DataValue)
	598
	599	literal_value = hex_literal <\|> decimal_literal
	600
	601	hex_literal :: Parser Int
	602	hex_literal = do
591	603	char '$'
592	604	digits <- many hexDigit
593	605	nspaces
594	606	let ((d, _):_) = readHex digits
595		return (d :: Address)
596
597		decimal_address :: Parser Address
598		decimal_address = do
	607	return d
	608
	609	decimal_literal :: Parser Int
	610	decimal_literal = do
599	611	digits <- many digit
600	612	nspaces
601		return (read digits :: Address)
602
603		data_value = hex_data_value <\|> decimal_data_value
604
605		hex_data_value :: Parser DataValue
606		hex_data_value = do
607		char '$'
608		digits <- many hexDigit
609		nspaces
610		let ((d, _):_) = readHex digits
611		return (d :: DataValue)
612
613		decimal_data_value :: Parser DataValue
614		decimal_data_value = do
615		digits <- many digit
616		nspaces
617		return (read digits :: DataValue)
	613	return $ read digits
618	614
619	615	-- -- -- driver -- -- --
620	616