🚀 go-pugleaf

Here is a definition/implementation of Unix-style SetJmp and LongJmp
for the Logitech Modula-2/86 running code for 8086's or 80186's.
I don't know it's applicability for jumping out of interrupt handlers,
because flags aren't saved.

Can anyone comment on how portable the functionality of LongJmp is?
How many M2 implementations don't let you get close enough to
the machine to implement it's semantics?

Comments, Corrections, Ports welcome.

---------------cut here-------------------------------
: This is a shar archive.  Extract with sh, not csh.
: The rest of this file will extract:
: Continuations.def Continuations.mod
echo x Continuations.def
sed 's/^X//' > Continuations.def << 'xEOF'
XDEFINITION MODULE Continuations;
X(*
X *      Non-local GOTO performed by saving and invoking continuations.
X *      The routines "setjmp" and "longjmp" on UNIX are the model.
X *      These routines are useful for dealing with errors and interrupts
X *      encountered in a low-level subroutine of a program.
X *      They may not be implementable on all Modula-2 systems.
X *)
X   EXPORT QUALIFIED
X      JustSet, Continuation, SetJmp, LongJmp, DisposeContinuation;
X    
X   CONST
X      JustSet = 0;
X    
X   TYPE
X      Continuation;
X    
X   PROCEDURE SetJmp(VAR contin: Continuation; VAR retval: INTEGER);
X(*
X *      SetJmp saves its stack environment in contin for later use
X *      by LongJmp.
X *      It returns the value JustSet (= 0) in parameter retval.
X *)
X
X   PROCEDURE LongJmp(contin: Continuation; retval: INTEGER);
X(*
X *      LongJmp restores the environment saved in contin and then
X *      returns in such a way that execution continues as if the
X *      previous call of SetJmp had just returned the value retval to
X *      its caller.  The caller of SetJmp must not have returned in the
X *      interim.  LongJmp alters the value of no other variable.
X *)
X
X   PROCEDURE DisposeContinuation(VAR contin: Continuation);
X(*
X *      Deallocate memory used for storing the Continuation.
X *      Important if variables of Continuation type repeatedly
X *      leave their scope after a SetJmp.
X *)
X
XEND Continuations.
xEOF
echo x Continuations.mod
sed 's/^X//' > Continuations.mod << 'xEOF'
XIMPLEMENTATION MODULE Continuations;
X(*
X *      Non-local GOTO performed by saving and invoking continuations.
X *      The routines "setjmp" and "longjmp" on UNIX are the model.
X *      These routines are useful for dealing with errors and interrupts
X *      encountered in a low-level subroutine of a program.
X *      Implementation requires Logitech Modula-2/86 v2.0 for 8086 or 80186.
X *                 Programmer: Vincent Broman. July 1986.
X *)
X   FROM SYSTEM IMPORT
X      ADDRESS, ADR, GETREG, SETREG, CODE,
X      AX, BX, CX, BP, ES;
X   FROM Storage IMPORT
X      ALLOCATE, DEALLOCATE;
X  
X   TYPE
X      intptr = POINTER TO INTEGER;
X
X      Continuation = POINTER TO jumpbuffer;
X
X      jumpbuffer =
X         RECORD
X            valuedest: intptr;
X            returnaddress: ADDRESS;
X            stackpointer, framepointer: CARDINAL;
X            self: Continuation
X         END;
X
X
X   PROCEDURE LongJmp(contin: Continuation; retval: INTEGER);
X(*
X *      LongJmp restores the environment saved in contin and then
X *      returns in such a way that execution continues as if the
X *      previous call of SetJmp had just returned the value retval to
X *      its caller.  The caller of SetJmp must not have returned in the
X *      interim.  LongJmp alters the value of no other variable.
X *)
X      CONST
X         (* i8086 machine code *)
X         move = 08BH;
X         AXtoSP = 0E0H;
X         CXtoBP = 0E9H;
X         
X         pushES = 006H;
X         pushBX = 053H;
X         return = 0CBH;
X      
X      VAR
X         BPnow: CARDINAL;
X         newBP, newSP, newCS, newIP: CARDINAL;
X
X      BEGIN (* LongJmp *)
X         (* check whether contin is valid, initialized *)
X         IF (contin = NIL) OR (contin^.self # contin) OR
X                        (contin^.returnaddress = NIL) OR
X                            (contin^.valuedest = NIL) THEN
X            HALT
X         END;
X         
X         (* check that caller of SetJmp hasn't returned *)
X         GETREG(BP, BPnow);
X         IF contin^.stackpointer < BPnow + 12 THEN HALT END;
X         
X         contin^.valuedest^ := retval;
X         
X         WITH contin^ DO
X            newBP := framepointer;
X            newSP := stackpointer;
X            newCS := returnaddress.SEGMENT;
X            newIP := returnaddress.OFFSET
X         END;
X         SETREG(ES, newCS);
X         SETREG(BX, newIP);
X         SETREG(AX, newSP);
X         SETREG(CX, newBP);
X         CODE( move, CXtoBP,
X               move, AXtoSP,
X               pushES,
X               pushBX,
X               return)
X      END LongJmp;
X
X    
X   PROCEDURE SetJmp(VAR contin: Continuation; VAR retval: INTEGER);
X(*
X *      SetJmp saves its stack environment in contin for later use
X *      by LongJmp.
X *      It returns the value JustSet (= 0) in parameter retval.
X *)
X      CONST
X         load = 08BH; AXfromBP = 046H; sub0 = 000H;
X         sub2 = 002H;
X         sub4 = 004H;
X      
X      VAR
X         returnoffset, returnsegment, oldBP, nowBP: CARDINAL;
X
X      BEGIN (* SetJmp *)
X         IF (contin = NIL) OR (contin^.self # contin) THEN
X            NEW(contin)
X         END; (* if contin not used before *)
X
X         WITH contin^ DO
X            valuedest := ADR(retval);
X            
X            GETREG(BP, nowBP);
X            stackpointer := nowBP + 14;
X            
X            CODE(load, AXfromBP, sub0);
X            GETREG(AX, oldBP);
X            framepointer := oldBP;
X
X            CODE(load, AXfromBP, sub2);
X            GETREG(AX, returnoffset);
X            returnaddress.OFFSET := returnoffset;
X
X            CODE(load, AXfromBP, sub4);
X            GETREG(AX, returnsegment);
X            returnaddress.SEGMENT := returnsegment;
X
X            self := contin
X         END; (* with *)
X
X         retval := JustSet
X      END SetJmp;
X
X
X   PROCEDURE DisposeContinuation(VAR contin: Continuation);
X(*
X *      Deallocate memory used for storing the Continuation.
X *      Important if variables of Continuation type repeatedly
X *      leave their scope after a SetJmp.
X *)
X      BEGIN
X         IF (contin # NIL) AND (contin^.self = contin) THEN
X            DISPOSE(contin)
X         END
X      END DisposeContinuation;
X
XBEGIN
XEND Continuations.
X
xEOF
---------------cut here-------------------------------

Vincent Broman, code 632,  Naval Ocean Systems Center, San Diego, CA 92152, USA
Phone: +1 619 225 2365        {seismo,caip,ihnp4,ucbvax}!\\\\\\\
Arpa: broman@bugs.nosc.mil Uucp: {floyd,moss,bang,hp-sdd,sdcsvax}!noscvax!broman