MINICERN/packlib/kernlib/kerngen/ccgen/jmpset.c

   1 /*
   2  * $Id$
   3  *
   4  * $Log$
   5  * Revision 1.3  1997/10/23 16:25:10  mclareni
   6  * NT mods, mostly C Fortran interface
   7  *
   8  * Revision 1.2  1997/02/04 17:34:22  mclareni
   9  * Merge Winnt and 97a versions
  10  *
  11  * Revision 1.1.1.1.2.1  1997/01/21 11:29:30  mclareni
  12  * All mods for Winnt 96a on winnt branch
  13  *
  14  * Revision 1.1.1.1  1996/02/15 17:49:23  mclareni
  15  * Kernlib
  16  *
  17  */
  18 #include "kerngen/pilot.h"
  19
  20 /*>    ROUTINE JMPSET (AREA, ROUT)
  21
  22   CERN PROGLIB#         JMPSET          .VERSION KERNFOR  4.29  910718
  23
  24        The function  setjmp  cannot be implemented
  25             by a Fortran interface routine
  26
  27       Instead, we provide  IRETN = JMPSET (AREA,ROUT) which
  28       will dump the environment into AREA and call ROUT.
  29       IRTN = 0 on return signals normal return from ROUT,
  30       IRTN = n signals return from JMPLONG (AREA,n)
  31
  32 Usage :
  33           PROGRAM TOP
  34               COMMON /JMP/ AREA(32)
  35               EXTERNAL  XQT
  36
  37            12 IRTN = JMPSET (AREA,XQT)
  38               GO TO 12
  39               END
  40
  41           SUBROUTINE XQT
  42               CALL DOWN
  43               END
  44
  45           SUBROUTINE DOWN
  46               COMMON /JMP/ AREA(32)
  47
  48               IF (HOME)  CALL JMPLONG (AREA,1)
  49               END
  50 */
  51 #include <setjmp.h>
  52 #if defined(CERNLIB_QX_SC)
  53 int type_of_call jmpset_(area,ufun)
  54 #endif
  55 #if defined(CERNLIB_QXNO_SC)
  56 int type_of_call jmpset(area,ufun)
  57 #endif
  58 #if defined(CERNLIB_QXCAPT)
  59 int type_of_call JMPSET(area,ufun)
  60 #endif
  61 #if defined(CERNLIB_QSIGJMP)
  62       sigjmp_buf area;
  63 #endif
  64 #if !defined(CERNLIB_QSIGJMP)
  65       jmp_buf area;
  66 #endif
  67 #if defined(CERNLIB_QCCINDAD)
  68       void (type_of_call ** ufun)();
  69 #endif
  70 #if !defined(CERNLIB_QCCINDAD)
  71       void (type_of_call * ufun)();
  72 #endif
  73 {
  74       void (type_of_call * unext)();
  75       int  irtn;
  76
  77 #if defined(CERNLIB_QCCINDAD)
  78       unext = *ufun;
  79 #endif
  80 #if !defined(CERNLIB_QCCINDAD)
  81       unext = ufun;
  82 #endif
  83
  84 #if defined(CERNLIB_QSIGJMP)
  85       irtn = sigsetjmp(area,7);
  86 #endif
  87 #if !defined(CERNLIB_QSIGJMP)
  88       irtn = setjmp(area);
  89 #endif
  90
  91       if (irtn != 0)               return irtn;
  92       (* unext)();
  93       return 0;
  94 }
  95 /*> END <----------------------------------------------------------*/