home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
compcomp
/
tpyacc
/
src
/
lexmsgs.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-05-13
|
4KB
|
137 lines
unit LexMsgs;
(* 2-5-91 AG *)
(* Copyright (c) 1990,91 by Albert Graef, Schillerstr. 18,
6509 Schornsheim/Germany
All rights reserved *)
interface
(* TP Lex message and error handling module
Note: this module should be USEd by any module using the heap during
initialization, since it installs a heap error handler (which
terminates the program with fatal error `memory overflow'). *)
var errors, warnings : Integer;
(* - current error and warning count *)
procedure error(msg : String; pos : Integer);
(* - print current input line and error message (pos denotes position to
mark in source file line) *)
procedure warning(msg : String; pos : Integer);
(* - print warning message *)
procedure fatal(msg : String);
(* - writes a fatal error message, erases Lex output file and terminates
the program with errorlevel 1 *)
const
(* sign-on and usage message: *)
sign_on = 'TP Lex Version 3.0a [May 92], Copyright (c) 1990-92 Albert Graef';
usage = 'Usage: LEX [options] lex-file[.L] [output-file[.PAS]]';
options = 'Options: /v verbose, /o optimize';
(* command line error messages: *)
invalid_option = 'invalid option ';
illegal_no_args = 'illegal number of parameters';
(* syntax errors: *)
unmatched_lbrace = '101: unmatched %{';
syntax_error = '102: syntax error';
unexpected_eof = '103: unexpected end of file';
(* semantic errors: *)
symbol_already_defined = '201: symbol already defined';
undefined_symbol = '202: undefined symbol';
invalid_charnum = '203: invalid character number';
empty_grammar = '204: empty grammar?';
(* fatal errors: *)
cannot_open_file = 'FATAL: cannot open file ';
write_error = 'FATAL: write error';
mem_overflow = 'FATAL: memory overflow';
intset_overflow = 'FATAL: integer set overflow';
sym_table_overflow = 'FATAL: symbol table overflow';
pos_table_overflow = 'FATAL: position table overflow';
state_table_overflow = 'FATAL: state table overflow';
trans_table_overflow = 'FATAL: transition table overflow';
macro_stack_overflow = 'FATAL: macro stack overflow';
implementation
uses LexBase;
procedure position(var f : Text;
lineNo : integer;
line : String;
pos : integer);
(* writes a position mark of the form
gfilename (lineno): line
^
on f with the caret ^ positioned at pos in line
a subsequent write starts at the next line, indented with tab *)
var
line1, line2 : String;
begin
(* this hack handles tab characters in line: *)
line1 := intStr(lineNo)+': '+line;
line2 := blankStr(intStr(lineNo)+': '+copy(line, 1, pos-1));
writeln(f, line1);
writeln(f, line2, '^');
write(f, tab)
end(*position*);
procedure error(msg : String; pos : Integer);
begin
inc(errors);
writeln;
position(output, lno, line, pos);
writeln(msg);
writeln(yylst);
position(yylst, lno, line, pos);
writeln(yylst, msg);
if ioresult<>0 then ;
end(*error*);
procedure warning(msg : String; pos : Integer);
begin
inc(warnings);
writeln;
position(output, lno, line, pos);
writeln(msg);
writeln(yylst);
position(yylst, lno, line, pos);
writeln(yylst, msg);
if ioresult<>0 then ;
end(*warning*);
procedure fatal(msg : String);
begin
writeln;
writeln(msg);
close(yyin); close(yyout); close(yylst); erase(yyout);
halt(1)
end(*fatal*);
{$F+}
function heapErrorHandler ( size : Word ): Integer;
{$F-}
begin
if size>0 then
fatal(mem_overflow) (* never returns *)
else
heapErrorHandler := 1
end(*heapErrorHandler*);
begin
errors := 0; warnings := 0;
(* install heap error handler: *)
heapError := @heapErrorHandler;
end(*LexMsgs*).