1 /*  Part of XPCE --- The SWI-Prolog GUI toolkit
2 
3     Author:        Jan Wielemaker and Anjo Anjewierden
4     E-mail:        jan@swi.psy.uva.nl
5     WWW:           http://www.swi.psy.uva.nl/projects/xpce/
6     Copyright (c)  1985-2002, University of Amsterdam
7     All rights reserved.
8 
9     Redistribution and use in source and binary forms, with or without
10     modification, are permitted provided that the following conditions
11     are met:
12 
13     1. Redistributions of source code must retain the above copyright
14        notice, this list of conditions and the following disclaimer.
15 
16     2. Redistributions in binary form must reproduce the above copyright
17        notice, this list of conditions and the following disclaimer in
18        the documentation and/or other materials provided with the
19        distribution.
20 
21     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22     "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23     LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24     FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25     COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26     INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27     BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28     LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29     CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31     ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32     POSSIBILITY OF SUCH DAMAGE.
33 */
34 
35 #include <h/kernel.h>
36 #include <h/trace.h>
37 #include <h/interface.h>
38 
39 static void initErrorDatabase(HashTable db);
40 
41 static status
initialiseError(Error e,Name id,StringObj format,Name kind,Name feedback)42 initialiseError(Error e, Name id, StringObj format, Name kind, Name feedback)
43 { if ( isDefault(kind) )     kind     = NAME_warning;
44   if ( isDefault(feedback) ) feedback = NAME_report;
45 
46   assign(e, id,       id);
47   assign(e, format,   format);
48   assign(e, kind,     kind);
49   assign(e, feedback, feedback);
50 
51   lockObject(e, ON);
52   appendHashTable(ErrorTable, e->id, e);
53 
54   succeed;
55 }
56 
57 
58 Error
getConvertError(Class class,Name id)59 getConvertError(Class class, Name id)
60 { Error e;
61 
62   if ( !ErrorTable )
63   { if ( inBoot )
64       fail;
65     realiseClass(ClassError);
66     if ( !ErrorTable )
67       fail;
68   }
69 
70   if ( (e=getMemberHashTable(ErrorTable, id)) )
71     answer(e);
72 
73   exceptionPce(PCE, NAME_undefinedError, id, EAV);
74 
75   return getMemberHashTable(ErrorTable, id);
76 }
77 
78 
79 static status
displayError(Error e,int argc,Any * argv)80 displayError(Error e, int argc, Any *argv)
81 { if ( e->feedback == NAME_report )
82   { ArgVector(av, argc+2);
83     int i;
84 
85     av[0] = e->kind;
86     av[1] = e->format;
87     for(i=0; i<argc; i++)
88       av[i+2] = argv[i];
89 
90     sendv(argv[0], NAME_report, argc+2, av);
91   } else
92   { string s;
93 
94     str_writefv(&s, (CharArray) e->format, argc, argv);
95 
96     if ( e->kind == NAME_inform || e->kind == NAME_status )
97       Cprintf("[PCE: ");
98     else
99       Cprintf("[PCE %s: ", strName(e->kind));
100 
101     Cputstr(&s);
102     str_unalloc(&s);
103 
104 #ifndef O_RUNTIME
105     if ( e->kind == NAME_fatal ||
106 	 (e->feedback == NAME_print &&
107 	  e->kind != NAME_inform &&
108 	  e->kind != NAME_status &&
109 	  e->kind != NAME_warning) )
110     { Cprintf("\n\tin: ");
111       pceWriteErrorGoal();
112       send(PCE, NAME_exposeConsole, EAV);
113       Cputchar('\007');			/* ^G: ASCII bell */
114       debuggingPce(PCE, ON);
115     }
116 #endif
117     Cprintf("]\n");
118   }
119 
120   succeed;
121 }
122 
123 
124 static StringObj
getFormatError(Error e,int argc,const Any argv[])125 getFormatError(Error e, int argc, const Any argv[])
126 { string s;
127   StringObj sobj;
128 
129   str_writefv(&s, (CharArray)e->format, argc, argv);
130 
131   sobj = StringToString(&s);
132   str_unalloc(&s);
133 
134   answer(sobj);
135 }
136 
137 
138 
139 		 /*******************************
140 		 *	 CLASS DECLARATION	*
141 		 *******************************/
142 
143 /* Type declaractions */
144 
145 static char *T_initialise[] =
146         { "name=name",
147 	  "format=string",
148 	  "kind=[{status,inform,warning,error,fatal,ignored}]",
149 	  "feedback=[{report,throw,print}]"
150 	};
151 
152 /* Instance Variables */
153 
154 static vardecl var_error[] =
155 { IV(NAME_id, "name", IV_GET,
156      NAME_name, "Unique identifier"),
157   IV(NAME_format, "string", IV_GET,
158      NAME_report, "Format used to print the message"),
159   IV(NAME_kind, "{status,inform,warning,error,fatal,ignored}", IV_BOTH,
160      NAME_report, "Kind of message"),
161   IV(NAME_feedback, "{report,throw,print}", IV_BOTH,
162      NAME_report, "Where (how) the report is reported")
163 };
164 
165 /* Send Methods */
166 
167 static senddecl send_error[] =
168 { SM(NAME_initialise, 4, T_initialise, initialiseError,
169      DEFAULT, "-> id, format, [kind], [feedback]"),
170   SM(NAME_display, 1, "unchecked ...", displayError,
171      NAME_report, "Display the error message using context")
172 };
173 
174 /* Get Methods */
175 
176 static getdecl get_error[] =
177 { GM(NAME_convert, 1, "error", "name", getConvertError,
178      NAME_oms, "Convert id into error"),
179   GM(NAME_lookup, 1, "error", "name", getConvertError,
180      NAME_oms, "Convert id into error"),
181   GM(NAME_format, 1, "string", "unchecked ...", getFormatError,
182      NAME_report, "Return a formatted error message")
183 };
184 
185 /* Resources */
186 
187 #define rc_error NULL
188 /*
189 static classvardecl rc_error[] =
190 {
191 };
192 */
193 
194 /* Class Declaration */
195 
196 static Name error_termnames[] = { NAME_id, NAME_format,
197 				  NAME_kind, NAME_feedback
198 				};
199 
200 ClassDecl(error_decls,
201           var_error, send_error, get_error, rc_error,
202           2, error_termnames,
203           "$Rev$");
204 
205 
206 status
makeClassError(Class class)207 makeClassError(Class class)
208 { declareClass(class, &error_decls);
209 
210   ErrorTable = globalObject(NAME_errors, ClassHashTable, EAV);
211   initErrorDatabase(ErrorTable);
212 
213   succeed;
214 }
215 
216 
217 		/********************************
218 		*         ERROR DATABASE	*
219 		********************************/
220 
221 #define ET_ERROR	0x00
222 #define ET_WARNING	0x01
223 #define ET_STATUS	0x02
224 #define ET_INFORM	0x03
225 #define ET_FATAL	0x04
226 #define ET_IGNORED	0x05
227 #define ET_MASK		0x0f
228 
229 #define EF_THROW	0x00
230 #define EF_PRINT	0x10
231 #define EF_REPORT	0x20
232 #define EF_MASK		0xf0
233 
234 typedef struct
235 { const Name id;
236   const int  flags;
237   const char *format;
238 } error_def;
239 
240 static const error_def errors[] =
241 {					/* Files */
242   { NAME_badFile,		EF_REPORT,
243     "%N: Not an %s file" },
244   { NAME_badFileName,		EF_REPORT,
245     "%N: Bad file name: %s" },
246   { NAME_cannotStat,		EF_REPORT,
247     "%N: Cannot get file attributes: %s" },
248   { NAME_cannotSeekNonFile,	0,
249     "%N: Cannot seek non-regular file" },
250   { NAME_chdir,			EF_REPORT,
251     "%N: Cannot change directory to %s: %s" },
252   { NAME_mkdir,			EF_REPORT,
253     "%N: Cannot make directory: %s" },
254   { NAME_rmdir,			EF_REPORT,
255     "%N: Cannot remove directory: %s" },
256   { NAME_backupFile,		EF_REPORT,
257     "%N: Cannot make a backup in %s: %s" },
258   { NAME_openFile,		EF_REPORT,
259     "%N: Cannot open for %s: %s" },
260   { NAME_readDirectory,		EF_REPORT,
261     "%N: Cannot read: %s" },
262   { NAME_removeFile,		EF_REPORT,
263     "%N: Cannot remove: %s" },
264   { NAME_renameFile,		EF_REPORT,
265     "%N: Cannot rename to %s: %s" },
266   { NAME_ioError,		EF_REPORT,
267     "%N: IO error: %s" },
268   { NAME_incompleteLine,	EF_REPORT,
269     "%N: Incomplete line" },
270   { NAME_noLimit,		0,
271     "%I%N: Failed to get system limit: %s" },
272   { NAME_seekFile,		EF_REPORT,
273     "%N: Cannot seek to %d from %s: %s" },
274   { NAME_cannotFindFile,	EF_REPORT,
275     "%N: Cannot find. Path = \"%s\"" },
276   { NAME_noFile,		EF_REPORT,
277     "%N: No associated file" },
278   { NAME_noTempFile,		EF_REPORT,
279     "%I: Cannot create temporary file: %s" },
280   { NAME_notOpenFile,		0,
281     "%N: Not open in mode %s" },
282   { NAME_cannotStartProcess,	EF_REPORT,
283     "%N: Cannot start: %s" },
284   { NAME_noPipe,		EF_REPORT,
285     "%N: Cannot create pipe: %s" },
286 					/* Process */
287   { NAME_unknownSignal,		0,
288     "%O: Unknown signal: %s" },
289   { NAME_outOfPtys,		EF_REPORT,
290     "%O: Out of pseudo-tty's" },
291   { NAME_openTty,		EF_REPORT,
292     "%O: Cannot open terminal %s: %s" },
293   { NAME_ioctlGet,		EF_REPORT,
294     "%O: Failed to fetch parameters of %s: %s" },
295   { NAME_ioctlSet,		EF_REPORT,
296     "%O: Failed to set parameters of %s: %s" },
297   { NAME_setControllingTty,	EF_REPORT,
298     "%O: Failed to set controlling terminal" },
299   { NAME_killedOnExit,		ET_STATUS,
300     "%N: Process killed on exit" },
301   { NAME_processExitStatus,	EF_REPORT,
302     "%N: Process exit status %d" },
303   { NAME_brokenPipe,		ET_IGNORED,
304     "%N: Broken pipe" },
305   { NAME_ptyError,		EF_REPORT,
306     "%N: Could not get pseudo terminal" },
307   { NAME_execError,		EF_REPORT,
308     "%N: Failed to execute: %s" },
309 
310 					/* C-symbols */
311   { NAME_notEnoughMemory,	ET_WARNING|EF_REPORT,
312     "%N: Not enough memory" },
313   { NAME_stackOverflow,		ET_ERROR,
314     "%N: Stack overflow (@pce <-max_goal_depth: %d)" },
315   { NAME_representation,	0,
316     "%O: cannot represent due to %s" },
317 					/* Sockets  */
318   { NAME_socket,		EF_REPORT,
319     "%N: Cannot %s socket: %s" },
320   { NAME_noHost,		EF_REPORT,
321     "%N: Cannot find host %s" },
322   { NAME_noDomain,		0,
323     "%N: no domain and cannot infer default" },
324   { NAME_hostname,		0,
325     "%N: cannot get hostname: %s" },
326   { NAME_noSocketDomain,	ET_WARNING|EF_REPORT,
327     "%N: No support for %s domain sockets" },
328 
329 					/* Class Variables */
330   { NAME_incompatibleClassVariable,	0,
331     "%N: Associated class-variable has incompatible type" },
332   { NAME_noClassVariable,	0,
333     "%N: No associated class_variable" },
334   { NAME_defaultSyntaxError,	ET_WARNING|EF_PRINT,
335     "%I: %N:%d Syntax error in Defaults-file" },
336   { NAME_oldDefaultFormat,	ET_WARNING|EF_PRINT,
337     "%N: old fashioned default syntax: %s" },
338   { NAME_classVariablesNotObtained, ET_WARNING|EF_PRINT,
339     "%O: class-variables have not been obtained" },
340 
341 					/* Display */
342   { NAME_noCurrentDisplay,	0,
343     "%N: No current display" },
344   { NAME_notSameDisplay,	0,
345     "%N: Not on the same display: %N" },
346   { NAME_noMainWindow,		ET_FATAL,
347     "%N: Failed to create X-application-shell" },
348   { NAME_noApplicationContext,	ET_FATAL,
349     "%N: Failed to create X-application-context" },
350 					/* Colour/Cursor/Font, etc */
351   { NAME_noLocaleSupport,	ET_WARNING,
352     "%N: X11 does not support locale %s" },
353   { NAME_cannotSetLocale,	ET_WARNING,
354     "%N: X11: cannot set locale modifiers" },
355 
356   { NAME_noNamedColour,		ET_WARNING,
357     "%N: No colour named %s; using black" },
358   { NAME_noNamedCursor,		EF_REPORT,
359     "%N: No cursor named %s" },
360   { NAME_getSelection,		EF_REPORT,
361     "%N: Cannot get %s selection: %s" },
362   { NAME_cannotBecomeSelectionOwner, EF_REPORT,
363     "%N: Cannot become selection owner" },
364   { NAME_noSelectionType,	ET_WARNING,
365     "%N: Selectiontype %s is not supported" },
366   { NAME_replacedColour,	EF_REPORT|ET_IGNORED,
367     "%N: Replaced by close value" },
368   { NAME_replacedByColour,	ET_IGNORED,
369     "%O: replaced by colour(%N)" },
370 
371 					/* Fonts */
372   { NAME_noDefaultFont,		ET_FATAL,
373     "%N: No default font defined (Pce.Display.no_font)" },
374   { NAME_replacedFont,		ET_WARNING|EF_PRINT,
375     "%N: Failed to open; replaced by %N" },
376   { NAME_no16BitFontsSupported,	ET_WARNING,
377     "%N: 16-bit fonts are not (yet) supported" },
378   { NAME_noFontsInFamily, ET_WARNING,
379     "%N: No fonts in font-family %s" },
380   { NAME_badFontAlias, ET_WARNING,
381     "%O: Bad font alias %N --> %O" },
382 
383 					/* X-errors */
384   { NAME_xOpen,			ET_FATAL,
385     "%N: Xopen failed on %s" },
386   { NAME_xError,		0,
387     "%N: X-error" },
388   { NAME_noXServer,		ET_FATAL,
389     "%N: Failed to connect to X-server at `%s': %s\n"
390     "*********************************************************************\n"
391     "* You MUST be running the X11 Windowing environment.  If you are,   *\n"
392     "* check the setting of your DISPLAY environment variable as well    *\n"
393     "* the access rights to your X11 server.  See xauth(1) and xhost(1). *\n"
394     "*********************************************************************"
395   },
396   { NAME_xMovedDisplay,		ET_STATUS|EF_PRINT,
397     "%N: Moved to display %s" },
398   { NAME_cannotGrabPointer,	ET_WARNING|EF_PRINT,
399     "%N: Failed to grab pointer: %s" },
400   { NAME_noRelatedXFont,	ET_WARNING,
401     "%N: No related X-font" },
402   { NAME_cannotConvertDefault,	ET_WARNING|EF_PRINT,
403     "%N: Failed to convert %s.  Trying program default" },
404   { NAME_cannotConvertProgramDefault,	ET_FATAL,
405     "%N: Failed to convert program default %O" },
406   { NAME_winMetafile,		ET_WARNING,
407     "%O: API operation %s failed: %s" },
408   { NAME_x11Threads,		ET_WARNING,
409     "%O: Cannot change X11 threading: display is already open" },
410 
411 					/* Save/Load */
412   { NAME_newSaveVersion,	ET_IGNORED|EF_PRINT,
413     "%N: Saved as version %d, current version is %d" },
414   { NAME_cannotSaveObject,	0,
415     "%O: Cannot save object: %s" },
416   { NAME_noAssoc,		0,
417     "%N: No external object @%s" },
418   { NAME_loadMessage,		ET_STATUS|EF_PRINT,
419     "%O: %s" },
420   { NAME_illegalCharacter,	ET_FATAL,
421     "%O: Illegal character (%c) at index %d" },
422   { NAME_referencedObjectNotLoaded, ET_FATAL,
423     "%N: Referenced object %O not loaded" },
424   { NAME_noSavedClassDef,	ET_FATAL,
425     "%N: Cannot find class-definition from id = %d" },
426   { NAME_loadNoClass,		ET_WARNING|EF_PRINT,
427     "%N: Referenced class %s does not exist" },
428   { NAME_loadOldSlot,		ET_WARNING|EF_PRINT,
429     "%N: Slot %s<-%s is is not in current class definition" },
430 
431 					/* Types */
432   { NAME_argumentType,		0,
433     "%N: Argument %d (%s): `%s' expected, found `%O'" },
434   { NAME_missingArgument,	0,
435     "%N: Missing argument %d (%s): `%s' expected" },
436   { NAME_unexpectedType,	0,
437     "%O: Should be a %N" },
438   { NAME_unresolvedType,	0,
439     "%N: Unresolved type (not built-in and no such class)" },
440   { NAME_elementType,		0,
441     "%O: Element %d is not a %N" },
442   { NAME_cannotConvert,		0,
443     "%N: Cannot convert %O" },
444   { NAME_argumentCount,		0,
445     "%N: Behaviour has %d arguments" },
446   { NAME_noNamedArgument,	0,
447     "%N: No argument named %s" },
448   { NAME_unboundAfterBoundArgument, 0,
449     "%N: un-named arguments cannot appear after named arguments" },
450   { NAME_inconsistentArguments, 0,
451     "%N: Inconsistent arguments" },
452   { NAME_typeLoop,		0,
453     "%N: Type translation loop for %O" },
454   { NAME_noTypeKind,		0,
455     "%N: Unknown type-kind: %s" },
456   { NAME_badTypeSyntax,		0,
457     "%N: Syntax error in type-specification" },
458   { NAME_instantiationFault,	0,
459     "%N: %N: Instantiation fault" },
460 
461 					/* text_item */
462   { NAME_cannotConvertText,	EF_REPORT|ET_WARNING,
463     "%N: Cannot convert `%s' to a %N" },
464   { NAME_soleCompletion,	EF_REPORT|ET_STATUS,
465     "%N: Sole completion" },
466   { NAME_completeNoMatch,	EF_REPORT|ET_WARNING,
467     "%N: No Match" },
468 					/* Text (editor, text_buffer) */
469   { NAME_mismatchedBracket,	EF_REPORT|ET_STATUS,
470     "%IMismatched bracket" },
471   { NAME_noMatchingBracket,	EF_REPORT|ET_STATUS,
472     "%INo matching bracket" },
473   { NAME_undoOverflow,		EF_REPORT|ET_IGNORED,
474     "%ICouldn't store undo information; check Pce.TextBuffer.undo_size" },
475 					/* Tables */
476   { NAME_badParameterKeyVector,	0,
477     "%O: Bad parameter- or key-vector" },
478   { NAME_badVectorSize,		0,
479     "%O: Vector %O should have %d elements" },
480   { NAME_noTable,		0,
481     "%O: Table has no hash_tables" },
482 					/* Graphicals */
483   { NAME_rotate90,		0,
484     "%O: Graphicals may only be rotated with multiples of 90 degrees" },
485   { NAME_alreadyShown,		0,
486     "%O: %O is already shown in %O" },
487   { NAME_nodeNotInTree,		0,
488     "%O: Node is not part of a tree" },
489   { NAME_alreadyHasParent,	0,
490     "%O: Already has a parent" },
491   { NAME_wouldBeCyclic,		0,
492     "%O: operation would lead to a cycle" },
493   { NAME_mustBeCreatedBefore,	0,
494     "%O: Must be ->create'd before `%s'" },
495   { NAME_badTexture,		0,
496     "%N: Unknown texture" },
497   { NAME_tooManyScreenLines,	0,
498     "%N: More than 500 lines???" },
499 					/* Dialog Items */
500   { NAME_noDefaultLabel,	0,
501     "%N: No default label for %s" },
502   { NAME_graphicalNotDisplayed,	0,
503     "%N: Cannot open popup on not-displayed graphical: %s" },
504 					/* PostScript */
505   { NAME_noPostScriptHeader,	0,
506     "%O: Failed to get postscript_header" },
507   { NAME_mustBeOpenBeforePostscript, 0,
508     "%O: Must be opened before <-postscript" },
509 					/* Windows, Frames and Tiles */
510   { NAME_noSubTile, 0,
511     "%O: tile %O has no <-super" },
512 					/* Arithmetic */
513   { NAME_noVar,			0,
514     "%N: Cannot find variable %N" },
515   { NAME_multipleVar,		0,
516     "%N: Variable %N occurs more than once" },
517   { NAME_domainError,		0,
518     "%N: Domain error: %s" },
519 					/* Message passing */
520   { NAME_badSelector,		0,
521     "%N: Illegal selector: %O" },
522   { NAME_freedObject,		0,
523     "%N: Freed object: %O" },
524 #ifndef O_RUNTIME
525   { NAME_noBehaviour,		ET_WARNING,
526     "%O: No implementation for: %s%s" },
527 #else
528   { NAME_noBehaviour,		ET_WARNING,
529     "%IFailed on not-implemented behaviour" },
530 #endif /*O_RUNTIME*/
531   { NAME_noTextBehaviour,	ET_WARNING,
532     "%O: No implementation for interactive function: ->%s" },
533   { NAME_noClass,		0,
534     "%N: Unknown class" },
535   { NAME_noSuperClassOf,	0,
536     "%N: \"%s\" is not a super-class of my class" },
537   { NAME_noImplementation,	0,
538     "%N: Not implemented" },
539   { NAME_badReturnValue,	0,
540     "%N: Return of incompatible value: %O; return_type is %N" },
541   { NAME_convertedReturnValue,	ET_STATUS,
542     "%N: Converted return value: %O to %O" },
543   { NAME_mustBeToReceiver,	0,
544     "%O: Is not @receiver (= %O)" },
545   { NAME_redefinedAssoc,	0,
546     "%N: Object @%s already exists" },
547   { NAME_changedLoop,		ET_IGNORED,
548     "%N: Looping while forwarding changes" },
549   { NAME_badVectorUsage,	0,
550     "%N: Arguments: any..., vector, [int]" },
551   { NAME_cannotExecute,		0,
552     "%N: Cannot execute" },
553   { NAME_noFunction,		0,
554     "%N: is not a function" },
555   { NAME_lastIsNoFunction,	0,
556     "%N: Last statement of progn is not a function" },
557   { NAME_evalFailed,		ET_WARNING,
558     "%N: Failed to evaluate" },
559   { NAME_unknownFunction,	ET_WARNING,
560     "%O: Unknown arithmetic function" },
561   { NAME_outOfIntRange,		ET_WARNING,
562     "%N: computed value is out of integer range" },
563   { NAME_initVariableFailed,	ET_WARNING,
564     "%N: Init failed for %O" },
565   { NAME_redeclaredVar,		0,
566     "%N: Variable redeclared" },
567   { NAME_unlinkFailed,		ET_WARNING,
568     "%O: ->unlink failed" },
569   { NAME_negativeRefCountInCreate, ET_WARNING,
570     "%IReference-count of %O drops below zero (while creating/freeing)" },
571   { NAME_negativeRefCount, 0,
572     "%IReference-count of %O drops below zero" },
573   { NAME_stringTooLong,		ET_FATAL,
574     "%O: string too long (%d; max = 134217727)" },
575   { NAME_typeNameTooLong,	ET_FATAL,
576     "%O: type name too long (max = %d)" },
577   { NAME_maxRecordSize,		0,
578     "%O: max record-size is %d" },
579 
580   { NAME_negativeCodeReferenceCount, ET_FATAL,
581     "%O: Code reference-count drops below zero" },
582   { NAME_cannotCreateInstances, 0,
583     "%O: It is not allowed to create instances of this class" },
584   { NAME_badCArgList,		0,
585     "%O%s%s: Unterminated argument list on call from C?" },
586 
587 					/* consistency-check (object) */
588   { NAME_checkedObjects,	ET_INFORM|EF_PRINT,
589     "%IChecked %d objects" },
590   { NAME_noExtension,		ET_WARNING|EF_PRINT,
591     "%O: No attribute of extension %s" },
592   { NAME_noProperObject,	ET_WARNING|EF_PRINT,
593     "%O: Not a proper object" },
594   { NAME_creating,		ET_WARNING|EF_PRINT,
595     "%O: Creating flag set" },
596   { NAME_badSlotValue,		ET_WARNING|EF_PRINT,
597     "%O: Illegal value in slot %N: %s" },
598   { NAME_badCellValue,		ET_WARNING|EF_PRINT,
599     "%O: Illegal cell %d: %s" },
600   { NAME_badElementValue,	ET_WARNING|EF_PRINT,
601     "%O: Illegal element %d: %s" },
602   { NAME_badKeyValue,		ET_WARNING|EF_PRINT,
603     "%O: Illegal key in %s --> %s" },
604   { NAME_badValueValue,		ET_WARNING|EF_PRINT,
605     "%O: Illegal value in %s --> %s" },
606   { NAME_failedToConvert,	ET_WARNING|EF_PRINT,
607     "%O: Failed to convert %s for slot %N" },
608   { NAME_badSlotValue,		ET_WARNING|EF_PRINT,
609     "%O: Illegal value in slot %N: %s" },
610   { NAME_freedSlotValue,	ET_WARNING|EF_PRINT,
611     "%O: Freed object in slot %N: %s" },
612   { NAME_freedCellValue,	ET_WARNING|EF_PRINT,
613     "%O: Freed object in cell %d: %s" },
614   { NAME_freedElementValue,	ET_WARNING|EF_PRINT,
615     "%O: Freed object in element %d: %s" },
616   { NAME_freedKeyValue,		ET_WARNING|EF_PRINT,
617     "%O: Freed key in %s --> %s" },
618   { NAME_freedValueValue,	ET_WARNING|EF_PRINT,
619     "%O: Freed value in %s --> %s" },
620   { NAME_tooFewBuckets,		ET_WARNING|EF_PRINT,
621     "%O: %d elements in only %d buckets?" },
622 
623 					/* Classes */
624   { NAME_redeclaredReference,	0,
625     "%O: Redeclared object reference: %N" },
626   { NAME_cannotChangeSuperClass,0,
627     "%N: Cannot change super-class" },
628   { NAME_notClassType,		0,
629     "%N: Is not of <-kind class" },
630   { NAME_cannotRefineVariable,	0,
631     "%N: Cannot refine variable %s" },
632   { NAME_hasInstances,		0,
633     "%N: Class already has instances" },
634   { NAME_hasSubClasses,		0,
635     "%N: Class already has subclasses" },
636   { NAME_noVariable,		0,
637     "%O: Unknown variable: %s" },
638   { NAME_classHasVariable,	0,
639     "%N: Class already defines variable %s" },
640 					/* Errors */
641   { NAME_unknownError,		0,
642     "%N: Unknown error: %s" },
643 					/* Host */
644   { NAME_noCallBack,		0,
645     "%N: Host does not support call-back" },
646 					/* Images */
647   { NAME_noImageFormat,		EF_REPORT,
648     "%N: Image format %s is not supported by this version" },
649   { NAME_pixelMismatch,		0,
650     "%O: Incompatible pixel-type: %O" },
651 
652 					/* Miscellaneous */
653   { NAME_readOnly,		0,
654     "%N: Read only" },
655   { NAME_stackEmpty,		0,
656     "%N: Stack empty: %s" },
657   { NAME_notPart,		0,
658     "%N: %s is not a part" },
659   { NAME_unknownEscape,		0,
660     "%N: Unknown escape sequence: %s%c" },
661   { NAME_notImplemented,	0,
662     "%N: Not implemented: %s" },
663   { NAME_alreadyPartOf,		0,
664     "%N: %s is already part of %s" },
665   { NAME_tooManyArguments,	0,
666     "%N: Too many arguments" },
667   { NAME_nameAlreadyExists,	0,
668     "%N: Name already exists" },
669   { NAME_cannotConstraintSelf,	0,
670     "%N: Cannot contraint object to itself" },
671   { NAME_syntaxError,		EF_REPORT,
672     "%N: Syntax error: %s" },
673   { NAME_sourceError,		EF_REPORT,
674     "%I%N:%d: %s" },
675   { NAME_internalError,		0,
676     "%N: Internal error" },
677   { NAME_needImageAndHotSpot,	0,
678     "%N: Style image needs <-image and <-hot_spot" },
679   { NAME_noFetchFunction,	0,
680     "%N: text %s does not return <-fetch_function" },
681   { NAME_noChangeAfterOpen,	0,
682     "%O: Cannot change after ->open" },
683   { NAME_notOpen,		0,
684     "%O: Not opened" },
685   { NAME_noButtonEvent,		0,
686     "%O: Is not a button-related event" },
687   { NAME_noEvent,		0,
688     "%O: No event named %s" },
689   { NAME_signal,		ET_FATAL,
690     "%O: Signal trapped: %s" },
691   { NAME_createFailed,		0,
692     "%O: Failed to ->create" },
693   { NAME_noCharacter,		ET_WARNING|EF_REPORT,
694     "%O: No character and @event is not printable" },
695   { NAME_noKeyBinding,		0,
696     "%O: No key_binding named %s" },
697   { NAME_noArgument,		ET_WARNING|EF_REPORT,
698     "%N: Cannot construct %d-th argument for %N" },
699   { NAME_noRegexRegister,	ET_WARNING|EF_REPORT,
700     "%N: No register \\%d" },
701   { NAME_noPrintName,		0,
702     "%O: Cannot generate printable name" },
703   { NAME_failedToClone,		0,
704     "%O: Failed to <-clone" },
705   { NAME_intRange,		0,
706     "%O: Integer value out of range" },
707   { NAME_noMember,		0,
708     "%O: No member %O" },
709   { NAME_notSupportedForChar16, 0,
710     "%O: operation not supported on 16-bit strings" },
711   { NAME_formatBufferOverFlow,  0,
712     "%O: format buffer overflow (buffer size = %d)" },
713   { NAME_runtimeVersion,	0,
714     "%N: operation not supported in runtime system"
715   },
716   { NAME_notInitialised,	0,
717     "%O: Object is not initialised"
718   },
719   { NAME_unknownEncoding,	0,
720     "%O: Unknown encoding: %s"
721   },
722 					/* Tables/layout managament */
723   { NAME_spannedRow,	0,	/* tables */
724     "%O: Table contains row-spanned cell %O in sort range"
725   },
726   { NAME_noChangeLayoutInterface, 0,
727     "%O: cannot change layout-interface"
728   },
729 
730 #ifdef WIN32_GRAPHICS
731 					/* MS-Windows errors */
732   { NAME_moreThanOneIcon,	0,
733     "%N: Contains more than 1 icon.  Using first" },
734 #endif /*WIN32_GRAPHICS*/
735 
736   { NAME_threadsInitialised,		0,
737     "%N: Cannot change threading after initialisation" },
738 
739 					/* List closer */
740   { NULL,			0,
741     NULL }
742 };
743 
744 
745 static void
initErrorDatabase(HashTable db)746 initErrorDatabase(HashTable db)
747 { const error_def *err = errors;
748 
749   for(; err->id; err++)
750   { Name feedback = NIL, kind = NIL;
751 
752     switch(err->flags & ET_MASK)
753     { case ET_ERROR:	kind = NAME_error;	break;
754       case ET_WARNING:  kind = NAME_warning;	break;
755       case ET_STATUS:	kind = NAME_status;	break;
756       case ET_INFORM:	kind = NAME_inform;	break;
757       case ET_FATAL:	kind = NAME_fatal;	break;
758       case ET_IGNORED:	kind = NAME_ignored;	break;
759       default:
760 	assert(0);
761     }
762 
763 #ifndef O_RUNTIME
764     switch(err->flags & EF_MASK)
765     { case EF_THROW:	feedback = NAME_throw;  break;
766       case EF_REPORT:	feedback = NAME_report;	break;
767       case EF_PRINT:	feedback = NAME_print;	break;
768       default:
769 	assert(0);
770     }
771 #else
772     feedback = NAME_report;
773 #endif /*O_RUNTIME*/
774 
775     newObject(ClassError, err->id, CtoString(err->format),
776 	      kind, feedback, EAV);
777   }
778 }
779 
780 
781 		/********************************
782 		*          C-INTERFACE		*
783 		********************************/
784 
785 static void
_errorPce(Any obj,Name id,va_list args)786 _errorPce(Any obj, Name id, va_list args)
787 { Error e;
788 
789   if ( id == NAME_stackOverflow )
790     MaxGoalDepth += 100;
791 
792   if ( (e = getConvertError(ClassError, id)) )
793   { int argc, i;
794     Any argv[VA_PCE_MAX_ARGS+1];
795 
796     if ( e->kind == NAME_ignored )
797       return;
798 
799     argv[0] = e;
800     if ( !writef_arguments(strName(e->format) + 2, /* skip '%N: ' */
801 			   args, &argc, &argv[1]) )
802       argc = 0;
803     argc++;				/* e, arg-1, arg-2, ... */
804 
805     for(i=0; i<argc; i++)
806       if ( !validPceDatum(argv[i]) )
807 	argv[i] = CtoName("<Bad argument>");
808 
809     if ( inBoot )
810     { if ( CurrentGoal )
811 	CurrentGoal->flags |= PCE_GF_EXCEPTION;
812 
813       Cprintf("[PCE BOOT ERROR: ");
814       writef(strName(e->format), argc-1, argv+1)	;
815       Cprintf("\n\tin: ");
816       pceWriteErrorGoal();
817       Cprintf("]\n");
818       hostAction(HOST_RECOVER_FROM_FATAL_ERROR);
819       hostAction(HOST_HALT);
820       exit(1);
821     } else
822     { if ( !(isProperObject(obj) && isProperObject(classOfObject(obj))) )
823       { Cprintf("->error on non-object %s\n", pp(obj));
824 	obj = CtoString(pp(obj));
825       }
826 
827       sendv(obj, isFunction(obj) ? NAME_Error : NAME_error, argc, argv);
828       if ( e->kind == NAME_fatal )
829       {
830 #ifndef O_RUNTIME
831 	if ( id != NAME_noXServer )	/* little hack ... */
832           pceBackTrace(NULL, 20);
833         Cprintf("Host stack:\n");
834         hostAction(HOST_BACKTRACE, 5);
835 #endif
836 	hostAction(HOST_RECOVER_FROM_FATAL_ERROR);
837 	hostAction(HOST_HALT);
838 	exit(1);
839       }
840     }
841   } else				/* undefined error */
842   { if ( CurrentGoal )
843       CurrentGoal->flags |= PCE_GF_EXCEPTION;
844 
845     if ( inBoot )
846       sysPce("Unknown error at boot: %s", strName(id));
847     else
848       errorPce(obj, NAME_unknownError, id);
849   }
850 }
851 
852 
853 status
errorPce(Any obj,Name id,...)854 errorPce(Any obj, Name id, ...)
855 { va_list args;
856 
857   va_start(args, id);
858   _errorPce(obj, id, args);
859   va_end(args);
860 
861   fail;
862 }
863 
864 
865 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
866 errorTypeMismatch()
867 	Utility routine to report type-mismatch on implementation objects.
868 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
869 
870 status
errorTypeMismatch(Any rec,Any impl,int arg,Type type,Any val)871 errorTypeMismatch(Any rec, Any impl, int arg, Type type, Any val)
872 { Type argtype;
873   Name argname = NIL;
874 
875   if ( instanceOfObject(impl, ClassMethod) )
876   { Method m = impl;
877 
878     argtype = m->types->elements[arg-1];
879   } else if ( instanceOfObject(impl, ClassObjOfVariable) )
880   { Variable v = impl;
881     argtype = v->type;
882     argname = v->name;
883   } else
884   { argtype = type;
885   }
886 
887   if ( isNil(argname) )
888   { if ( instanceOfObject(argtype, ClassType) )
889       argname = argtype->argument_name;
890     if ( isNil(argname) )
891       argname = CtoName("?");
892   }
893 
894   return errorPce(impl, NAME_argumentType,
895 		  toInt(arg), argname, getNameType(type), val);
896 }
897