Changeset 7851

Timestamp:

11/05/05 15:06:37 (3 years ago)

Author:

autrijus

Message:

* Repair PIR codegen; use "new .Continuation" instead of

the old style "newsub" op. Suggested by Leo.

Location:

src

Files:

• Emit/PIR.hs (modified) (3 diffs)
• Pugs/CodeGen/PIR.hs (modified) (2 diffs)

src/Emit/PIR.hs

@@ -87 +87 @@
     = PerlScalar | PerlArray | PerlHash
     | PerlInt | PerlPair | PerlRef | PerlEnv
+    | Closure | Continuation
     | BareType String
     deriving (Show, Eq, Typeable)
@@ -587 +588 @@
                 -> PrimName    -- ^ PIR opcode to use for branching
                 -> Decl        -- ^ Final declaration of the sub
-stmtControlCond name comp = sub ("&statement_control:" ++ name) [arg0, arg1, arg2] (
-    [ "newsub" .- [funPMC, bare ".Continuation", bare postL]
-    , comp .- [arg0, bare altL]
-    ] ++ callThunkCC arg1 ++
-    [ InsLabel altL
-    ] ++ callThunkCC arg2 ++ collectCC postL) --> [tempPMC]
+stmtControlCond name comp =
+    sub ("&statement_control:" ++ name) [arg0, arg1, arg2] body --> [tempPMC]
     where
     altL = ("sc_" ++ name ++ "_alt")
     postL = ("sc_" ++ name ++ "_post")
+    body = concat
+        [ newCont postL
+        , [ comp .- [arg0, bare altL] ]
+        , callThunkCC arg1
+        , [ InsLabel altL ]
+        , callThunkCC arg2,
+        collectCC postL
+        ]
+
+newCont :: VarName -> [Ins]
+newCont label =
+    [ InsNew funPMC Continuation
+    , "set_addr" .- [funPMC, bare label]
+    ]
 
 {-| Creates appropriate @&infix:foo@ subs for logical operators (@||@, @&&@,
@@ -602 +613 @@
            -> PrimName         -- ^ PIR opcode to use (@if@, @unless@)
            -> Decl             -- ^ Final declaration of the sub
-op2Logical name comp = sub ("&infix:" ++ name) [arg0, arg1] (
-    [ "newsub" .- [funPMC, bare ".Continuation", bare postL]
-    , comp .- [arg0, bare altL]
-    , "set_returns" .- retSigList [arg0]
-    , "returncc" .- []
-    , InsLabel altL
-    ] ++ callThunkCC arg1 ++ collectCC postL) --> [tempPMC]
+op2Logical name comp = sub ("&infix:" ++ name) [arg0, arg1] body --> [tempPMC]
     where
     altL = ("sc_" ++ escaped name ++ "_alt")
     postL = ("sc_" ++ escaped name ++ "_post")
+    body = newCont postL ++
+        [ comp .- [arg0, bare altL]
+        , "set_returns" .- retSigList [arg0]
+        , "returncc" .- []
+        , InsLabel altL
+        ] ++ callThunkCC arg1 ++ collectCC postL
 
 {-| Escapes characters which have a special meaning in PIR. -}

src/Pugs/CodeGen/PIR.hs

@@ -89 +89 @@
         [begL, sndL, retL, endL] <- genLabel ["thunkBegin", "thunkAgain", "thunkReturn", "thunkEnd"]
         this    <- genPMC "block"
-        tellIns $ "newsub" .- [reg this, bare ".Continuation", bare begL]
+        tellIns $ InsNew (reg this) Continuation
+        tellIns $ "set_addr" .- [reg this, bare begL]
         tellIns $ "goto" .- [bare endL]
         tellLabel begL
@@ -109 +110 @@
         [begL, endL] <- genLabel ["blockBegin", "blockEnd"]
         this    <- genPMC "block"
-        tellIns $ "newsub" .- [reg this, bare ".Closure", bare begL]
+        tellIns $ InsNew (reg this) Closure
+        tellIns $ "set_addr" .- [reg this, bare begL]
         tellIns $ "goto" .- [bare endL]
         tellLabel begL