sources/new-s5r4/handler.c

   1 /*     Loglan82 Compiler&Interpreter
   2      Copyright (C) 1993 Institute of Informatics, University of Warsaw
   3      Copyright (C)  1993, 1994 LITA, Pau
   4
   5      This program is free software; you can redistribute it and/or modify
   6      it under the terms of the GNU General Public License as published by
   7      the Free Software Foundation; either version 2 of the License, or
   8      (at your option) any later version.
   9
  10      This program is distributed in the hope that it will be useful,
  11      but WITHOUT ANY WARRANTY; without even the implied warranty of
  12      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13      GNU General Public License for more details.
  14
  15              You should have received a copy of the GNU General Public License
  16              along with this program; if not, write to the Free Software
  17              Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18
  19  contacts:  Andrzej.Salwicki@univ-pau.fr
  20
  21 or             Andrzej Salwicki
  22                 LITA   Departement d'Informatique
  23                 Universite de Pau
  24                 Avenue de l'Universite
  25                 64000 Pau   FRANCE
  26                  tel.  ++33 59923154    fax. ++33 59841696
  27
  28 =======================================================================
  29 */
  30
  31 #include "depend.h"
  32 #include "genint.h"
  33 #include "int.h"
  34 #include "process.h"
  35 #include "intproto.h"
  36
  37 /* Handler routines */
  38
  39 /* pataud le 13/10/94
  40 #if !NO_GRAPH || !DJE
  41 #if MSDOS
  42 #include "graf\graf.h"
  43 #else
  44 #include "graf/graf.h"
  45 #endif
  46 #endif
  47 */
  48
  49 void errsignal(exception)
  50 int exception;
  51 {
  52     word signum, ah, am;
  53
  54     signum = scot[ exception ];
  55     if (signum != -1)                   /* attempt to call a handler */
  56     {
  57         raise_signal(signum, (word) 0, &ah, &am);
  58         if (ic != 0)                    /* continue execution */
  59         {
  60             go(ah, am);
  61             longjmp(contenv, 1);
  62         }
  63     }
  64
  65 #if MSDOS && !NO_GRAPH && !DJE
  66     {
  67         extern bool graphmode;
  68
  69         if (graphmode) groff();
  70         graphmode = FALSE;
  71     }
  72 #endif
  73
  74     putc('\n', stderr);
  75     switch (exception)
  76     {
  77         case RTESLCOF: fprintf(stderr, " SL CHAIN CUT OFF");                    break;
  78         case RTEUNSTP: fprintf(stderr, " UNIMPLEMENTED STANDARD PROCEDURE");    break;
  79         case RTEILLAT: fprintf(stderr, " ILLEGAL ATTACH");                      break;
  80         case RTEILLDT: fprintf(stderr, " ILLEGAL DETACH");                      break;
  81         case RTECORTM: fprintf(stderr, " COROUTINE TERMINATED");                break;
  82         case RTECORAC: fprintf(stderr, " COROUTINE ACTIVE");                    break;
  83         case RTEINVIN: fprintf(stderr, " ARRAY INDEX ERROR");                   break;
  84         case RTEILLAB: fprintf(stderr, " INCORRECT ARRAY BOUNDS");              break;
  85         case RTEINCQA: fprintf(stderr, " IMPROPER QUA");                        break;
  86         case RTEINCAS: fprintf(stderr, " ILLEGAL ASSIGNMENT");                  break;
  87         case RTEFTPMS: fprintf(stderr, " FORMAL TYPE MISSING");                 break;
  88         case RTEILLKL: fprintf(stderr, " ILLEGAL KILL");                        break;
  89         case RTEILLCP: fprintf(stderr, " ILLEGAL COPY");                        break;
  90         case RTEINCHS: fprintf(stderr, " INCOMPATIBLE HEADERS");                break;
  91         case RTEHNDNF: fprintf(stderr, " HANDLER NOT FOUND");                   break;
  92         case RTEMEMOV: fprintf(stderr, " MEMORY OVERFLOW");                     break;
  93         case RTEFHTLG: fprintf(stderr, " FORMAL LIST TOO LONG");                break;
  94         case RTEILLRT: fprintf(stderr, " ILLEGAL RETURN");                      break;
  95         case RTEREFTN: fprintf(stderr, " REFERENCE TO NONE");                   break;
  96         case RTEDIVBZ: fprintf(stderr, " DIVISION BY ZERO");                    break;
  97         case RTESYSER: fprintf(stderr, " SYSTEM ERROR");                        break;
  98         case RTEILLIO: fprintf(stderr, " ILLEGAL I/O OPERATION");               break;
  99         case RTEIOERR: fprintf(stderr, " I/O ERROR");                           break;
 100         case RTECNTOP: fprintf(stderr, " CANNOT OPEN FILE");                    break;
 101         case RTEBADFM: fprintf(stderr, " INPUT DATA FORMAT BAD");               break;
 102         case RTEILLRS: fprintf(stderr, " ILLEGAL RESUME");                      break;
 103         case RTETMPRC: fprintf(stderr, " TOO MANY PROCESSES ON ONE MACHINE");   break;
 104         case RTEINVND: fprintf(stderr, " INVALID NODE NUMBER");                 break;
 105         case RTENEGST: fprintf(stderr, " NEGATIVE STEP VALUE");                 break;
 106         case RTENONGL: fprintf(stderr, " REFERENCE TO GLOBAL NON PROCESS OBJECT FROM PROCESS");                 break;
 107         default      : fprintf(stderr, " UNRECOGNIZED ERROR");
 108     }
 109     if (thisp->trlnumber < 0) thisp->trlnumber = - thisp->trlnumber;
 110     if (thisp->trlnumber != 0)
 111         fprintf(stderr, "\n AT LINE: %ld\n", (long) thisp->trlnumber);
 112     endprocess(4);
 113 } /* end errsignal */
 114
 115
 116 void raise_signal(signal, skip, ahnew, amnew)   /* Raise exception */
 117 word signal, skip;
 118 word *ahnew, *amnew;
 119 {
 120     word t1, t2, t3, t4, t5, virts;
 121     protdescr *ptr;
 122
 123     t1 = 0;                             /* handler for others = no */
 124     t2 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
 125     t3 = c1;                            /* am of current */
 126     t5 = 0;                             /* flag handler not found */
 127     do
 128     {
 129         ptr = prototype[ M[ t3+PROTNUM ] ]; /* prototype of current */
 130         t4 = ptr->handlerlist;
 131         if (t4 != 0)                    /* any handlers ? */
 132         {
 133             do
 134             {
 135                 t5 = M[ t4 ];           /* signal number */
 136                 if (t5 != signal)
 137                 {
 138                     if (t5 == 0 && t1 == 0) t1 = t4;
 139                     t4 = M[ t4+2 ];
 140                 }
 141             } while (t5 != signal && t4 != 0);
 142         }
 143         if (t5 != signal)               /* look in DL or SL */
 144         {
 145             if (t1 != 0) t4 = t1;       /* handler for others found */
 146             else
 147             {
 148                 t4 = t3+M[ t3 ];
 149                 if (ptr->kind == HANDLER)
 150                     t2 = M[ t4+SL ];    /* use SL for handlers */
 151                 else
 152                     t2 = M[ t4+DL ];    /* or DL for other goodies */
 153                 if (t2 == 0)            /* handler not found */
 154                 {
 155                     if (signal <= MAXSYSSN)
 156                     {                   /* system signal */
 157                         ic = skip;
 158                         if (ic != 0) longjmp(contenv, 1);
 159                         else return;
 160                     }
 161                     else errsignal(RTEHNDNF);
 162                 }
 163                 t3 = M[ t2 ];
 164             }
 165         }
 166         else t1 = 0;
 167     } while (t1 == 0 && t5 != signal);
 168
 169     virts = thisp->prochead+M[ thisp->prochead ]+VIRTSC;
 170     M[ virts ] = t2;                    /* compactification possible */
 171     M[ virts+1 ] = M[ t2+1 ];
 172     t3 = M[ t4+1 ];                     /* prototype number of handler */
 173     t5 = prototype[ t3 ]->appetite;
 174     if (t1 != 0)                        /* others */
 175     {
 176         request(t5, ahnew, amnew);
 177         M[ *amnew+M[ *amnew ]+SIGNR ] = 0;
 178     }
 179     else
 180     {
 181         if (signal == scot[ RTEMEMOV ] &&
 182             thisp->lastitem-thisp->lastused-1 < t5)
 183         {
 184             scot[ RTEMEMOV ] = -1;      /* make memov look like abort */
 185             errsignal(RTEMEMOV);
 186         }
 187         request(t5, ahnew, amnew);
 188         M[ *amnew+M[ *amnew ]+SIGNR ] = signal;
 189     }
 190     M[ *amnew+PROTNUM ] = t3;           /* provide system attributes */
 191     t5 = *amnew+M[ *amnew ];
 192     M[ t5+SL ] = M[ virts ];
 193     M[ t5+SL+1 ] = M[ virts+1 ];
 194     t2 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
 195     M[ t5+DL ] = t2;
 196     M[ t5+DL+1 ] = M[ t2+1 ];
 197     if (t1 != 0)                        /* skip */
 198     {
 199         ic = skip;
 200         go(*ahnew, *amnew);
 201     }
 202 } /* end raise_signal */
 203
 204
 205 void wind()
 206 {
 207     word t1, t2;
 208
 209     t1 = M[ M[ c1+M[ c1 ]+SL ] ];       /* am of handlers' SL */
 210     t2 = c1;                            /* current */
 211     while (TRUE)
 212     {
 213         t2 = M[ M[ t2+M[ t2 ]+DL ] ];   /* am of DL */
 214         if (t2 == t1) break;
 215         M[ t2+M[ t2 ]+LSC ] = prototype[ M[ t2+PROTNUM ] ]->lastwill;
 216     }
 217     back(&thisp->backobj, &M[ temporary ], (word) 0);
 218 } /* end wind */
 219
 220
 221 void term()
 222 {
 223     word t1;
 224
 225     t1 = M[ M[ c1+M[ c1 ]+SL ] ];       /* am of handlers' SL */
 226     M[ t1+M[ t1 ]+LSC ] = prototype[ M[ t1+PROTNUM ] ]->lastwill;
 227     wind();
 228 } /* end term */
 229
 230
 231 /* This wraps up the above series of the handler procedures.
 232  */
 233
 234 void backhd(virt, am)
 235 virtaddr *virt;
 236 word *am;
 237 {
 238     if (M[ c1+M[ c1 ]+SIGNR ] <= MAXSYSSN)
 239         errsignal(RTEILLRT);            /* illegal return */
 240     else
 241         back(virt, am, (word) 0);
 242 } /* end backhd */
 243