New information in closure dbg blocks to accomodate multiclosures and
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Sat, 21 Apr 1990 16:26:47 +0000 (16:26 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Sat, 21 Apr 1990 16:26:47 +0000 (16:26 +0000)
make the accessors/mutators architecture independent.

v7/src/runtime/infutl.scm
v7/src/runtime/runtime.pkg
v7/src/runtime/udata.scm
v7/src/runtime/uenvir.scm
v8/src/runtime/infutl.scm
v8/src/runtime/runtime.pkg
v8/src/runtime/uenvir.scm

index 0ab0a2b499c712c001d2d11665892283ffd4d6ad..4ca2cc1a09c7b4d088e8c023dd4cd5f6cb24edb8 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.15 1989/11/21 00:00:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infutl.scm,v 1.16 1990/04/21 16:26:26 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -269,28 +269,38 @@ MIT in each case. |#
           (equal? (car x) (car y))
           (directory-prefix? (cdr x) (cdr y)))))
 \f
+(define-integrable (dbg-block/layout-first-offset block)
+  (let ((layout (dbg-block/layout block)))
+    (and (pair? layout) (car layout))))
+
+(define-integrable (dbg-block/layout-vector block)
+  (let ((layout (dbg-block/layout block)))
+    (if (pair? layout)
+       (cdr layout)
+       layout)))
+
 (define (dbg-block/dynamic-link-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/dynamic-link))
 
 (define (dbg-block/ic-parent-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/ic-parent))
 
 (define (dbg-block/normal-closure-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/normal-closure))
 
 (define (dbg-block/return-address-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/return-address))
 
 (define (dbg-block/static-link-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/static-link))
 
 (define (dbg-block/find-name block name)
-  (let ((layout (dbg-block/layout block)))
+  (let ((layout (dbg-block/layout-vector block)))
     (let ((end (vector-length layout)))
       (let loop ((index 0))
        (and (< index end)
index fa9f817f74a8174fb9c56a2d231047cbe573c364..76eb178402b13aa092fe22f0648c0a4631fc6434 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.65 1990/04/12 21:53:41 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.66 1990/04/21 16:26:47 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -234,6 +234,8 @@ MIT in each case. |#
          dbg-block/find-name
          dbg-block/ic-parent-index
          dbg-block/layout
+         dbg-block/layout-first-offset
+         dbg-block/layout-vector
          dbg-block/normal-closure-index
          dbg-block/original-parent
          dbg-block/parent
index a8fbd35664bae7ea8015019291a82ab0a7998300..af1511c2d7b51e8b371619b0dd933dc01ef11d39 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/udata.scm,v 14.11 1989/08/15 13:20:30 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/udata.scm,v 14.12 1990/04/21 16:26:13 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -145,13 +145,26 @@ MIT in each case. |#
        (error "Stack address out of range" address start-offset))
     index))
 
-(define-integrable (compiled-closure/ref closure index)
-  ;; 68020 specific -- must be rewritten in compiler interface.
-  ((ucode-primitive primitive-object-ref 2) closure (+ 2 index)))
-
-(define-integrable (compiled-closure/set! closure index value)
-  ;; 68020 specific -- must be rewritten in compiler interface.
-  ((ucode-primitive primitive-object-set! 3) closure (+ 2 index) value)
+;; In the following two procedures, offset can be #f to support
+;; old-style 68020 closures.  When offset is not #f, it works on all
+;; architectures.
+
+(define (compiled-closure/ref closure index offset)
+  (if (not offset)
+      ((ucode-primitive primitive-object-ref 2) closure (+ 2 index))
+      ((ucode-primitive primitive-object-ref 2)
+       ((ucode-primitive compiled-code-address->block 1)
+       closure)
+       (+ index offset))))
+
+(define-integrable (compiled-closure/set! closure index offset value)
+  (if (not offset)
+      ((ucode-primitive primitive-object-set! 3) closure (+ 2 index) value)
+      ((ucode-primitive primitive-object-set! 3)
+       ((ucode-primitive compiled-code-address->block 1)
+       closure)
+       (+ index offset)
+       value))
   unspecific)
 \f
 ;;;; Compiled Code Blocks
index d7234c8ea480135aa0ab8c542934b1bf462aa448..921e68b5aff0b0c3c853f98196b237725de54cfe 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uenvir.scm,v 14.15 1989/10/27 07:19:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uenvir.scm,v 14.16 1990/04/21 16:25:12 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -286,10 +286,11 @@ MIT in each case. |#
          (let ((parent (dbg-block/parent block)))
            (case (dbg-block/type parent)
              ((STACK)
-              (make-stack-ccenv parent
-                                frame
-                                (+ (dbg-continuation/offset continuation)
-                                   (vector-length (dbg-block/layout block)))))
+              (make-stack-ccenv
+               parent
+               frame
+               (+ (dbg-continuation/offset continuation)
+                  (vector-length (dbg-block/layout-vector block)))))
              ((IC)
               (let ((index (dbg-block/ic-parent-index block)))
                 (if index
@@ -329,7 +330,7 @@ MIT in each case. |#
              (frame (stack-ccenv/frame environment))
              (index
               (+ (stack-ccenv/start-index environment)
-                 (vector-length (dbg-block/layout block)))))
+                 (vector-length (dbg-block/layout-vector block)))))
           (let ((stack-link (dbg-block/stack-link block)))
             (cond ((not stack-link)
                    (with-values
@@ -347,7 +348,8 @@ MIT in each case. |#
                   (else
                    (loop stack-link
                          frame
-                         (+ (vector-length (dbg-block/layout stack-link))
+                         (+ (vector-length
+                             (dbg-block/layout-vector stack-link))
                             (case (dbg-block/type stack-link)
                               ((STACK)
                                0)
@@ -399,7 +401,8 @@ MIT in each case. |#
 (define (stack-ccenv/bound-names environment)
   (map dbg-variable/name
        (list-transform-positive
-          (vector->list (dbg-block/layout (stack-ccenv/block environment)))
+          (vector->list
+           (dbg-block/layout-vector (stack-ccenv/block environment)))
         dbg-variable?)))
 
 (define (stack-ccenv/bound? environment name)
@@ -468,7 +471,7 @@ MIT in each case. |#
   (map dbg-variable/name
        (list-transform-positive
           (vector->list
-           (dbg-block/layout (closure-ccenv/stack-block environment)))
+           (dbg-block/layout-vector (closure-ccenv/stack-block environment)))
         (lambda (variable)
           (and (dbg-variable? variable)
                (closure-ccenv/variable-bound? environment variable))))))
@@ -479,12 +482,12 @@ MIT in each case. |#
       (and index
           (closure-ccenv/variable-bound?
            environment
-           (vector-ref (dbg-block/layout block) index))))))
+           (vector-ref (dbg-block/layout-vector block) index))))))
 
 (define (closure-ccenv/variable-bound? environment variable)
   (or (eq? (dbg-variable/type variable) 'INTEGRATED)
       (vector-find-next-element
-       (dbg-block/layout (closure-ccenv/closure-block environment))
+       (dbg-block/layout-vector (closure-ccenv/closure-block environment))
        variable)))
 
 (define (closure-ccenv/lookup environment name)
@@ -501,9 +504,16 @@ MIT in each case. |#
                        (closure-ccenv/get-value environment)
                        value))
 \f
+(define-integrable (closure/get-value closure closure-block index)
+  (compiled-closure/ref closure
+                       index
+                       (dbg-block/layout-first-offset closure-block)))
+
 (define (closure-ccenv/get-value environment)
   (lambda (index)
-    (compiled-closure/ref (closure-ccenv/closure environment) index)))
+    (closure/get-value (closure-ccenv/closure environment)
+                      (closure-ccenv/closure-block environment)
+                      index)))
 
 (define (closure-ccenv/has-parent? environment)
   (let ((stack-block (closure-ccenv/stack-block environment)))
@@ -530,7 +540,7 @@ MIT in each case. |#
         (guarantee-ic-environment
          (let ((index (dbg-block/ic-parent-index closure-block)))
            (if index
-               (compiled-closure/ref closure index)
+               (closure/get-value closure closure-block index)
                (compiled-code-block/environment
                 (compiled-entry/block closure))))))
        (else
@@ -541,43 +551,43 @@ MIT in each case. |#
 \f
 (define (lookup-dbg-variable block name get-value)
   (let loop ((name name))
-    (let ((index (dbg-block/find-name block name)))
-      (let ((variable (vector-ref (dbg-block/layout block) index)))
-       (case (dbg-variable/type variable)
-         ((NORMAL)
-          (get-value index))
-         ((CELL)
-          (let ((value (get-value index)))
-            (if (not (cell? value))
-                (error "Value of variable should be in cell" variable value))
-            (cell-contents value)))
-         ((INTEGRATED)
-          (dbg-variable/value variable))
-         ((INDIRECTED)
-          (loop (dbg-variable/name (dbg-variable/value variable))))
-         (else
-          (error "Unknown variable type" variable)))))))
+    (let* ((index (dbg-block/find-name block name))
+          (variable (vector-ref (dbg-block/layout-vector block) index)))
+      (case (dbg-variable/type variable)
+       ((NORMAL)
+        (get-value index))
+       ((CELL)
+        (let ((value (get-value index)))
+          (if (not (cell? value))
+              (error "Value of variable should be in cell" variable value))
+          (cell-contents value)))
+       ((INTEGRATED)
+        (dbg-variable/value variable))
+       ((INDIRECTED)
+        (loop (dbg-variable/name (dbg-variable/value variable))))
+       (else
+        (error "Unknown variable type" variable))))))
 
 (define (assignable-dbg-variable? block name)
   (eq? 'CELL
        (dbg-variable/type
-       (vector-ref (dbg-block/layout block)
+       (vector-ref (dbg-block/layout-vector block)
                    (dbg-block/find-name block name)))))
 
 (define (assign-dbg-variable! block name get-value value)
-  (let ((index (dbg-block/find-name block name)))
-    (let ((variable (vector-ref (dbg-block/layout block) index)))
-      (case (dbg-variable/type variable)
-       ((CELL)
-        (let ((cell (get-value index)))
-          (if (not (cell? cell))
-              (error "Value of variable should be in cell" name cell))
-          (set-cell-contents! cell value)
-          unspecific))
-       ((NORMAL INTEGRATED INDIRECTED)
-        (error "Variable cannot be side-effected" variable))
-       (else
-        (error "Unknown variable type" variable))))))
+  (let ((index (dbg-block/find-name block name))       
+       (variable (vector-ref (dbg-block/layout-vector block) index)))
+    (case (dbg-variable/type variable)
+      ((CELL)
+       (let ((cell (get-value index)))
+        (if (not (cell? cell))
+            (error "Value of variable should be in cell" name cell))
+        (set-cell-contents! cell value)
+        unspecific))
+      ((NORMAL INTEGRATED INDIRECTED)
+       (error "Variable cannot be side-effected" variable))
+      (else
+       (error "Unknown variable type" variable)))))
 
 (define (dbg-block/name block)
   (let ((procedure (dbg-block/procedure block)))
index a98a5d1e70dacee878d567735b80bfb75c6718a6..259938c7d9851b1e0059fd2e8b30b961b58c6927 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.15 1989/11/21 00:00:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infutl.scm,v 1.16 1990/04/21 16:26:26 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -269,28 +269,38 @@ MIT in each case. |#
           (equal? (car x) (car y))
           (directory-prefix? (cdr x) (cdr y)))))
 \f
+(define-integrable (dbg-block/layout-first-offset block)
+  (let ((layout (dbg-block/layout block)))
+    (and (pair? layout) (car layout))))
+
+(define-integrable (dbg-block/layout-vector block)
+  (let ((layout (dbg-block/layout block)))
+    (if (pair? layout)
+       (cdr layout)
+       layout)))
+
 (define (dbg-block/dynamic-link-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/dynamic-link))
 
 (define (dbg-block/ic-parent-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/ic-parent))
 
 (define (dbg-block/normal-closure-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/normal-closure))
 
 (define (dbg-block/return-address-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/return-address))
 
 (define (dbg-block/static-link-index block)
-  (vector-find-next-element (dbg-block/layout block)
+  (vector-find-next-element (dbg-block/layout-vector block)
                            dbg-block-name/static-link))
 
 (define (dbg-block/find-name block name)
-  (let ((layout (dbg-block/layout block)))
+  (let ((layout (dbg-block/layout-vector block)))
     (let ((end (vector-length layout)))
       (let loop ((index 0))
        (and (< index end)
index 6f11d52f3026ab5a964dcaa9230951e9d6b17313..3e1f712d159214651a97141333cd7a90837ea5a8 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.65 1990/04/12 21:53:41 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.66 1990/04/21 16:26:47 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -234,6 +234,8 @@ MIT in each case. |#
          dbg-block/find-name
          dbg-block/ic-parent-index
          dbg-block/layout
+         dbg-block/layout-first-offset
+         dbg-block/layout-vector
          dbg-block/normal-closure-index
          dbg-block/original-parent
          dbg-block/parent
index 9c5eaa5d833bdde19a7df8c43661b6c92b43b6b2..faeaee161e500d163ca187716e05574ccad6f15a 100644 (file)
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/uenvir.scm,v 14.15 1989/10/27 07:19:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/uenvir.scm,v 14.16 1990/04/21 16:25:12 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -286,10 +286,11 @@ MIT in each case. |#
          (let ((parent (dbg-block/parent block)))
            (case (dbg-block/type parent)
              ((STACK)
-              (make-stack-ccenv parent
-                                frame
-                                (+ (dbg-continuation/offset continuation)
-                                   (vector-length (dbg-block/layout block)))))
+              (make-stack-ccenv
+               parent
+               frame
+               (+ (dbg-continuation/offset continuation)
+                  (vector-length (dbg-block/layout-vector block)))))
              ((IC)
               (let ((index (dbg-block/ic-parent-index block)))
                 (if index
@@ -329,7 +330,7 @@ MIT in each case. |#
              (frame (stack-ccenv/frame environment))
              (index
               (+ (stack-ccenv/start-index environment)
-                 (vector-length (dbg-block/layout block)))))
+                 (vector-length (dbg-block/layout-vector block)))))
           (let ((stack-link (dbg-block/stack-link block)))
             (cond ((not stack-link)
                    (with-values
@@ -347,7 +348,8 @@ MIT in each case. |#
                   (else
                    (loop stack-link
                          frame
-                         (+ (vector-length (dbg-block/layout stack-link))
+                         (+ (vector-length
+                             (dbg-block/layout-vector stack-link))
                             (case (dbg-block/type stack-link)
                               ((STACK)
                                0)
@@ -399,7 +401,8 @@ MIT in each case. |#
 (define (stack-ccenv/bound-names environment)
   (map dbg-variable/name
        (list-transform-positive
-          (vector->list (dbg-block/layout (stack-ccenv/block environment)))
+          (vector->list
+           (dbg-block/layout-vector (stack-ccenv/block environment)))
         dbg-variable?)))
 
 (define (stack-ccenv/bound? environment name)
@@ -468,7 +471,7 @@ MIT in each case. |#
   (map dbg-variable/name
        (list-transform-positive
           (vector->list
-           (dbg-block/layout (closure-ccenv/stack-block environment)))
+           (dbg-block/layout-vector (closure-ccenv/stack-block environment)))
         (lambda (variable)
           (and (dbg-variable? variable)
                (closure-ccenv/variable-bound? environment variable))))))
@@ -479,12 +482,12 @@ MIT in each case. |#
       (and index
           (closure-ccenv/variable-bound?
            environment
-           (vector-ref (dbg-block/layout block) index))))))
+           (vector-ref (dbg-block/layout-vector block) index))))))
 
 (define (closure-ccenv/variable-bound? environment variable)
   (or (eq? (dbg-variable/type variable) 'INTEGRATED)
       (vector-find-next-element
-       (dbg-block/layout (closure-ccenv/closure-block environment))
+       (dbg-block/layout-vector (closure-ccenv/closure-block environment))
        variable)))
 
 (define (closure-ccenv/lookup environment name)
@@ -501,9 +504,16 @@ MIT in each case. |#
                        (closure-ccenv/get-value environment)
                        value))
 \f
+(define-integrable (closure/get-value closure closure-block index)
+  (compiled-closure/ref closure
+                       index
+                       (dbg-block/layout-first-offset closure-block)))
+
 (define (closure-ccenv/get-value environment)
   (lambda (index)
-    (compiled-closure/ref (closure-ccenv/closure environment) index)))
+    (closure/get-value (closure-ccenv/closure environment)
+                      (closure-ccenv/closure-block environment)
+                      index)))
 
 (define (closure-ccenv/has-parent? environment)
   (let ((stack-block (closure-ccenv/stack-block environment)))
@@ -530,7 +540,7 @@ MIT in each case. |#
         (guarantee-ic-environment
          (let ((index (dbg-block/ic-parent-index closure-block)))
            (if index
-               (compiled-closure/ref closure index)
+               (closure/get-value closure closure-block index)
                (compiled-code-block/environment
                 (compiled-entry/block closure))))))
        (else
@@ -541,43 +551,43 @@ MIT in each case. |#
 \f
 (define (lookup-dbg-variable block name get-value)
   (let loop ((name name))
-    (let ((index (dbg-block/find-name block name)))
-      (let ((variable (vector-ref (dbg-block/layout block) index)))
-       (case (dbg-variable/type variable)
-         ((NORMAL)
-          (get-value index))
-         ((CELL)
-          (let ((value (get-value index)))
-            (if (not (cell? value))
-                (error "Value of variable should be in cell" variable value))
-            (cell-contents value)))
-         ((INTEGRATED)
-          (dbg-variable/value variable))
-         ((INDIRECTED)
-          (loop (dbg-variable/name (dbg-variable/value variable))))
-         (else
-          (error "Unknown variable type" variable)))))))
+    (let* ((index (dbg-block/find-name block name))
+          (variable (vector-ref (dbg-block/layout-vector block) index)))
+      (case (dbg-variable/type variable)
+       ((NORMAL)
+        (get-value index))
+       ((CELL)
+        (let ((value (get-value index)))
+          (if (not (cell? value))
+              (error "Value of variable should be in cell" variable value))
+          (cell-contents value)))
+       ((INTEGRATED)
+        (dbg-variable/value variable))
+       ((INDIRECTED)
+        (loop (dbg-variable/name (dbg-variable/value variable))))
+       (else
+        (error "Unknown variable type" variable))))))
 
 (define (assignable-dbg-variable? block name)
   (eq? 'CELL
        (dbg-variable/type
-       (vector-ref (dbg-block/layout block)
+       (vector-ref (dbg-block/layout-vector block)
                    (dbg-block/find-name block name)))))
 
 (define (assign-dbg-variable! block name get-value value)
-  (let ((index (dbg-block/find-name block name)))
-    (let ((variable (vector-ref (dbg-block/layout block) index)))
-      (case (dbg-variable/type variable)
-       ((CELL)
-        (let ((cell (get-value index)))
-          (if (not (cell? cell))
-              (error "Value of variable should be in cell" name cell))
-          (set-cell-contents! cell value)
-          unspecific))
-       ((NORMAL INTEGRATED INDIRECTED)
-        (error "Variable cannot be side-effected" variable))
-       (else
-        (error "Unknown variable type" variable))))))
+  (let ((index (dbg-block/find-name block name))       
+       (variable (vector-ref (dbg-block/layout-vector block) index)))
+    (case (dbg-variable/type variable)
+      ((CELL)
+       (let ((cell (get-value index)))
+        (if (not (cell? cell))
+            (error "Value of variable should be in cell" name cell))
+        (set-cell-contents! cell value)
+        unspecific))
+      ((NORMAL INTEGRATED INDIRECTED)
+       (error "Variable cannot be side-effected" variable))
+      (else
+       (error "Unknown variable type" variable)))))
 
 (define (dbg-block/name block)
   (let ((procedure (dbg-block/procedure block)))