(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "26-Sep-88 14:46:20" {POOH/N}<POOH>VANMELLE>LISP>UNWINDUFN;1
 2152   

      changes to%:  (FNS \UNWIND.UFN)

      previous date%: "26-Sep-88 13:06:15" {POOH/N}<POOH>VANMELLE>ERIS>LISP>UNWINDUFN;1)


(* "
Copyright (c) 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT UNWINDUFNCOMS)

(RPAQQ UNWINDUFNCOMS ((FNS \UNWIND.UFN)))
(DEFINEQ

(\UNWIND.UFN

(LAMBDA (N.KEEP) (* ; "Edited 26-Sep-88 14:45 by bvm") (* ;;; "UFN for UNWIND opcode.  The two bytes are the desired stack depth to unwind to and a flag indicating whether to push TOS when done") (LET* ((CALLER (\MYALINK)) (NEXT (fetch (FX NEXTBLOCK) of CALLER)) (SP (- NEXT WORDSPERCELL)) (DESIREDSP (+ (- (fetch (FX FIRSTPVAR) of CALLER) WORDSPERCELL) (UNFOLD (LRSH N.KEEP 8) WORDSPERCELL))) (PUSHP (NEQ (LOGAND N.KEEP 255) 0)) OLDTOS) (if (> DESIREDSP SP) then (RAID "Stack for UNWIND is already shallower than desired depth by (words)" (- DESIREDSP SP)) else (COND (PUSHP (* ; "Save old top of stack") (SETQ OLDTOS (\GETBASEPTR (STACKADDBASE SP) 0)) (* ; "And we don't have to look at it further") (SETQ SP (- SP WORDSPERCELL)))) (UNINTERRUPTABLY (while (GREATERP SP DESIREDSP) bind (PVAR0BASE ← (STACKADDBASE (fetch (FX FIRSTPVAR) of CALLER))) do (if (fetch BINDMARKP of (STACKADDBASE SP)) then (* ; "Unbind stuff.  Bind mark says how many pvars were bound, and gives the offset of the last of them") (LET ((LASTPVAR (fetch BINDLASTPVAR of (STACKADDBASE SP)))) (to (fetch BINDNVALUES of (STACKADDBASE SP)) do (\PUTBASE PVAR0BASE LASTPVAR 65535) (SETQ LASTPVAR (- LASTPVAR WORDSPERCELL))))) (SETQ SP (- SP WORDSPERCELL))) (replace (FX NEXTBLOCK) of CALLER with (add DESIREDSP WORDSPERCELL)) (\MAKEFREEBLOCK DESIREDSP (- NEXT DESIREDSP)) (COND ((NOT PUSHP) (* ; "Keep return value from being pushed") (replace (FX NOPUSH) of CALLER with T))) (* ;; "Now explicitly slow return to caller, since we have violated the fast return assumptions by blowing away stack between here and there") (\SLOWRETURN) OLDTOS))))
)
)
(PUTPROPS UNWINDUFN COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (428 2071 (\UNWIND.UFN 438 . 2069)))))
STOP