1 /*
2 **********************************************************************
3 * *
4 * ML/I macro processor -- C version *
5 * *
6 * Module 5 - Error routines (alphabetical order) *
7 * *
8 * Copyright (C) R.D. Eager MMXVIII *
9 * P.J. Brown University of Kent MCMLXVII *
10 * *
11 **********************************************************************
12 */
13
14
15 #include "ml1.h"
16
17
18 /*** Forward references ***/
19
20 #if ANSI
21 static void mcabrt(void);
22 static char *mestype(INT);
23 static void prid(void);
24 static void prlid(INT *);
25 static void prmiss(void);
26 static void prname(INT *,INT);
27 static void prnfnd(INT);
28 static char *prtype(INT,INT);
29 static INT setype(INT *);
30 #else
31 static VOID mcabrt();
32 static char *mestype();
33 static VOID prid();
34 static VOID prlid();
35 static VOID prmiss();
36 static VOID prname();
37 static VOID prnfnd();
38 static char *prtype();
39 static int setype();
40 #endif
41
42
erlmd()43 VOID erlmd()
44 /* Multiply-defined label. */
45 { prerr();
46 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
47 mderpr("Label %d is multiply-defined",meval);
48 #endif
49 #if FBSD64 | L1
50 mderpr("Label %ld is multiply-defined",meval);
51 #endif
52 prctxt();
53 }
54
55
erlme()56 VOID erlme()
57 /* Illegal macro element. */
58 { prerr();
59 idlen = 1;
60 mderid();
61 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
62 mderpr("%d is illegal macro element",meval);
63 #endif
64 #if FBSD64 | L1
65 mderpr("%ld is illegal macro element",meval);
66 #endif
67 prctxt();
68 mcabrt();
69 }
70
71
erlia()72 VOID erlia()
73 /* Illegal argument. */
74 { prerr();
75 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
76 mderpr("Argument %d has illegal value",sdb.argno);
77 #endif
78 #if FBSD64 | L1
79 mderpr("Argument %ld has illegal value",sdb.argno);
80 #endif
81 idlen = opdb.arglen;
82 idpt = eriapt;
83 prviz();
84 mcabrt();
85 }
86
87
erlovf()88 VOID erlovf()
89 /* Arithmetic overflow. */
90 { prerr();
91 mderpr("Arithmetic overflow");
92 prctxt();
93 mcabrt();
94 }
95
96
erlso()97 VOID erlso()
98 /* Stack overflow. If the current text is the source text, then the
99 following additional information is given: if there are any
100 constructions currently unmatched, or if a search is being made for a
101 label as a result of a forward MC-GO, then appropriate diagnostic
102 messages are printed. */
103 { prerr();
104 mderpr("Process aborted for lack of storage");
105 if((sdb.dbugsw == DB_SOURCE) && ((skiplv != 0) || (sdb.skval != 0))) {
106 mderpr(" possibly due to\n");
107 prmiss();
108 } else prctxt();
109 mihalt();
110 }
111
112
ermtst()113 VOID ermtst()
114 /* Routine to test for mismatches. Prints appropriate diagnostics if any
115 are found. */
116 { if((skiplv != 0) || (sdb.skval != 0)) {
117 prerr();
118 prmiss();
119 }
120 }
121
122
ersic()123 VOID ersic()
124 /* Illegal input character. */
125 { INT *oidpt = idpt; /* Save current values */
126 INT oidlen = idlen;
127
128 prerr();
129 mderpr("Illegal input character");
130 prctxt();
131
132 idpt = oidpt; /* Restore previous values */
133 idlen = oidlen;
134 }
135
136
ersnw()137 VOID ersnw()
138 /* Illegal macro name after warning. */
139 { prerr();
140 mderpr("Illegal macro name after warning");
141 prviz();
142 }
143
144
145 #if ANSI
macerr(INT n)146 VOID macerr(INT n)
147 #else
148 VOID macerr(n)
149 INT n;
150 #endif
151 /* System error. This should never (!) occur. */
152 { prerr();
153 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
154 mderpr("System error %d\n\n",n);
155 #endif
156 #if FBSD64 | L1
157 mderpr("System error %ld\n\n",n);
158 #endif
159 mihalt();
160 }
161
162
mcabrt()163 static VOID mcabrt()
164 /* Routine to clear up and print diagnostics after an error in a call of
165 an operation macro or insert. The aborted construction is given a null
166 value. Control is returned to the main scanning loop. */
167 { opexit();
168 prname(sdb.mtchpt,TRUE);
169 mderpr(" aborted due to above error\n\n");
170 longjmp(bssave,1);
171 }
172
173
prctxt()174 VOID prctxt()
175 /* Routine to print the current text. */
176 { INT erbloc[EDBSZ]; /* Error block - area for saving the EDB */
177
178 fmove((INT) EDBSZ,at_edb,erbloc);
179 /* Save the current EDB */
180 mderpr("\n\ndetected in\n");
181 if(sdb.dbugsw == DB_EVAL) goto erop;
182
183 prct2:
184 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
185 mderpr("line %d of ",sdb.linect);
186 #endif
187 #if FBSD64 | L1
188 mderpr("line %ld of ",sdb.linect);
189 #endif
190
191 for (;;) {
192 switch(sdb.dbugsw) {
193 case DB_SOURCE: /* In source text */
194 mderpr("source text\n\n");
195 fmove((INT) EDBSZ,erbloc,at_edb);
196 /* Restore the EDB */
197 return;
198
199 case DB_OPARG:
200 case DB_SUBARG: /* In argument */
201 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
202 mderpr("argument %d of ",sdb.argno);
203 #endif
204 #if FBSD64 | L1
205 mderpr("argument %ld of ",sdb.argno);
206 #endif
207 goto erop;
208
209 case DB_DELIM: /* In delimiter */
210 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
211 mderpr("delimiter %d of ",sdb.argno);
212 #endif
213 #if FBSD64 | L1
214 mderpr("delimiter %ld of ",sdb.argno);
215 #endif
216
217 erop: /* In operation macro, argument or delimiter */
218 sdb.argpt = sdb.dbugpt;
219 #if IBMC
220 #pragma checkout(suspend)
221 #endif
222 sdb.dbugpt = (INT *) (((struct sdbf *)(sdb.dbugpt))->mtchpt);
223 /* Stacked value of 'sdb.mtchpt' */
224 #if IBMC
225 #pragma checkout(resume)
226 #endif
227 if(sdb.dbugsw != DB_EVAL) {
228 prname(sdb.dbugpt,FALSE);
229 mderpr(" evaluated in\n");
230 if(sdb.dbugsw != DB_OPARG) break;
231 }
232
233 #if IBMC
234 #pragma checkout(suspend)
235 #endif
236 case DB_REPL:; /* In macro */
237 #if IBMC
238 #pragma checkout(resume)
239 #endif
240 prname(sdb.dbugpt,FALSE);
241 mderpr(" with ");
242 if(*sdb.argpt == 0) mderpr("no ");
243 mderpr("arguments");
244 sdb.argno = 0;
245 sdb.dbugpt = sdb.argpt;
246
247 while(*sdb.argpt != sdb.argno) {
248 sdb.argno++;
249 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
250 mderpr("\n%3d) ",sdb.argno);
251 #endif
252 #if FBSD64 | L1
253 mderpr("\n%3ld) ",sdb.argno);
254 #endif
255 setpts(DB_SUBARG);
256 prid();
257 }
258
259 mderpr("\ncalled from\n");
260 break;
261
262 default:
263 macerr((INT) 16);
264 }
265
266 fmove((INT) EDBSZ,sdb.stakpt + 1,at_edb);
267 /* Restore the EDB */
268 if(sdb.mchlin == sdb.linect) goto prct2;
269 if(*sdb.spt == '\n') {
270 sdb.linect--;
271 if(sdb.linect == sdb.mchlin) goto prct2;
272 }
273 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
274 mderpr("lines %d to %d of ",sdb.mchlin,sdb.linect);
275 #endif
276 #if FBSD64 | L1
277 mderpr("lines %ld to %ld of ",sdb.mchlin,sdb.linect);
278 #endif
279 }
280 }
281
282
prenv()283 VOID prenv()
284 /* Routine to print the version number of the machine-independent logic,
285 and the names of all the constructions in the current environment. The
286 built-in operation macro names are not printed. */
287 { INT i;
288 INT *j;
289 INT *ptr;
290 INT type;
291
292 mderpr("\n\n\nVersion %s\n",MIVERSION);
293
294 for(i = TY_STOP; i <= TY_SKIP; i++) {
295 mderpr("\n%ss are\n\n",prtype(i,TRUE));
296
297 for(j = sdb.hashpt; j < sdb.hashpt + LHV; j++) {
298 ptr = j;
299 for(;;) {
300 ptr = (INT *) *ptr;
301 if(ptr == NULLPT) break;
302
303 if((stffpt <= ptr) && (ptr < endpt)) {
304 /* Eliminate built-in macros */
305 type = setype(ptr + 1);
306
307 if(type == i) {
308 if((type != TY_STOP) && !ckvaly(ptr,type)) continue;
309 prlid(ptr + 1);
310 mderpr("\n");
311 }
312 }
313 }
314 }
315 }
316 }
317
318
prerr()319 VOID prerr()
320 /* Routine to introduce diagnostic output. The count of errors (in S5)
321 is updated. */
322 { mderpr("\n\nError(s)\n");
323 (*at_s5)++;
324 }
325
326
prid()327 static VOID prid()
328 /* Routine to print the atom described by 'idpt' and 'idlen',
329 restricting length to TEXMAX characters. */
330 { INT sw;
331 INT *pt = (INT *) NULL; /* To satisfy optimisers */
332
333 /* Handle null atom */
334
335 if(idlen == 0) {
336 mderpr("(null)");
337 return;
338 }
339
340 /* Test if layout character */
341
342 if(idlen == 1) {
343 pt = lulayk(TRUE);
344 if(pt != NULLPT) { /* Print keyword for layout characters */
345 idlen = pt[2];
346 idpt = pt + 3;
347 mderpr("(");
348 mderid();
349 mderpr(")");
350 return;
351 }
352 }
353
354 /* Print ordinary text, restricting length if necessary */
355
356 for(;;) {
357 sw = FALSE;
358 if(idlen > TEXMAX) {
359 sw = TRUE;
360 pt = idpt + idlen - HTMAX;
361 idlen = HTMAX;
362 }
363 mderid();
364 if(!sw) break;
365 idpt = pt;
366 mderpr(" --- ");
367 }
368 }
369
370
371 #if ANSI
prlid(INT * ptr)372 static VOID prlid(INT *ptr)
373 #else
374 static VOID prlid(ptr)
375 INT *ptr;
376 #endif
377 /* Routine to print a LID - parameter points at orlink. */
378 { for(;;) {
379 idlen = ptr[1];
380 idpt = ptr + 2;
381 ptr = idpt + idlen; /* Move past atom */
382 prid();
383 if(*ptr == WITHMK) continue; /* ...A WITH B... */
384 if(*ptr != WTHSMK) break; /* ...A WITHS B... */
385 mderpr(" ");
386 }
387 }
388
389
prmiss()390 static VOID prmiss()
391 /* Function to print names of unmatched constructions. */
392 { INT lchlink;
393
394 if(nestlv != 0) {
395 lfpt = cllfpt;
396 for(;;) {
397 mderpr("Delimiter ");
398 for(;;) {
399 prlid(delpt);
400 lchlink = *delpt;
401 if(lchlink == ENDCHN) break;
402 mderpr(" or ");
403 delpt += lchlink;
404 }
405 mderpr(" of ");
406 prname(sdb.mtchpt,FALSE);
407 prnfnd(sdb.mchlin);
408 if(!decalv()) break;
409 }
410 skiplv = 0;
411 if(sdb.skval < 0) sdb.skval = -sdb.skval - 1;
412 }
413
414 if(sdb.skval != 0) {
415 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
416 mderpr("Label %d referenced",sdb.skval);
417 #endif
418 #if FBSD64 | L1
419 mderpr("Label %ld referenced",sdb.skval);
420 #endif
421 prnfnd(sdb.sklin);
422 sdb.skval = 0;
423 }
424 prctxt();
425 }
426
427
428 #if ANSI
prname(INT * ptr,INT first)429 static VOID prname(INT *ptr,INT first)
430 #else
431 static VOID prname(ptr,first)
432 INT *ptr;
433 INT first;
434 #endif
435 /* Routine to print the type and name of a construction - 'ptr'
436 points at orlink. */
437 { mderpr("%s ",prtype(setype(ptr),first));
438 prlid(ptr);
439 }
440
441
442 #if ANSI
prnfnd(INT line)443 static VOID prnfnd(INT line)
444 #else
445 static VOID prnfnd(line)
446 INT line;
447 #endif
448 /* Routine to print "not found" message, with line number. */
449 {
450 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
451 mderpr(" in line %d of current text not found\n",line);
452 #endif
453 #if FBSD64 | L1
454 mderpr(" in line %ld of current text not found\n",line);
455 #endif
456 }
457
458
459 #if ANSI
mestype(INT type)460 static char *mestype(INT type)
461 #else
462 static char *mestype(type)
463 INT type;
464 #endif
465 { switch(type) {
466 case TY_STOP : return("stop");
467 case TY_MACRO : return("macro");
468 case TY_WARN : return("warning");
469 case TY_INSERT: return("insert");
470 case TY_SKIP : return("skip");
471 default : macerr((INT) 17);
472
473 /* NOTREACHED */
474 }
475 #if IBMC
476 #pragma checkout(suspend)
477 #endif
478 #if FBSD32 | FBSD64
479 #pragma clang diagnostic push
480 #pragma clang diagnostic ignored "-Wreturn-type"
481 #endif
482 }
483 #if FBSD32 | FBSD64
484 #pragma clang diagnostic pop
485 #endif
486 #if IBMC
487 #pragma checkout(resume)
488 #endif
489
490
491 #if ANSI
prtype(INT type,INT first)492 static char *prtype(INT type,INT first)
493 #else
494 static char *prtype(type,first)
495 INT type;
496 INT first;
497 #endif
498 /* Function to return a string describing a particular type of
499 construction. */
500 { char *mes;
501 static char typvec[8];
502
503 mes = mestype(type);
504 if(first) {
505 INT i = 0;
506
507 while((typvec[i] = mes[i]) != '\0') i++;
508 typvec[0] = (char) (toupper((int) typvec[0]));
509 return(typvec);
510 }
511 else return(mes);
512 }
513
514
prviz()515 VOID prviz()
516 /* Routine to print fuller information, after an illegal macro name or
517 argument has been detected. */
518 { mderpr(", viz \"");
519 prid();
520 mderpr("\"");
521 prctxt();
522 }
523
524
525 #if ANSI
setype(INT * ptr)526 static INT setype(INT *ptr)
527 #else
528 static INT setype(ptr)
529 INT *ptr;
530 #endif
531 /* Function to return the type of a construction - parameter points at
532 orlink. */
533 { ptr++;
534
535 for(;;) {
536 ptr = *ptr + ptr + 1;
537 if((*ptr != WITHMK) && (*ptr != WTHSMK)) break;
538 ptr++;
539 }
540
541 if(*ptr == SPCSMK) ptr++;
542
543 return(ptr[1]);
544 }
545
546
547 /*
548 ***********************
549 * *
550 * End of module 5 *
551 * *
552 ***********************
553 */
554
555