@@ -84,6 +84,9 @@ catom (CL l) = reg (LVar l)
8484catom (CC (I i)) = "MKINT(" ++ show i ++ ")"
8585catom (CC v) = "const(" ++ show v ++ ")"
8686catom (CP n) = cname n
87+
88+off o (CL i) = CL (i + o)
89+off o x = x
8790
8891assignCon i r tag args
8992 = indent i ++ reg r ++ " = MKCON(" ++ show tag ++ ", " ++
@@ -97,17 +100,22 @@ assignCon i r tag args
97100
98101assignFn i r f args
99102 = indent i ++ "EXTEND(" ++ show (length args) ++ ");\n" ++
100− indent i ++ setArgs 1 (reverse args) ++ "\n"
101− -- indent i ++ "CALL(" ++ reg r ++ ", " ++ cname f ++ ");\n"
103+ indent i ++ setArgs 1 (map (off (length args)) (reverse args)) ++ "\n" ++
104+ indent i ++ cname f ++ "(vm);\n" ++
105+ indent i ++ "CLEAR(" ++ show (length args) ++ ");\n" ++
106+ case r of
107+ RVal -> ""
108+ r -> indent i ++ reg r ++ " = " ++ reg RVal ++ "\n"
102109 where
103110 setArgs i [] = ""
104111 setArgs i (a : as) = reg (LVar i) ++ " = " ++ catom a ++ "; "
105112 ++ setArgs (i + 1) as
106113
107−tailCall i d f args
114+doTailCall i d f args
108115 = indent i ++ "EXTEND(" ++ show (length args) ++ ");\n" ++
109− indent i ++ setArgs 1 (reverse args) ++ "\n"
110−-- indent i ++ "TAILCALL(" ++ show d ++ ", " ++ cname f ++ ");\n"
116+ indent i ++ setArgs 1 (map (off (length args)) (reverse args)) ++ "\n" ++
117+ indent i ++ "SLIDE(" ++ show d ++ ", " ++ show (length args) ++ ");\n" ++
118+ indent i ++ cname f ++ "(vm); return;\n"
111119 where
112120 setArgs i [] = ""
113121 setArgs i (a : as) = reg (LVar i) ++ " = " ++ catom a ++ "; "
@@ -116,7 +124,7 @@ tailCall i d f args
116124cg :: Int -> CInst -> String
117125cg i (ASSIGN r (CCon t args))
118126 = assignCon i r t args
119−cg i (ASSIGN r (CApp f args))
127+cg i (ASSIGN r (CExactApp f args))
120128 = assignFn i r f args
121129cg i (ASSIGN r (CAtom e)) = indent i ++ reg r ++ " = " ++ catom e ++ ";\n"
122130cg i (RESERVE s) = indent i ++ "EXTEND(" ++ show s ++ ");\n"
@@ -137,7 +145,7 @@ cg i (SWITCH v bs def)
137145 branch (t, c) = indent i ++ "case " ++ show t ++ ":\n" ++
138146 concatMap (cg (i+1)) c ++
139147 indent (i+1) ++ "break;\n"
140−cg i (TAILCALL d f args) = tailCall i d f args
148+cg i (TAILCALLEXACT d f args) = doTailCall i d f args
141149cg i (ERROR s) = indent i ++ "ERROR(" ++ show s ++ ")\n";
142150cg i _ = indent i ++ "NOT DONE;\n"
143151