Add PROGV instruction

Author: Bike

BIR-builder/builder.lisp

@@ -160,3 +160,5 @@
   (setf (bir:dynamic-environment (first (bir:next inst))) inst))
 (defmethod post ((inst bir:unwind-protect))
   (setf (bir:dynamic-environment (first (bir:next inst))) inst))
+(defmethod post ((inst bir:progvi))
+  (setf (bir:dynamic-environment (first (bir:next inst))) inst))

BIR/instructions.lisp

@@ -198,6 +198,10 @@ See LETI"))
   ()
   (:documentation "Terminator and dynamic environment representing the binding of a dynamic variable. Within this dynamic environment, the symbol has this value (unless there is a more recent binding, of course). The first input is the VARIABLE-CELL being bound, and the second input its new value. No outputs."))
 
+(defclass progvi (dynamic-environment no-output terminator1)
+  ()
+  (:documentation "Terminator and dynamic environment representing the binding of several dynamic variables determined at runtime, as by CL:PROGV. Within this dynamic environment, the symbols have the values or lack thereof (unless there is a more recent binding, of course.) The first input is the list of symbols, and the second input is the list of values. No outputs."))
+
 (defclass unwind (terminator0)
   ((%come-from :initarg :come-from :reader come-from
                :type come-from)

BIR/packages.lisp

@@ -52,7 +52,7 @@
            #:abstract-call #:callee #:call #:local-call
            #:abstract-local-call #:mv-call #:mv-local-call
            #:attributes
-           #:leti #:dynamic-leti #:constant-bind #:enclose #:code
+           #:leti #:dynamic-leti #:constant-bind #:progvi #:enclose #:code
            #:thei #:asserted-type #:type-check-function #:delete-thei)
   (:export #:primop #:info)
   (:export #:do-functions #:map-functions)

BIR/verify.lisp

@@ -242,6 +242,8 @@ If there are problems, a VERIFICATION-FAILED is signaled. If the verification pr
   (let* ((inputs (inputs instruction))
          (constant (first inputs))
          (val (second inputs)))
+    (test (= (length inputs) 2)
+          "has more or less than two inputs ~a" instruction inputs)
     (test (typep constant 'variable-cell)
           "has non-variable-cell input ~a"
           instruction constant)
@@ -254,6 +256,13 @@ If there are problems, a VERIFICATION-FAILED is signaled. If the verification pr
     (check-ubd instruction (list val))
     (check-usedness instruction (list val))))
 
+(defmethod verify-inputs ((instruction progvi))
+  (let ((inputs (inputs instruction)))
+    (test (= (length inputs) 2)
+          "has more or less than two inputs ~a" instruction inputs)
+    (check-ubd instruction inputs)
+    (check-usedness instruction inputs)))
+
 (defmethod verify-inputs ((instruction load-time-value-reference))
   (let* ((inputs (inputs instruction))
          (ltv (first inputs)))