aboutsummaryrefslogtreecommitdiff
path: root/snug-clean
diff options
context:
space:
mode:
Diffstat (limited to 'snug-clean')
-rw-r--r--snug-clean/src/Snug/Compile.icl1
-rw-r--r--snug-clean/src/Snug/Compile/Simulate.icl11
2 files changed, 10 insertions, 2 deletions
diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl
index dcbc5ad..1bb7ff7 100644
--- a/snug-clean/src/Snug/Compile.icl
+++ b/snug-clean/src/Snug/Compile.icl
@@ -204,6 +204,7 @@ where
simulator _ _ _ _ = // TODO
pushBasicValue (BVInt 0) >>|
buildCons (constructorLabel "" "INT") 1
+// = BasicValue !BasicValue
// | Symbol !SymbolIdent
// | Constructor !ConstructorIdent
// | Case !Expression ![CaseAlternative]
diff --git a/snug-clean/src/Snug/Compile/Simulate.icl b/snug-clean/src/Snug/Compile/Simulate.icl
index af72277..b443913 100644
--- a/snug-clean/src/Snug/Compile/Simulate.icl
+++ b/snug-clean/src/Snug/Compile/Simulate.icl
@@ -130,14 +130,21 @@ indirectAndEval =
, StoreWord TempImm 0 FrontEvalPtr
] >>|
storeStackValue sv 4 FrontEvalPtr >>|
+ getState >>= \{hp_offset} ->
add
// Evaluate
[ AddImmediate Signed FrontEvalPtr HeapPtr (Immediate offset)
, Jump NoLink (Direct (Address 0 "eval"))
- ] >>|
+ , AddImmediate Signed HeapPtr HeapPtr (Immediate hp_offset)
+ ]
+ SVIndirect 4 FrontEvalPtr ->
+ // We only need to overwrite the descriptor with an indirection
getState >>= \{hp_offset} ->
add
- [ AddImmediate Signed HeapPtr HeapPtr (Immediate hp_offset)
+ [ LoadAddress TempImm (Address 0 (functionLabel "" NodeEntry "indir"))
+ , StoreWord TempImm 0 FrontEvalPtr
+ , Jump NoLink (Direct (Address 0 "eval"))
+ , AddImmediate Signed HeapPtr HeapPtr (Immediate hp_offset)
]
_ ->
fail "unexpected top of stack in indirect\n"