/*
(Concurrent) Clean Compiler: Support
========================================
This module contains all the compiler supporting routines,
such as: the storage administration and the error handling
routines and some global variables containing the compiler
settings.
At the end of this module the version number of the compiler
is administered.
Author: Sjaak Smetsers
At: University of Nijmegen, department of computing science
Version: 1.0
*/
#include "system.h"
#include "sizes.h"
#include "cmdline.h"
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
#include "scanner.h"
#include "buildtree.h"
#include "comparser.h"
#include "checker.h"
#include "typechecker.h"
#include "statesgen.h"
#include "codegen_types.h"
#include "codegen1.h"
#include "codegen2.h"
#include "instructions.h"
#include "overloading.h"
#include "checksupport.h"
#include "dbprint.h"
extern int VERSION;
/* 'CurrentModule' contains the name of the module that is currently under examination. */
char *CurrentPhase, *CurrentModule, *CurrentExt;
unsigned CurrentLine;
Symbol CurrentSymbol;
Bool CompilerError;
jmp_buf ExitEnv;
char *OutName = (char *) NIL;
char *InName;
/* The storage administration. */
unsigned long NrOfBytes;
unsigned NrOfLargeBlocks;
static char *StartStorage, *FirstBlock, *LastBlock, *NextFreeMem;
static void *AllocLarge (SizeT size)
{
char **newblock;
size = ReSize (size);
if ((newblock = (char **) Alloc ((unsigned long) size + SizeOf (char *), SizeOf (char)))!=NULL){
*newblock = FirstBlock;
FirstBlock = (char *) newblock++;
NrOfBytes += size;
return (char *) newblock;
} else {
FatalCompError ("comsupport", "AllocLarge", "Insufficient Memory");
return (void *) Null;
}
}
static Bool InitStorageFlag = True;
void InitStorage (void)
{
if (InitStorageFlag){
char **newblock;
if ((newblock = (char **) Alloc ((unsigned long) (MemBlockSize + (SizeT) (SizeOf (char *))), SizeOf (char)))!=NULL){
*newblock = (char *) NIL;
StartStorage = LastBlock = FirstBlock = (char *) newblock;
NextFreeMem = SizeOf(char*)+(char*)newblock;
InitStorageFlag = False;
NrOfBytes = (unsigned long) (MemBlockSize + (SizeT) (SizeOf (char *)));
NrOfLargeBlocks = 0;
} else
FatalCompError ("comsupport", "InitStorage","Insufficient Memory");
}
}
#undef FILL_ALLOCATED_MEMORY_WITH_GARBAGE
#ifdef FILL_ALLOCATED_MEMORY_WITH_GARBAGE
static unsigned char g_next_garbage_byte=0;
#endif
void *CompAlloc (SizeT size)
{
char *new_block;
size = ReSize (size);
if (size > KBYTE){
NrOfLargeBlocks++;
#ifdef FILL_ALLOCATED_MEMORY_WITH_GARBAGE
{
void *m;
unsigned char *p,next_garbage_byte;
int i;
m=AllocLarge (size);
i=size;
p=m;
next_garbage_byte=g_next_garbage_byte;
while (--i>=0)
*p++ = next_garbage_byte++;
g_next_garbage_byte=next_garbage_byte;
return m;
}
#else
return AllocLarge (size);
#endif
}
new_block=NextFreeMem;
if (new_block-LastBlock+size > MemBlockSize+SizeOf(char*)){
char **newblock;
newblock = (char **) Alloc ((unsigned long)
(MemBlockSize + (SizeT) (sizeof (char *))), SizeOf (char));
if (newblock!=NULL){
*((char **) LastBlock) = (char *) newblock;
LastBlock = (char *) newblock;
*newblock = (char *) NIL;
new_block=LastBlock+SizeOf(char*);
NrOfBytes += (unsigned long) (MemBlockSize + (SizeT) (SizeOf (char *)));
} else {
/* FPrintF (StdError,"Allocated %ld bytes\n",(long)NrOfBytes); */
FatalCompError ("comsupport", "CompAlloc", "Insufficient Memory");
}
}
NextFreeMem = new_block+size;
#ifdef FILL_ALLOCATED_MEMORY_WITH_GARBAGE
{
unsigned char *p,next_garbage_byte;
int i;
i=size;
p=(unsigned char*)new_block;
next_garbage_byte=g_next_garbage_byte;
while (--i>=0)
*p++ = next_garbage_byte++;
g_next_garbage_byte=next_garbage_byte;
}
#endif
return (void *) new_block;
}
static HeapDescr FreeHeapDescrList;
HeapDescr TH_New (void)
{
HeapDescr new_hd;
if (FreeHeapDescrList)
{ new_hd = FreeHeapDescrList;
FreeHeapDescrList = FreeHeapDescrList -> hd_next;
}
else
new_hd = CompAllocType (struct heap_descr);
new_hd -> hd_start = NULL;
return new_hd;
} /* TH_New */
void TH_Free (HeapDescr hd)
{
char *next_block;
char *currentblock = hd -> hd_start;
while (currentblock != NULL)
{ next_block = *(char**) currentblock;
Free (currentblock);
currentblock = next_block;
}
hd -> hd_next = FreeHeapDescrList;
FreeHeapDescrList = hd;
} /* TH_Free */
void TH_Reset (HeapDescr hd)
{
if (hd -> hd_start)
hd -> hd_end = hd -> hd_start;
else
{ char **newblock = (char **) Alloc (TH_BlockSize + SizeOf (char *), SizeOf(char));
if (newblock == NULL){
/* FPrintF (StdError,"Allocated %ld bytes\n",(long)NrOfBytes); */
FatalCompError ("comsupport","TH_Reset","Insufficient Memory");
}
*newblock = (char *) NIL;
hd -> hd_end = hd -> hd_start = (char *) newblock;
}
hd -> hd_free = hd -> hd_start + SizeOf (char *);
} /* TH_Reset */
void *TH_Alloc (HeapDescr hd, SizeT size)
{
if (size > 0){
char *memory_block;
size = ReSize (size); /* word allignment */
if (size > TH_BlockSize) /* too large to be handled by the temporary administration */
return CompAlloc (size);
else if (hd -> hd_free + size > hd -> hd_end + (TH_BlockSize + SizeOf (char *)))
{
/* the current block if full so a new one has to be allocated */
if (*((char**) hd -> hd_end) == NULL)
{
char *new_block;
/* the reference to the next heap block is NIL which implies that
a new block has to be allocated in the Memory of the compiler */
new_block = (char*)Alloc (TH_BlockSize + SizeOf (char *), SizeOf (char));
if (new_block == NULL)
{
/* FPrintF (StdError,"Allocated %ld bytes\n",(long)NrOfBytes);
{
int n_blocks;
char *currentblock;
n_blocks=0;
for (currentblock=hd->hd_start; currentblock!=NULL; currentblock = *(char**) currentblock)
++n_blocks;
FPrintF (StdError,"Allocated %d blocks,%ld bytes\n",n_blocks,(long)n_blocks*(TH_BlockSize+SizeOf (char*)));
}
*/
TH_Free (hd);
FatalCompError ("comsupport","TH_Alloc","Insufficient Memory");
}
*((char**) hd -> hd_end) = new_block;
hd -> hd_end = *((char **) hd -> hd_end);
*((char**) hd -> hd_end) = NULL;
}
else
hd -> hd_end = *((char **) hd -> hd_end);
memory_block = hd -> hd_end + SizeOf(char*);
}
else
memory_block = hd -> hd_free;
hd -> hd_free = memory_block + size;
return memory_block;
}
else
return NULL;
}
extern Bool CS_MemoryCheck (void * ptr);
Bool CS_MemoryCheck (void * ptr)
{
return (char *) ptr > StartStorage && (char *) ptr <= LastBlock + MemBlockSize;
}
extern void finish_strictness_analysis (void);
void CompFree (void)
{
if (! InitStorageFlag){
char *block;
for (block = FirstBlock; block; ){
char *next_block;
next_block=*((char **) block);
Free (block);
block=next_block;
}
finish_strictness_analysis();
InitStorageFlag = True;
}
}
/* The environment to leave the compiler if a fatal error occurs */
void FatalCompError (char *mod, char *proc, char *mess)
{
FPrintF (StdError,"Fatal Error in %s:%s \"%s\"\n", mod, proc, mess);
if (OpenedFile){
if (ABCFileName){
CompilerError = True;
CloseABCFile (ABCFileName);
} else
FClose (OpenedFile);
OpenedFile = (File) NIL;
}
#ifdef CLEAN2
exit (1);
#else
longjmp (ExitEnv, 1);
#endif
}
void PrintSymbol (Symbol symbol, File file)
{
Ident symb_id;
unsigned line_nr;
switch (symbol -> symb_kind)
{
case newsymbol:
case instance_symb:
symb_id = symbol -> symb_ident;
line_nr = 0;
break;
case definition:
symb_id = symbol -> symb_def -> sdef_ident;
line_nr = symbol -> symb_def -> sdef_line;
break;
case int_denot:
FPutS (symbol->symb_int, file);
return;
case bool_denot:
FPutS (symbol->symb_bool ? ReservedWords [truesym] : ReservedWords [falsesym], file);
return;
case char_denot:
FPutS (symbol->symb_char, file);
return;
case string_denot:
FPutS (symbol->symb_string, file);
return;
case real_denot:
FPutS (symbol->symb_real, file);
return;
case tuple_symb:
FPutS (TupleId -> ident_name, file);
return;
case cons_symb:
FPutS (ConsId -> ident_name, file);
return;
case nil_symb:
FPutS (NilId -> ident_name, file);
return;
case select_symb:
FPutS (SelectId -> ident_name, file);
return;
case apply_symb:
FPutS (ApplyId -> ident_name, file);
return;
case if_symb:
FPutS (IfId -> ident_name, file);
return;
case fail_symb:
FPutS (FailId -> ident_name, file);
return;
default:
FPutS (ConvertSymbolKindToString ((SymbKind)symbol -> symb_kind), file);
return;
}
PrintSymbolOfIdent (symb_id, line_nr, file);
} /* PrintSymbol */
#include <stdarg.h>
static char *FindFormatSpecifier (char * format_string)
{
for (; *format_string != '\0' && *format_string != '%'; format_string++)
;
return format_string;
}
#ifdef GNU_C
void StaticMessage (Bool error, char *symbol_format1, char *message_format1, ...)
{
char *format, format_spec;
char symbol_format [256], message_format [256];
va_list ap;
strcpy (symbol_format, symbol_format1);
strcpy (message_format, message_format1);
va_start (ap, message_format1);
#else
void StaticMessage (Bool error, char *symbol_format, char *message_format, ...)
{
char *format, format_spec;
va_list ap;
va_start (ap, message_format);
#endif
if (! (error || DoWarning))
return;
#ifdef MAKE_MPW_TOOL
FPutS ("### ",StdError);
#endif
if (CurrentPhase){
FPutS (CurrentPhase, StdError);
FPutS (error ? " error [" : " warning [", StdError);
} else
FPutS (error ? "Error [" : "Warning [", StdError);
#ifdef MAKE_MPW_TOOL
FPutS ("File ",StdError);
#endif
FPutS (CurrentModule, StdError);
FPutS (CurrentExt, StdError);
if (CurrentLine > 0){
#ifdef MAKE_MPW_TOOL
FPrintF (StdError, "; Line %u", CurrentLine);
#else
FPrintF (StdError, ",%u", CurrentLine);
#endif
}
#ifdef MAKE_MPW_TOOL
FPutS ("] ", StdError);
#else
FPutC (',', StdError);
#endif
for (format = symbol_format; ;)
{ char *tail_format = FindFormatSpecifier (format);
if (*tail_format == '\0')
{ FPutS (format, StdError);
break;
}
else
{ *tail_format = '\0';
FPutS (format, StdError);
*tail_format = '%';
format_spec = * (++tail_format);
if (format_spec == '\0')
{ FPutC ('%', StdError);
break;
}
else
{ switch (format_spec)
{
case 's':
{ char * message = va_arg (ap, char *);
if (message != NULL)
FPutS (message, StdError);
break;
}
case 'D':
{
SymbDef def = va_arg (ap, SymbDef);
PrintSymbolOfIdent (def->sdef_ident, def->sdef_line, StdError);
break;
}
case 'S':
PrintSymbol (va_arg (ap, Symbol), StdError);
break;
default:
FPutC ('%', StdError);
FPutC (format_spec, StdError);
break;
}
format = ++tail_format;
}
}
}
#ifdef MAKE_MPW_TOOL
FPutS (": ", StdError);
#else
FPutS ("]: ", StdError);
#endif
for (format = message_format; ;)
{ char *tail_format = FindFormatSpecifier (format);
if (*tail_format == '\0')
{ FPutS (format, StdError);
break;
}
else
{ *tail_format = '\0';
FPutS (format, StdError);
*tail_format = '%';
format_spec = * (++tail_format);
if (format_spec == '\0')
{ FPutC ('%', StdError);
break;
}
else
{ switch (format_spec)
{
case 's':
{ char * message = va_arg (ap, char *);
if (message != NULL)
FPutS (message, StdError);
break;
}
case 'd':
{ int nr = va_arg (ap, int);
FPrintF (StdError, "%d", nr);
break;
}
case 'S':
PrintSymbol (va_arg (ap, Symbol), StdError);
break;
case 'N':
{ Node node = va_arg (ap, Node);
int arg_nr = va_arg (ap, int);
PrintNodeSymbol (node, arg_nr, StdError);
break;
}
case 'T':
PrintTCType (va_arg (ap, struct type_cell *),NULL);
break;
case 'U':
{
struct type_cell *type,*sub_type;
type=va_arg (ap, struct type_cell *);
sub_type=va_arg (ap, struct type_cell *);
PrintTCType (type,sub_type);
break;
}
default:
FPutC ('%', StdError);
FPutC (format_spec, StdError);
break;
}
format = ++tail_format;
}
}
}
FPutC ('\n', StdError);
va_end (ap);
if (error)
CompilerError = True;
}
void Verbose (char *msg)
{
if (DoVerbose)
FPrintF (StdVerboseL, "%s \"%s%s\"\n", msg, CurrentModule, CurrentExt);
}
void PrintVersion (void)
{
if (DoVerbose)
FPrintF (StdVerboseL, "Concurrent Clean Compiler (Version %d.%d)\n",
VERSION / 1000, VERSION % 1000);
}
static char Init[] = "Compiler initialization";
Bool InterruptFlag;
File OpenedFile;
static void SetInterruptFlag (void)
{
InterruptFlag = True;
}
void ExitOnInterrupt (void)
{
CheckInterrupt ();
if (InterruptFlag){
if (OpenedFile){
if (ABCFileName){
CompilerError = True;
CloseABCFile (ABCFileName);
} else
FClose (OpenedFile);
OpenedFile = (File) NIL;
}
#ifdef _STANDALONE_
if (InCommandInterpreter)
FPrintF (StdOut, "<interrupt>\n");
#endif
longjmp (ExitEnv, 1);
}
}
static void (*oldhandler) ();
void InitCompiler (void)
{
InterruptFlag = False;
OpenedFile = (File) NIL;
CompilerError = False;
InName = (char *) NIL;
/* Call all the initialization functions */
/* InitStorage has to be called first */
CurrentModule = Init;
CurrentExt = "";
FreeHeapDescrList = NULL;
InitStorage ();
InitScanner ();
InitParser ();
InitChecker ();
InitTypeChecker ();
InitStatesGen ();
InitCoding ();
InitInstructions ();
#ifdef _COMPSTATS_
InitDB ();
#endif
oldhandler = SetSignal (SetInterruptFlag);
} /* InitCompiler */
void ExitCompiler (void)
{
CompFree();
SetSignal (oldhandler);
OutName = (char *) NIL;
}
#ifdef _DEBUG_
void ErrorInCompiler (char *mod, char *proc, char *msg)
{
if (CurrentModule!=NULL)
FPrintF (StdError,"Error in compiler while compiling %s.icl: Module %s, Function %s, \"%s\"\n",CurrentModule,mod,proc,msg);
else
FPrintF (StdError,"Error in compiler: Module %s, Function %s, \"%s\"\n",mod,proc,msg);
#ifdef CLEAN2
exit (1);
#endif
}
void Assume (Bool cond, char *mod, char *proc)
{
if (! cond)
ErrorInCompiler (mod, proc, "wrong assumption");
}
void AssumeError (char *mod, char *proc)
{
ErrorInCompiler (mod, proc, "wrong assumption");
}
#endif
#if D
void error (void)
{
printf ("error in compiler\n");
}
#endif