aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ABC/Assembler.icl8
-rw-r--r--ABC/Code/RTS.icl5
-rw-r--r--ABC/Driver.icl3
-rw-r--r--test.icl173
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
diff --git a/test.icl b/test.icl
index 21431bf..7d6068f 100644
--- a/test.icl
+++ b/test.icl
@@ -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
+ ]