1 /* Loglan82 Compiler&Interpreter
2 Copyright (C) 1993 Institute of Informatics, University of Warsaw
3 Copyright (C) 1993, 1994 LITA, Pau
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.
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.
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.
19 contacts: Andrzej.Salwicki@univ-pau.fr
22 LITA Departement d'Informatique
24 Avenue de l'Universite
26 tel. ++33 59923154 fax. ++33 59841696
28 =======================================================================
37 /* Handler routines */
42 #include "graf\graf.h"
44 #include "graf/graf.h"
49 void errsignal(exception)
54 signum = scot[ exception ];
55 if (signum != -1) /* attempt to call a handler */
57 raise_signal(signum, (word) 0, &ah, &am);
58 if (ic != 0) /* continue execution */
65 #if MSDOS && !NO_GRAPH && !DJE
67 extern bool graphmode;
69 if (graphmode) groff();
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");
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);
113 } /* end errsignal */
116 void raise_signal(signal, skip, ahnew, amnew) /* Raise exception */
120 word t1, t2, t3, t4, t5, virts;
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 */
129 ptr = prototype[ M[ t3+PROTNUM ] ]; /* prototype of current */
130 t4 = ptr->handlerlist;
131 if (t4 != 0) /* any handlers ? */
135 t5 = M[ t4 ]; /* signal number */
138 if (t5 == 0 && t1 == 0) t1 = t4;
141 } while (t5 != signal && t4 != 0);
143 if (t5 != signal) /* look in DL or SL */
145 if (t1 != 0) t4 = t1; /* handler for others found */
149 if (ptr->kind == HANDLER)
150 t2 = M[ t4+SL ]; /* use SL for handlers */
152 t2 = M[ t4+DL ]; /* or DL for other goodies */
153 if (t2 == 0) /* handler not found */
155 if (signal <= MAXSYSSN)
156 { /* system signal */
158 if (ic != 0) longjmp(contenv, 1);
161 else errsignal(RTEHNDNF);
167 } while (t1 == 0 && t5 != signal);
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 */
176 request(t5, ahnew, amnew);
177 M[ *amnew+M[ *amnew ]+SIGNR ] = 0;
181 if (signal == scot[ RTEMEMOV ] &&
182 thisp->lastitem-thisp->lastused-1 < t5)
184 scot[ RTEMEMOV ] = -1; /* make memov look like abort */
187 request(t5, ahnew, amnew);
188 M[ *amnew+M[ *amnew ]+SIGNR ] = signal;
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 */
196 M[ t5+DL+1 ] = M[ t2+1 ];
197 if (t1 != 0) /* skip */
202 } /* end raise_signal */
209 t1 = M[ M[ c1+M[ c1 ]+SL ] ]; /* am of handlers' SL */
210 t2 = c1; /* current */
213 t2 = M[ M[ t2+M[ t2 ]+DL ] ]; /* am of DL */
215 M[ t2+M[ t2 ]+LSC ] = prototype[ M[ t2+PROTNUM ] ]->lastwill;
217 back(&thisp->backobj, &M[ temporary ], (word) 0);
225 t1 = M[ M[ c1+M[ c1 ]+SL ] ]; /* am of handlers' SL */
226 M[ t1+M[ t1 ]+LSC ] = prototype[ M[ t1+PROTNUM ] ]->lastwill;
231 /* This wraps up the above series of the handler procedures.
234 void backhd(virt, am)
238 if (M[ c1+M[ c1 ]+SIGNR ] <= MAXSYSSN)
239 errsignal(RTEILLRT); /* illegal return */
241 back(virt, am, (word) 0);