From fa8b99969d7a6966c1cd309d41384051599070fb Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Sun, 3 Jul 2016 19:57:27 +0200
Subject: Fix RTS; working example

---
 test.icl | 173 +++++++++++++++++++++++----------------------------------------
 1 file changed, 62 insertions(+), 111 deletions(-)

(limited to 'test.icl')

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
+		  ]
-- 
cgit v1.2.3