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

(FILECREATED "13-Oct-88 09:45:34" {ERIS}<LISPCORE>PATCHES>SOURCES>AR-10888-PATCH.\;1
 3618   

      |changes| |to:|  (FNS \\UNWIND.UFN)
                       (VARS AR-10888-PATCHCOMS)

      |previous| |date:| "12-Oct-88 16:30:51" {ERIS}<LISPCORE>PATCHES>LIBRARY>AR-10888-PATCH.\;1)


(PRETTYCOMPRINT AR-10888-PATCHCOMS)

(RPAQQ AR-10888-PATCHCOMS
 (
                               (* |;;| 

                             "Patch file AR-10888-PATCH.  Contains fixes for the AR(s) (10888).")


                               (ADDVARS (*FEATURES* :AR-10888))
                               (FILES TEDITWINDOW)
                               (FNS \\UNWIND.UFN)))



(* |;;| "Patch file AR-10888-PATCH.  Contains fixes for the AR(s) (10888).")



(ADDTOVAR *FEATURES*
 :AR-10888)

(FILESLOAD TEDITWINDOW)
(DEFINEQ

(\\UNWIND.UFN

  (LAMBDA (N.KEEP)
                                       (* \; "Edited 27-Sep-88 11:48 by jds")


(* |;;;| "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)
           (DESIREDSP (IPLUS (IDIFFERENCE (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
                                    WORDSPERCELL)
                             (UNFOLD (LRSH N.KEEP 8)
                                    WORDSPERCELL)))
           (PUSHP (NEQ (LOGAND N.KEEP 255)
                       0))
           OLDTOS)
          (COND
             (PUSHP                                          (* \; "Save old top of stack")

                    (SETQ OLDTOS (\\GETBASEPTR (STACKADDBASE (IDIFFERENCE SP WORDSPERCELL))
                                        0))))
          (UNINTERRUPTABLY
              (|while|
 (GREATERP (|add|
 SP (IMINUS WORDSPERCELL))
                                  DESIREDSP) |bind|
 (PVAR0BASE ← (STACKADDBASE
                                                                      (|fetch|
 (FX FIRSTPVAR)
                                                                         |of|
 CALLER)))
                 |when|
 (|fetch|
 BINDMARKP |of|
 (STACKADDBASE SP))
                 |do|
                                    (* \; 

"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 (IDIFFERENCE LASTPVAR WORDSPERCELL)))))
              (|replace|
 (FX NEXTBLOCK) |of|
 CALLER |with|
 (|add|
 DESIREDSP 
                                                                              WORDSPERCELL))
              (\\MAKEFREEBLOCK DESIREDSP (IDIFFERENCE 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))))
)
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (883 3595 (\\UNWIND.UFN 893 . 3593)))))
STOP