git @ Cat's Eye Technologies SixtyPical / aacfb02
`reserve`d storage locations can have initial values. Cat's Eye Technologies 8 years ago
7 changed file(s) with 61 addition(s) and 47 deletion(s). Raw diff Collapse all Expand all
121121 TODO
122122 ----
123123
124 * Initial values for reserved, incl. tables
124 * Initial values for reserved tables
125125 * give length for tables, must be there for reserved, if no init val
126126 * Character tables ("strings" to everybody else)
127 * Put uninitialized `reserve`d data in uninitialized data segment
127128 * Addressing modes — indexed mode on more instructions
128129 * `jsr (vector)`
129130 * `jmp routine`
6161 | reserve byte lives
6262 | routine main {
6363 | 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 {
6475 | sta lives
6576 | }
6677 | routine died {
3535 Emitting a `repeat`.
3636
3737 | assign byte screen 1024
38 | reserve byte zero
38 | reserve byte four : $04
3939 | routine main {
40 | ldy zero
40 | ldy four
4141 | repeat bne {
4242 | inc screen
4343 | dey
44 | cpy zero
44 | cpy four
4545 | }
4646 | sty screen
4747 | }
4848 = main:
49 = ldy zero
49 = ldy four
5050 =
5151 = _repeat_1:
5252 = inc screen
5353 = dey
54 = cpy zero
54 = cpy four
5555 = BNE _repeat_1
5656 = sty screen
5757 = rts
5858 =
5959 = .alias screen 1024
60 = zero: .byte 0
60 = four: .byte 4
6161
6262 Nested ifs.
6363
3030 checkInstr j@(COPY _ (Indexed (NamedLocation sz g) reg)) =
3131 case lookupDecl p g of
3232 Just (Assign _ ByteTable _) -> j
33 Just (Reserve _ ByteTable) -> j
33 Just (Reserve _ ByteTable _) -> j
3434 Just _ -> (COPY A A)
3535 Nothing -> (COPY A A)
3636 checkInstr other = other
1919 emitDecl p decl ++ "\n" ++ emitDecls p decls
2020
2121 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
2531 emitDecl p (External name addr) = ".alias " ++ name ++ " " ++ (show addr)
2632 emitDecl p d = error (
2733 "Internal error: sixtypical doesn't know how to " ++
4646 -- -- -- -- program model -- -- -- --
4747
4848 data Decl = Assign LocationName StorageType Address -- .alias
49 | Reserve LocationName StorageType -- .word, .byte
49 | Reserve LocationName StorageType (Maybe DataValue) -- .word, .byte
5050 | External RoutineName Address
5151 deriving (Show, Ord, Eq)
5252
9292 getRoutineName (Routine name _ _) = name
9393
9494 getDeclLocationName (Assign name _ _) = name
95 getDeclLocationName (Reserve name _) = name
95 getDeclLocationName (Reserve name _ _) = name
9696
9797 getDeclLocationType (Assign _ t _) = t
98 getDeclLocationType (Reserve _ t) = t
98 getDeclLocationType (Reserve _ t _) = t
9999
100100 isLocationDecl (Assign _ _ _) = True
101 isLocationDecl (Reserve _ _) = True
101 isLocationDecl (Reserve _ _ _) = True
102102 isLocationDecl _ = False
103103
104104 declaredLocationNames (Program decls _) =
1010 {-
1111
1212 Toplevel := {Decl} {Routine}.
13 Decl := "reserve" StorageType LocationName
14 | "assign" StorageType LocationName Address
13 Decl := "reserve" StorageType LocationName [":" Literal]
14 | "assign" StorageType LocationName Literal
1515 | "external" RoutineName Address.
16 StorageType := "byte" | "word" | "vector".
16 StorageType := "byte" | "word" | "byte table" | "vector".
1717 Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block.
1818 Block := "{" {Command} "}".
1919 Command := "if" Branch Block "else" Block
6767 nspaces
6868 sz <- storage_type
6969 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
7175
7276 assign :: Parser Decl
7377 assign = do
7579 nspaces
7680 sz <- storage_type
7781 name <- location_name
78 addr <- address
82 addr <- literal_address
7983 return $ Assign name sz addr
8084
8185 external :: Parser Decl
8387 string "external"
8488 nspaces
8589 name <- routineName
86 addr <- address
90 addr <- literal_address
8791 return $ External name addr
8892
8993 get_storage "byte" = Byte
195199 immediate :: Parser AddressingModality
196200 immediate = do
197201 string "#"
198 v <- data_value
202 v <- literal_data_value
199203 return $ Immediately v
200204
201205 addressing_mode :: String -> (AddressingModality -> [StorageLocation] -> Instruction) -> Parser Instruction
584588 name <- location_name
585589 return (NamedLocation Nothing name)
586590
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
591603 char '$'
592604 digits <- many hexDigit
593605 nspaces
594606 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
599611 digits <- many digit
600612 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
618614
619615 -- -- -- driver -- -- --
620616