diff options
| -rw-r--r-- | ABC/Assembler.icl | 8 | ||||
| -rw-r--r-- | ABC/Code/RTS.icl | 5 | ||||
| -rw-r--r-- | ABC/Driver.icl | 3 | ||||
| -rw-r--r-- | test.icl | 173 |
4 files changed, 70 insertions, 119 deletions
diff --git a/ABC/Assembler.icl b/ABC/Assembler.icl index 9de0708..e5e3a9a 100644 --- a/ABC/Assembler.icl +++ b/ABC/Assembler.icl @@ -29,12 +29,12 @@ where collect :: Assembler Int Int -> SymTable collect [] _ _ = [] -collect [Label l :r] lc dc = [(l,lc,LabSym) :collect r lc dc] -collect [Descriptor dl rl _ _:r] lc dc = [(dl,dc,DescSym):collect r lc (dc+1)] -collect [_ :r] lc dc = collect r (lc+1) dc +collect [Label l :r] lc dc = [(l,lc,LabSym) :collect r lc dc] +collect [Descriptor dl _ _ _:r] lc dc = [(dl,dc,DescSym):collect r lc (dc+1)] +collect [_ :r] lc dc = collect r (lc+1) dc lookup :: Label SymType SymTable -> Int -lookup l t [] = abortn ("label " <+ l <+ " not defined as " <+ t) +lookup l t [] = abortn (l <+ " not defined as " <+ t) lookup l t [(name,n,type):r] | l == name && t == type = n | otherwise = lookup l t r diff --git a/ABC/Code/RTS.icl b/ABC/Code/RTS.icl index f28f4d8..89032f3 100644 --- a/ABC/Code/RTS.icl +++ b/ABC/Code/RTS.icl @@ -7,6 +7,8 @@ rts = [ Descriptor "INT" "_rnf" 0 "integer" , Descriptor "BOOL" "_rnf" 0 "boolean" , Jmp "init_graph" + , Label "_rnf" + , Rtn , Label "init_graph" , Create , Fill "Start" 0 "n_Start" 0 @@ -31,6 +33,7 @@ rts , DecI , Jmp "_brackets" , Label "_exit" + , Pop_b 1 , Rtn , Label "_args" , Print "(" @@ -49,8 +52,6 @@ rts , Jsr "_driver" , DecI , Jmp "_arg_loop" - , Label "_rnf" - , Rtn , Label "_cycle" , Print "cycle in spine\n" , Halt diff --git a/ABC/Driver.icl b/ABC/Driver.icl index aa89ae1..633d248 100644 --- a/ABC/Driver.icl +++ b/ABC/Driver.icl @@ -1,6 +1,6 @@ implementation module ABC.Driver -import StdEnv, StdDebug +import StdEnv import ABC.Machine @@ -18,7 +18,6 @@ boot (prog,descs) fetch_cycle :: State -> State fetch_cycle st=:{pc,program} -//# pc = trace_n pc pc | pc_end pc = st | otherwise = fetch_cycle (currinstr {st & pc=pc`}) where @@ -3,6 +3,7 @@ module test import StdEnv import ABC.Machine +import ABC.Code Start = toString end.io where @@ -10,67 +11,15 @@ where state = boot (prog,descs) end = fetch_cycle state -rts :: Assembler -rts - = [ Descriptor "INT" "_rnf" 0 "integer" - , Descriptor "BOOL" "_rnf" 0 "boolean" - , Jmp "init_graph" - , Label "init_graph" - , Create - , Fill "Start" 0 "n_Start" 0 - , Jsr "_driver" - , Print "\n" - , Halt - , Label "_driver" - , PushI 0 - , Label "_print" - , JsrEval - , GetNodeArity 0 - , EqI_b 0 0 - , JmpFalse "_args" - , Label "_print_last" - , PrintSymbol 0 - , Pop_a 1 - , Pop_b 1 - , Label "_brackets" - , EqI_b 0 0 - , JmpTrue "_exit" - , Print ")" - , DecI - , Jmp "_brackets" - , Label "_exit" - , Rtn - , Label "_args" - , Print "(" - , PrintSymbol 0 - , GetDescArity 0 - , ReplArgs_b - , Pop_b 1 - , Label "_arg_loop" - , Print " " - , EqI_b 1 0 - , JmpFalse "_next_arg" - , Pop_b 1 - , IncI - , Jmp "_print" - , Label "_next_arg" - , Jsr "_driver" - , DecI - , Jmp "_arg_loop" - , Label "_rnf" - , Rtn - , Label "_cycle" - , Print "cycle in spine\n" - , Halt - , Label "_type_error" - , Print "type error\n" - , Halt - ] - ints :: Assembler ints = [ Label "+I1" - , IncI + , PushI_a 0 + , PushI_a 1 + , AddI + , Pop_a 1 + , FillI_b 0 0 + , Pop_b 1 , Rtn ] @@ -85,64 +34,66 @@ length = rts ++ list ++ ints ++ - [ Descriptor "Length" "a_Length" 2 "Length" + [ Descriptor "Length" "a_Length" 2 "Length" - , Label "n_Length" - , SetEntry "_cycle" 0 - , PushArgs 0 2 2 + , Label "n_Length" + , SetEntry "_cycle" 0 + , PushArgs 0 2 2 - , Label "a_Length" - , Push_a 1 - , JsrEval - , Pop_a 1 + , Label "a_Length" + , Push_a 1 + , JsrEval + , Pop_a 1 - , Label "Length1" - , EqDescArity "Cons" 2 1 - , JmpFalse "Length2" - , PushArgs 1 2 2 - , Push_a 1 - , JsrEval - , Create - , Create - , FillI 1 0 - , Push_a 5 - , Jsr "+I1" - , Update_a 1 5 - , Update_a 0 4 - , Pop_a 4 - , Jmp "Length1" + , Label "Length1" + , EqDescArity "Cons" 2 1 + , JmpFalse "Length2" + , PushArgs 1 2 2 + , Push_a 1 + , JsrEval + , Create + , FillI 1 0 + , Push_a 4 + , Jsr "+I1" + , Update_a 1 5 + , Update_a 0 4 + , Pop_a 4 + , Jmp "Length1" - , Label "Length2" - , EqDescArity "Nil" 0 1 - , JmpFalse "Length3" - , Fill_a 0 2 - , Pop_a 2 - , Rtn + , Label "Length2" + , EqDescArity "Nil" 0 1 + , JmpFalse "Length3" + , Fill_a 0 2 + , Pop_a 2 + , Rtn - , Label "Length3" - , Jmp "_type_error" + , Label "Length3" + , Jmp "_type_error" - , Descriptor "Start" "n_Start" 0 "Start" - , Label "n_Start" - , Create - , Create - , Create - , Fill "Nil" 0 "_rnf" 0 - , Create - , FillI 1 0 - , Fill "Cons" 2 "_rnf" 2 - , Fill "Length" 1 "n_Length" 1 - //, Jmp "_driver" - , Dump "" - , Halt + , Descriptor "Start" "n_Start" 0 "Start" + , Label "n_Start" + , Create + , Create + , Create + , Create + , Fill "Nil" 0 "_rnf" 1 + , FillI 5 0 + , Fill "Cons" 2 "_rnf" 2 + , Create + , FillI 3 0 + , Fill "Cons" 2 "_rnf" 2 + , Create + ] ++ show_list ++ + [ JsrEval + , Rtn ] +where + show_length + = [ FillI 0 0 + , Fill "Length" 2 "n_Length" 2 + ] -cons_1_nil :: Assembler // p. 45, doesn't work (Nil/Cons no descriptors) -cons_1_nil - = [ Create - , Create - , Fill "Nil" 0 "_rnf" 0 - , Create - , FillI 1 0 - , Fill "Cons" 2 "_rnf" 2 - ] + show_list + = [ FillI 2 0 + , Fill "Cons" 2 "_rnf" 2 + ] |