[gs-cvs] rev 7513 - trunk/gs/lib

[ray at ghostscript.com]

Author: ray
Date: 2006-12-16 12:41:10 -0800 (Sat, 16 Dec 2006)
New Revision: 7513

Modified:
   trunk/gs/lib/gs_setpd.ps
Log:
Fix setpagedevice /Install procedure handling so that a error from the Install
will restore the previous (presumably correct) Install and apply the Policies
for the error handling. Also fix the .execinstall so that the plumbing will
leave a predictable number of elements on the stack in case of an error.
Bug #689020 for customer #661.

DETAILS:

The .execinstall needed fixing since it could leave one extra element on the
operand stack, but sometimes it would not. The oparray_cleanup of the error
handling _would_ restore the op stack to the point where .execinstall was
invoked, but at that point, the procedure operand was part of the old stack
count. This meant that if the Install procedure pushed something on the op
stack before getting the error, it would be there after the 'stopped', but
if it didn't push anything, the stacks would be the same as if the exec was
OK.

By duplicating the procedure prior to the exec in .execinstall, we insure
that there will always be that value on the stack when stopped returns
'true'. Normal execution doesn't change and will pop the extra value created
by the 'dup'.

EXPECTED DIFFERENCE:

None.


Modified: trunk/gs/lib/gs_setpd.ps
===================================================================
--- trunk/gs/lib/gs_setpd.ps	2006-12-15 18:08:57 UTC (rev 7512)
+++ trunk/gs/lib/gs_setpd.ps	2006-12-16 20:41:10 UTC (rev 7513)
@@ -510,9 +510,9 @@
   } bind
   1 {		% Roll back the failed request to its previous status.
 SETPDDEBUG { (Rolling back.) = pstack flush } if
-	3 index 2 index 3 -1 roll put
+	3 index 2 index 3 -1 roll .forceput
 	4 index 1 index .knownget
-	 { 4 index 3 1 roll put }
+	 { 4 index 3 1 roll .forceput }
 	 { 3 index exch .undef }
 	ifelse
   } bind
@@ -817,7 +817,18 @@
   dup .setpagedevice
   .setdefaulthalftone	% Set the default screen before calling Install.
   dup /Install .knownget {
-    { .execinstall } stopped { .postinstall stop } { .postinstall } ifelse
+    { .execinstall } stopped {
+      pop % Install procedure failed. One element will have been left on the stack.
+      % stack: mark <orig> <request> <failed> <merged>
+      1 index /Install $error /errorname get put	% Put it in the "failed" dict
+      % .applypolicies needs stack: <orig> <merged> <failed>
+      exch 4 2 roll exch 4 2 roll .applypolicies exch 4 2 roll exch 4 2 roll
+      % Now execute the old Install -- failures after this are not handled
+      dup /Install .knownget { { .execinstall } stopped { pop } if } if
+      .postinstall stop
+    } {
+      .postinstall
+    } ifelse
   } {
     .postinstall
   } ifelse
@@ -826,18 +837,21 @@
 % We break out the code after calling the Install procedure into a
 % separate procedure, since it is executed even if Install causes an error.
 % By making .execinstall a separate operator procedure, we get the stacks
-% restored if it fails.
+% mostly restored if it fails, except for one element (the operand).
+% Thus if it fails, there will be one element left on the op stack.
 
 /.execinstall {		% <proc> .execinstall -
+  dup	% element left on the stack if the exec fails.
+
 	% Because the interpreter optimizes tail calls, we can't just let
 	% the body of this procedure be 'exec', because that would lose
 	% the stack protection that is the whole reason for having the
-	% procedure in the first place.  We hack this by adding a couple
-	% of extra tokens to ensure that the operator procedure is still
-	% on the stack during the exec.
+	% procedure in the first place. The 'pop' for the dummy element 
+	% on the op stack suffices.
   exec
-  0 pop	% See above.
+  pop	% See above.
 } odef
+
 /.postinstall {		% mark ... <failed> <merged> .postinstall -
    matrix currentmatrix .setdefaultmatrix
 		% Erase and initialize the page.