diff --git a/src/c/interpreter.d b/src/c/interpreter.d
index 412331779..c7dd1156f 100644
--- a/src/c/interpreter.d
+++ b/src/c/interpreter.d
@@ -1154,22 +1154,13 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
 	CASE(OP_PROGV); {
 		cl_object values = reg0;
 		cl_object vars = ECL_STACK_POP_UNSAFE(the_env);
-		cl_index n;
-		for (n = 0; !ecl_endp(vars); n++, vars = ECL_CONS_CDR(vars)) {
-			cl_object var = ECL_CONS_CAR(vars);
-			if (values == Cnil) {
-				ecl_bds_bind(the_env, var, OBJNULL);
-			} else {
-				ecl_bds_bind(the_env, var, cl_car(values));
-				values = ECL_CONS_CDR(values);
-			}
-		}
+		cl_index n = ecl_progv(the_env, vars, values);
 		ECL_STACK_PUSH(the_env, MAKE_FIXNUM(n));
 		THREAD_NEXT;
 	}
 	CASE(OP_EXIT_PROGV); {
 		cl_index n = fix(ECL_STACK_POP_UNSAFE(the_env));
-		ecl_bds_unwind_n(the_env, n);
+		ecl_bds_unwind(the_env, n);
 		THREAD_NEXT;
 	}
 
diff --git a/src/c/stacks.d b/src/c/stacks.d
index ce01299eb..e14d52fd3 100644
--- a/src/c/stacks.d
+++ b/src/c/stacks.d
@@ -227,6 +227,29 @@ ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index)
 	env->bds_top = new_bds_top;
 }
 
+cl_index
+ecl_progv(cl_env_ptr env, cl_object vars0, cl_object values0)
+{
+        cl_object vars = vars0, values = values0;
+        cl_index n = env->bds_top - env->bds_org;
+        for (; LISTP(vars) && LISTP(values); vars = ECL_CONS_CDR(vars)) {
+                if (Null(vars)) {
+                        return n;
+                } else {
+                        cl_object var = ECL_CONS_CAR(vars);
+                        if (Null(values)) {
+                                ecl_bds_bind(env, var, OBJNULL);
+                        } else {
+                                ecl_bds_bind(env, var, ECL_CONS_CAR(values));
+                                values = ECL_CONS_CDR(values);
+                        }
+                }
+        }
+        FEerror("Wrong arguments to special form PROGV. Either~%"
+                "~A~%or~%~A~%are not proper lists",
+                2, vars0, values0);
+}
+
 static bds_ptr
 get_bds_ptr(cl_object x)
 {
diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp
index 661edd8cd..1fd075650 100644
--- a/src/cmp/cmpvar.lsp
+++ b/src/cmp/cmpvar.lsp
@@ -329,34 +329,19 @@
     (make-c1form* 'PROGV :type (c1form-type forms)
 		  :args symbols values forms)))
 
-(defun c2progv (symbols values body
-                &aux (*unwind-exit* *unwind-exit*))
+(defun c2progv (symbols values body)
   (let* ((*lcl* *lcl*)
          (lcl (next-lcl))
          (sym-loc (make-lcl-var))
-         (val-loc (make-lcl-var)))
-    (wt-nl "{cl_object " sym-loc "," val-loc ";")
-    (wt-nl "cl_index " lcl " = cl_env_copy->bds_top - cl_env_copy->bds_org;")
-    (push lcl *unwind-exit*)
-    
+         (val-loc (make-lcl-var))
+         (*unwind-exit* (cons lcl *unwind-exit*)))
+    (wt-nl "{cl_object " sym-loc "," val-loc "; cl_index " lcl ";")
     (let ((*destination* sym-loc)) (c2expr* symbols))
-    
     (let ((*destination* val-loc)) (c2expr* values))
-    
-    (wt-nl "while(!ecl_endp(" sym-loc ")) {")
-    (when (safe-compile)
-      (wt-nl "if(type_of(CAR(" sym-loc "))!=t_symbol)")
-      (wt-nl
-       "FEinvalid_variable(\"~s is not a symbol.\",CAR(" sym-loc "));"))
-    (wt-nl "if(ecl_endp(" val-loc "))ecl_bds_bind(cl_env_copy,CAR(" sym-loc "),OBJNULL);")
-    (wt-nl "else{ecl_bds_bind(cl_env_copy,CAR(" sym-loc "),CAR(" val-loc "));")
-    (wt-nl val-loc "=CDR(" val-loc ");}")
-    (wt-nl sym-loc "=CDR(" sym-loc ");}")
-
+    (wt-nl lcl "= ecl_progv(cl_env_copy," sym-loc "," val-loc ");")
     (c2expr body)
     (wt "}")
-    )
-  )
+    ))
 
 (defun c1psetq (old-args &aux (args nil) (use-psetf nil))
   (do (var (l old-args (cddr l)))
diff --git a/src/h/external.h b/src/h/external.h
index a6673927b..c9b48d540 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -1417,6 +1417,7 @@ extern ECL_API cl_object si_set_limit(cl_object type, cl_object size);
 extern ECL_API cl_object si_get_limit(cl_object type);
 
 extern ECL_API void ecl_bds_overflow(void) /*__attribute__((noreturn))*/;
+extern ECL_API cl_index ecl_progv(cl_env_ptr env, cl_object vars, cl_object values);
 extern ECL_API void ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index);
 extern ECL_API void ecl_unwind(cl_env_ptr env, ecl_frame_ptr fr) /*__attribute__((noreturn))*/;
 extern ECL_API ecl_frame_ptr frs_sch(cl_object frame_id);