diff options
Diffstat (limited to 'src/interp/g-util.boot')
-rw-r--r-- | src/interp/g-util.boot | 37 |
1 files changed, 36 insertions, 1 deletions
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index e8fe239c..2462e843 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -371,6 +371,39 @@ expandStore ["%store",place,value] == cons? place => ["SETF",place,value] ["SETQ",place,value] +-- non-local control transfer + +$OpenAxiomCatchTag == KEYWORD::OpenAxiomCatchPoint + +expandThrow ['%throw,m,x] == + ['THROW,$OpenAxiomCatchTag, + ['CONS,$OpenAxiomCatchTag, + ['CONS,expandToVMForm m,expandToVMForm x]]] + +++ Subroutine of expandTry. Generate code for domain matching +++ of object `obj' with domain `dom'. +domainMatchCode(dom,obj) == + -- FIXME: Instead of domain equality, we should also consider + -- FIXME: cases of sub-domains, or domain schemes with constraints. + ['domainEqual,dom,['%head,obj]] + +expandTry ['%try,expr,handlers,cleanup] == + g := gensym() -- hold the exception object + ys := [[domainMatchCode(mode,['%tail,g]), + ['%bind,[[var,['%tail,['%tail,g]]]],stmt]] + for [.,var,mode,stmt] in handlers] + handlerBody := + ys = nil => g + ys := [:ys,['%true,['THROW,$OpenAxiomCatchTag,g]]] + ['%when, + [['%and,['%pair?,g], + ['%peq,['%head,g],$OpenAxiomCatchTag]], ['%when,:ys]], + ['%true,g]] + tryBlock := expandBind + ['%bind,[[g,['CATCH,$OpenAxiomCatchTag,expr]]],handlerBody] + cleanup = nil => tryBlock + ['UNWIND_-PROTECT,tryBlock,:expandToVMForm rest cleanup] + ++ Opcodes with direct mapping to target operations. for x in [ -- Boolean constants @@ -523,7 +556,9 @@ for x in [ ['%bind, :function expandBind], ['%store, :function expandStore], - ['%dynval, :function expandDynval] + ['%dynval, :function expandDynval], + ['%throw, :function expandThrow], + ['%try, :function expandTry] ] repeat property(first x,'%Expander) := rest x ++ Return the expander of a middle-end opcode, or nil if there is none. |