From aaec12d5e5e3abacd785030749494babc9ae251e Mon Sep 17 00:00:00 2001 From: Cat's Eye Technologies Date: Fri, 11 Apr 2014 22:50:03 +0100 Subject: [PATCH] Initial, awkward support for block-level declarations, including a failing test. --- README.markdown | 22 ++++++++++------------ doc/Emitting.markdown | 37 +++++++++++++++++++++++++++++++++++++ src/SixtyPical/Analyzer.hs | 9 ++++++--- src/SixtyPical/Checker.hs | 23 ++++++++++++++++------- src/SixtyPical/Emitter.hs | 19 +++++++++++-------- src/SixtyPical/Model.hs | 31 +++++++++++++++++++++---------- src/SixtyPical/Parser.hs | 7 ++++--- 7 files changed, 105 insertions(+), 43 deletions(-) diff --git a/README.markdown b/README.markdown index 0c9d340..c6c6dab 100644 --- a/README.markdown +++ b/README.markdown @@ -90,6 +90,16 @@ poisoned in the result context. (Same should apply for `repeat` and `with` and, really, many other cases which there just aren't enough test cases for yet.) +Declarations can have block scope. Such declarations may only be used within +the block in which they are declared. `reserve`d storage inside a block is not, +however, like a local variable (or `auto` in C); rather, it is more like a +`static` in C, except the value at that address is not guaranteed to be +retained between invokations of the block. This is intended to be used for +temporary storage. In addition, if analysis of the call graph indicates that +two such temporary addresses are never used simultaneously, they may be merged +to the same address. (This is, however, not yet implemented, and may not be +implemented for a while.) + ### "It's a Partial Solution" ### SixtyPical does not attempt to force your typed, abstractly interpreted @@ -121,18 +131,6 @@ For more information, see the docs (which are written in the form of Falderal literate test suites. If you have Falderal installed, you can run the tests with `./test.sh`.) -Ideas ------ - -These aren't implemented yet: - -* Inside a routine, an address may be declared with `temporary`. This is like - `static` in C, except the value at that address is not guaranteed to be - retained between invokations of the routine. Such addresses may only be used - within the routine where they are declared. If analysis indicates that two - temporary addresses are never used simultaneously, they may be merged - to the same address. - Internals --------- diff --git a/doc/Emitting.markdown b/doc/Emitting.markdown index 1671539..def83c6 100644 --- a/doc/Emitting.markdown +++ b/doc/Emitting.markdown @@ -211,3 +211,40 @@ Reserving and assigning byte tables. = .space frequencies 16 = .alias screen 1024 +Temporary storage, in the form of block-local declarations. Note that these +temporaries are not unioned yet, but they could be. + + | routine a { + | reserve byte foo + | reserve word bar + | lda foo + | sta >bar + | } + | routine b { + | reserve byte baz + | reserve word quuz + | lda baz + | sta InternalID -> (Routine, InternalID) -numberRoutineLoops (Routine name outputs instrs) iid = +numberRoutineLoops (Routine name outputs block) iid = let - (instrs', iid') = numberBlockLoops instrs iid + (block', iid') = numberBlockLoops block iid in - ((Routine name outputs instrs'), iid') + ((Routine name outputs block'), iid') -numberBlockLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID) -numberBlockLoops [] iid = ([], iid) -numberBlockLoops (instr:instrs) iid = +numberBlockLoops :: Block -> InternalID -> (Block, InternalID) +numberBlockLoops block iid = + let + (Block decls instrs) = block + (instrs', iid') = numberInstrsLoops instrs iid + block' = Block decls instrs' + in + (block', iid') + +numberInstrsLoops :: [Instruction] -> InternalID -> ([Instruction], InternalID) +numberInstrsLoops [] iid = ([], iid) +numberInstrsLoops (instr:instrs) iid = let (instr', iid') = numberInstruction instr iid - (instrs', iid'') = numberBlockLoops instrs iid' + (instrs', iid'') = numberInstrsLoops instrs iid' in ((instr':instrs'), iid'') diff --git a/src/SixtyPical/Emitter.hs b/src/SixtyPical/Emitter.hs index 43369d2..fa607b0 100644 --- a/src/SixtyPical/Emitter.hs +++ b/src/SixtyPical/Emitter.hs @@ -47,8 +47,11 @@ emitRoutines _ [] = "" emitRoutines p (rout:routs) = emitRoutine p rout ++ "\n" ++ emitRoutines p routs -emitRoutine p r@(Routine name _ instrs) = - name ++ ":\n" ++ emitInstrs p r instrs ++ " rts\n" +emitRoutine p r@(Routine name _ block) = + name ++ ":\n" ++ emitBlock p r block ++ " rts\n" + +emitBlock p r (Block decls instrs) = + emitInstrs p r instrs emitInstrs _ _ [] = "" emitInstrs p r (instr:instrs) = @@ -161,30 +164,30 @@ emitInstr p r (DELTA (NamedLocation st label) (-1)) = "dec " ++ label emitInstr p r (IF iid branch b1 b2) = (show branch) ++ " _label_" ++ (show iid) ++ "\n" ++ - emitInstrs p r b2 ++ + emitBlock p r b2 ++ " jmp _past_" ++ (show iid) ++ "\n" ++ "_label_" ++ (show iid) ++ ":\n" ++ - emitInstrs p r b1 ++ + emitBlock p r b1 ++ "_past_" ++ (show iid) ++ ":" emitInstr p r (REPEAT iid branch blk) = "\n_repeat_" ++ (show iid) ++ ":\n" ++ - emitInstrs p r blk ++ + emitBlock p r blk ++ " " ++ (show branch) ++ " _repeat_" ++ (show iid) emitInstr p r (WITH SEI blk) = "sei\n" ++ - emitInstrs p r blk ++ + emitBlock p r blk ++ " cli" emitInstr p r (WITH (PUSH A) blk) = "pha\n" ++ - emitInstrs p r blk ++ + emitBlock p r blk ++ " pla" emitInstr p r (WITH (PUSH AllFlags) blk) = "php\n" ++ - emitInstrs p r blk ++ + emitBlock p r blk ++ " plp" emitInstr p r (COPYROUTINE src (NamedLocation (Just Vector) dst)) = diff --git a/src/SixtyPical/Model.hs b/src/SixtyPical/Model.hs index b790ff0..86e85e9 100644 --- a/src/SixtyPical/Model.hs +++ b/src/SixtyPical/Model.hs @@ -60,6 +60,9 @@ data WithInstruction = SEI | PUSH StorageLocation deriving (Show, Ord, Eq) +data Block = Block [Decl] [Instruction] + deriving (Show, Ord, Eq) + data Instruction = COPY StorageLocation StorageLocation | CMP StorageLocation StorageLocation | ADD StorageLocation StorageLocation @@ -73,15 +76,15 @@ data Instruction = COPY StorageLocation StorageLocation | JSR RoutineName -- | JSRVECTOR StorageLocation | JMPVECTOR StorageLocation - | IF InternalID Branch [Instruction] [Instruction] - | REPEAT InternalID Branch [Instruction] + | IF InternalID Branch Block Block + | REPEAT InternalID Branch Block | DELTA StorageLocation DataValue - | WITH WithInstruction [Instruction] + | WITH WithInstruction Block | COPYROUTINE RoutineName StorageLocation | NOP deriving (Show, Ord, Eq) -data Routine = Routine RoutineName [StorageLocation] [Instruction] +data Routine = Routine RoutineName [StorageLocation] Block deriving (Show, Ord, Eq) data Program = Program [Decl] [Routine] @@ -129,12 +132,16 @@ routineDeclared routName p = -- -mapBlock :: (Instruction -> Instruction) -> [Instruction] -> [Instruction] -mapBlock = map +mapInstrs :: (Instruction -> Instruction) -> [Instruction] -> [Instruction] +mapInstrs = map + +mapBlock :: (Instruction -> Instruction) -> Block -> Block +mapBlock f (Block decls instrs) = + Block decls (mapInstrs f instrs) mapRoutine :: (Instruction -> Instruction) -> Routine -> Routine -mapRoutine f (Routine name outputs instrs) = - Routine name outputs (mapBlock f instrs) +mapRoutine f (Routine name outputs block) = + Routine name outputs (mapBlock f block) mapRoutines :: (Instruction -> Instruction) -> [Routine] -> [Routine] mapRoutines f [] = [] @@ -147,8 +154,12 @@ mapProgramRoutines f (Program decls routs) = -- -foldBlock :: (Instruction -> a -> a) -> a -> [Instruction] -> a -foldBlock = foldr +foldInstrs :: (Instruction -> a -> a) -> a -> [Instruction] -> a +foldInstrs = foldr + +foldBlock :: (Instruction -> a -> a) -> a -> Block -> a +foldBlock f a (Block decls instrs) = + foldInstrs f a instrs foldRoutine :: (Instruction -> a -> a) -> a -> Routine -> a foldRoutine f a (Routine name outputs instrs) = diff --git a/src/SixtyPical/Parser.hs b/src/SixtyPical/Parser.hs index 683b278..d6c9f5f 100644 --- a/src/SixtyPical/Parser.hs +++ b/src/SixtyPical/Parser.hs @@ -16,7 +16,7 @@ Decl := "reserve" StorageType LocationName [":" Literal] | "external" RoutineName Address. StorageType := "byte" ["[" Literal "]"] | "word" | "vector". Routine := "routine" RoutineName ["outputs" "(" {LocationName} ")"] Block. -Block := "{" {Command} "}". +Block := "{" {Decl} {Command} "}". Command := "if" Branch Block "else" Block | "lda" (LocationName | Immediate) | "ldx" (LocationName | Immediate) @@ -134,14 +134,15 @@ routine_outputs = do location = (try explicit_register <|> named_location) -block :: Parser [Instruction] +block :: Parser Block block = do string "{" nspaces + ds <- many decl cs <- many command string "}" nspaces - return cs + return (Block ds cs) -- -- -- -- -- -- commands -- -- -- -- --