Commit 8fa77df3 authored by cvs2snv's avatar cvs2snv

This commit was manufactured by cvs2svn to create tag 'stable2'.

parent f9a06467
#if ((defined (__MWERKS__) && !defined (__INTEL__)) || defined (__MRC__)) /* && !defined (MAKE_MPW_TOOL) */
# define MAIN_CLM
#endif
#include <stdio.h>
#include <unix.h>
#include <SIOUX.h>
#include <quickdraw.h>
#include <fonts.h>
#include <events.h>
#include <windows.h>
#include <memory.h>
#include <resources.h>
#include <menus.h>
#include <OSUtils.h>
#include "AppleEvents.h"
#include "Gestalt.h"
#include "AERegistry.h"
#include "system.h"
#include "path_cache.h"
#include "compiler.h"
extern void clear_inline_cache (void);
#undef BACKGROUND
#define MW_DEBUG 0
#ifndef BACKGROUND
# undef NO_REDIRECT_STDFILES
# undef STDIO_WINDOW
#endif
#define LINKER
#define CODE_GENERATOR
#undef PROFILE
#if 1
#define kSleepMax 50000
static Boolean gAppleEventsFlag, gQuitFlag;
static long gSleepVal;
static pascal OSErr DoAEOpenApplication (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
{
return noErr;
}
static pascal OSErr DoAEOpenDocuments (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent, long refCon)
{
return errAEEventNotHandled;
}
static pascal OSErr DoAEPrintDocuments (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
{
return errAEEventNotHandled;
}
static pascal OSErr DoAEQuitApplication (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon)
{
gQuitFlag = true;
return noErr;
}
#include <string.h>
extern int CallCompiler (int argc,char **argv);
#ifdef CODE_GENERATOR
# ifdef __cplusplus
extern "C" { int generate_code (int,char **); }
extern int generate_code68 (int,char **);
# else
extern int generate_code (int,char **);
extern int generate_code68__FiPPc (int,char **);
#define generate_code68 generate_code68__FiPPc
# endif
#endif
#ifdef LINKER
# ifdef __cplusplus
extern "C" { int link_application_argc_argv (int,char **); }
# else
extern int link_application_argc_argv (int,char **);
# endif
#endif
char return_error_string[200];
int do_command (char *command)
{
char *p,*(argv[257]);
int argc,result;
int redirect_stdout,redirect_stderr;
result=0;
redirect_stdout=0;
redirect_stderr=0;
argc=0;
p=command;
while (*p==' ' || *p=='\t')
++p;
while (*p!='\0' && argc<256){
if (*p=='>' || *p==''){
int redirection_char;
char *file_name;
redirection_char=*p;
++p;
while (*p==' ' || *p=='\t')
++p;
if (*p=='\0')
break;
if (*p=='\''){
char c,*d_p;
++p;
file_name=p;
d_p=p;
c=*p;
while (!(c=='\'' && p[1]!='\'') && c!='\0'){
*d_p++=c;
if (c=='\'')
++p;
c=*++p;
}
if (*p=='\0'){
*d_p='\0';
break;
}
*d_p='\0';
++p;
} else {
file_name=p;
while (*p!=' ' && *p!='\t' && *p!='\0')
++p;
if (*p!='\0')
*p++='\0';
}
if (redirection_char=='>' && redirect_stdout==0){
#ifndef NO_REDIRECT_STDFILES
freopen (file_name,"w",stdout);
redirect_stdout=1;
#endif
} else if (redirection_char=='' && redirect_stderr==0){
#ifndef NO_REDIRECT_STDFILES
freopen (file_name,"w",stderr);
redirect_stderr=1;
#endif
}
if (*p=='\0')
break;
while (*p==' ' || *p=='\t')
++p;
continue;
}
if (*p=='\''){
char c,*d_p;
++p;
argv[argc]=p;
d_p=p;
c=*p;
while (!(c=='\'' && p[1]!='\'') && c!='\0'){
*d_p++=c;
if (c=='\'')
++p;
c=*++p;
}
if (*p=='\0'){
*d_p='\0';
break;
}
++argc;
*d_p='\0';
++p;
} else {
argv[argc++]=p;
while (*p!=' ' && *p!='\t' && *p!='\0')
++p;
if (*p!='\0')
*p++='\0';
}
while (*p==' ' || *p=='\t')
++p;
}
argv[argc]=NULL;
/* {
int n;
for (n=0; n<argc; ++n)
printf ("%d %s\n",n,argv[n]);
}
*/
if (argc>0){
if (!strcmp (argv[0],"cocl")){
if (argc>=2 && !strcmp ("-clear_cache",argv[1])){
result=CallCompiler (argc-2,&argv[2]);
clear_path_cache();
clear_inline_cache();
FreePathList();
} else
result=CallCompiler (argc-1,&argv[1]);
}
#ifdef CODE_GENERATOR
else if (!strcmp (argv[0],"cg"))
result=generate_code (argc,&argv[0]);
else if (!strcmp (argv[0],"cg68"))
result=generate_code68 (argc,&argv[0]);
#endif
#ifdef LINKER
else if (!strcmp (argv[0],"linker"))
result=link_application_argc_argv (argc,&argv[0]);
#endif
else if (!strcmp (argv[0],"clear_cache")){
clear_path_cache();
clear_inline_cache();
FreePathList();
} else {
result=-1;
strcpy (return_error_string,"unknown command");
}
}
if (redirect_stdout)
fclose (stdout);
if (redirect_stderr)
fclose (stderr);
return result;
}
static char script_string[16001];
static pascal OSErr do_script_apple_event (AppleEvent *apple_event,AppleEvent *replyAppleEvent,long refCon)
{
DescType returned_type;
long actual_size;
int error;
error=AEGetParamPtr (apple_event,keyDirectObject,'TEXT',&returned_type,&script_string,sizeof (script_string),&actual_size);
if (error==noErr && actual_size<=16000){
int return_error_string_length;
script_string[actual_size]='\0';
return_error_string[0]='\0';
#if !MW_DEBUG
error=do_command (script_string);
#endif
return_error_string_length=strlen (return_error_string);
if (return_error_string_length!=0){
AEPutParamPtr (replyAppleEvent,keyErrorString,typeChar,return_error_string,return_error_string_length);
}
}
return error;
}
static void InitAppleEventsStuff (void)
{
OSErr retCode;
if (!gAppleEventsFlag)
return;
retCode = AEInstallEventHandler (kCoreEventClass,kAEOpenApplication,NewAEEventHandlerProc (DoAEOpenApplication),0,false);
if (retCode==noErr)
retCode = AEInstallEventHandler (kCoreEventClass,kAEOpenDocuments,NewAEEventHandlerProc (DoAEOpenDocuments),0,false);
if (retCode==noErr)
retCode = AEInstallEventHandler (kCoreEventClass,kAEPrintDocuments,NewAEEventHandlerProc (DoAEPrintDocuments),0,false);
if (retCode==noErr)
retCode = AEInstallEventHandler (kCoreEventClass,kAEQuitApplication,NewAEEventHandlerProc (DoAEQuitApplication),0,false);
if (retCode==noErr)
retCode = AEInstallEventHandler (kAEMiscStandards,kAEDoScript,NewAEEventHandlerProc (do_script_apple_event),0,false);
if (retCode!=noErr)
DebugStr("\pInstall event handler failed");
}
static void do_high_level_event (EventRecord *theEventRecPtr)
{
#if MW_DEBUG
script_string[0]=0;
#endif
AEProcessAppleEvent (theEventRecPtr);
#if MW_DEBUG
if (script_string[0]){
do_command (script_string);
script_string[0]=0;
}
#endif
}
extern short InstallConsole (short fd);
#ifdef PROFILE
# include <Profiler.h>
#endif
int /*clean_compiler_*/ main (void)
{
OSErr retCode;
long gestResponse;
EventRecord mainEventRec;
Boolean eventFlag;
SetApplLimit (GetApplLimit() - 200*1024);
InitGraf (&qd.thePort);
InitFonts();
FlushEvents (everyEvent,0);
#ifndef BACKGROUND
InitWindows();
InitCursor();
InitMenus();
#endif
_fcreator='3PRM';
gQuitFlag = false;
gSleepVal = kSleepMax;
retCode = Gestalt(gestaltAppleEventsAttr,&gestResponse);
if (retCode==noErr && (gestResponse & (1<<gestaltAppleEventsPresent))!=0)
gAppleEventsFlag = true;
else
gAppleEventsFlag = false;
#ifdef STDIO_WINDOW
SIOUXSettings.autocloseonquit=1;
SIOUXSettings.showstatusline=0;
SIOUXSettings.asktosaveonclose=0;
printf ("\n");
#endif
#if !defined (BACKGROUND) && !defined (STDIO_WINDOW)
fclose (stdout);
fclose (stderr);
#endif
InitAppleEventsStuff();
#ifdef PROFILE
if (ProfilerInit(/*collectSummary*/collectDetailed,bestTimeBase,10000,10)!=0)
return 0;
#endif
while (!gQuitFlag) {
eventFlag = WaitNextEvent (everyEvent,&mainEventRec,gSleepVal,nil);
#ifdef STDIO_WINDOW
if (SIOUXHandleOneEvent (&mainEventRec))
continue;
#endif
if (mainEventRec.what==keyDown)
break;
if (mainEventRec.what==kHighLevelEvent)
do_high_level_event (&mainEventRec);
}
#ifdef PROFILE
ProfilerDump ("\pProfile");
ProfilerTerm();
#endif
return 1;
}
#endif
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
# include "system.h"
# include "comsupport.h"
# include "backendsupport.h"
/*
Utilities
=========
*/
# ifdef _WINDOWS_
# undef _WINDOWS_
# include <windows.h>
# define Debugger() DebugBreak();
# else
# define Debugger() { * (int *) NULL = 0; }
# endif
void
AssertionFailed (char *conditionString, char *file, int line)
{
FPrintF (StdError, "Error in backend: File %s, Line %d (%s)\n", file, line, conditionString);
# ifdef _WINDOWS_
{
static char error[200];
sprintf (error, "Error in backend: File %s, Line %d (%s)\nDebug ?", file, line, conditionString);
if (MessageBox (NULL,error,"AssertionFailed",MB_YESNO)==IDYES)
Debugger ();
}
#else
Debugger ();
#endif
} /* AssertionFailed */
/*
Memory management
=================
*/
static enum {kMemoryInitClear, kMemoryInitSet} gMemoryInit = kMemoryInitSet;
# define kConvertBufferSize (32 * 1024)
typedef struct convert_buffer ConvertBufferS, *ConvertBufferP;
struct convert_buffer
{
ConvertBufferP cb_next;
char cb_memory [kConvertBufferSize];
};
static void
InvalidateMemory (void *memory, size_t size)
{
char value, *p;
int i;
switch (gMemoryInit)
{
case kMemoryInitClear:
value = 0;
break;
case kMemoryInitSet:
value = ~0;
break;
default:
Assert (False);
break;
}
p = memory;
for (i = 0; i < size; i++)
*p++ = value;
} /* InvalidateMemory */
static ConvertBufferP gFirstBuffer = NULL, gCurrentBuffer = NULL;
static char *gMemory;
static long gBytesLeft = 0;
static void
AllocConvertBuffer (void)
{
ConvertBufferP newBuffer;
newBuffer = (ConvertBufferP) malloc (sizeof (ConvertBufferS));
if (newBuffer == NULL)
FatalCompError ("backendsupport.c", "AllocConvertBuffer", "out of memory");
if (gFirstBuffer == NULL)
gCurrentBuffer = gFirstBuffer = newBuffer;
else
gCurrentBuffer = gCurrentBuffer->cb_next = newBuffer;
gCurrentBuffer->cb_next = NULL;
gBytesLeft = kConvertBufferSize;
gMemory = gCurrentBuffer->cb_memory;
InvalidateMemory (gMemory, kConvertBufferSize);
if (gFirstBuffer == NULL)
gFirstBuffer = gCurrentBuffer;
} /* AllocConvertBuffer */
void
FreeConvertBuffers (void)
{
ConvertBufferP buffer;
buffer = gFirstBuffer;
while (buffer != NULL)
{
ConvertBufferP nextBuffer;
nextBuffer = buffer->cb_next;
InvalidateMemory (buffer, sizeof (ConvertBufferS));
free (buffer);
buffer = nextBuffer;
}
gFirstBuffer = NULL;
gCurrentBuffer = NULL;
gBytesLeft = NULL;
} /* FreeConvertBuffers */
void *
ConvertAlloc (SizeT size)
{
void *memory;
size = (size+3) & ~3;
if (size > gBytesLeft)
AllocConvertBuffer ();
Assert (size <= gBytesLeft);
memory = gMemory;
gBytesLeft -= size;
gMemory += size;
return ((void *) memory);
} /* ConvertAlloc */
/*
Clean string
============
*/
typedef struct clean_string {int length; char chars [1]; } *CleanString;
/*
Debugging
=========
*/
extern void AssertionFailed (char *conditionString, char *file, int line);
# define Assert(condition) {if (!(condition)) AssertionFailed ("!(" #condition ")", __FILE__, __LINE__);}
/*
Memory management
=================
*/
extern void FreeConvertBuffers (void);
extern void *ConvertAlloc (SizeT size);
# define ConvertAllocType(t) ((t*) ConvertAlloc (SizeOf (t)))
# define ArraySize(array) ((unsigned) (sizeof (array) / sizeof (array[0])))
\ No newline at end of file
This diff is collapsed.
typedef enum
{
LazyArrayInstance, StrictArrayInstance, UnboxedArrayInstance, NrOfArrayInstances
} ArrayInstance;
typedef enum
{
NoQuantifier, AllQuantifier, ExistQuantifier, ExistAttributeQuantifier
} Quantifier;
typedef enum
{
/* defining symbol */
kUnknownRuleAlternativeKind, /* ':==', '=:', '=>' or '=' */
kUnknownFunctionAlternativeKind, /* '=>' or '=' */
kFunctionAlternativeKind, /* '=' */
kExplicitFunctionAlternativeKind, /* '=>' */
kCAFAlternativeKind, /* '=:' */
kArrowAlternativeKind /* '->' */
} RuleAltKind;
STRUCT (scope, Scope)
{
ImpRules *sc_rulesP;
ImpRule sc_rule;
RuleAlts *sc_altP;
Symbol sc_ruleSymbol;
RuleAltKind sc_altKind;
NodeDefP *sc_nodeDefsP;
NodeDefP *sc_firstNodeDefP;
int sc_scopeMask;
StrictNodeIdP *sc_strictDefsP;
};
extern Args NewArgument (NodeP pattern);
extern NodeP NewNode (SymbolP symb, Args args, int arity);
extern NodeP NewIfNode (void);
extern NodeP NewSelectorNode (SymbolP symb, Args args, int arity);
extern NodeP NewNodeIdNode (NodeIdP node_id);
extern NodeP NewApplyNode (NodeP function_node, Args args, int arity);
extern NodeP NewUpdateNode (SymbolP symb,Args args,int arity);
extern NodeP NewIdentifierNode (IdentP ident, Args args, int arity);
extern NodeP NewNodeByKind (NodeKind nodeKind, SymbolP symb, Args args, int arity);
# define NewNormalNode(symb, args, arity) NewNodeByKind (NormalNode, (symb), (args), (arity))
# define NewRecordNode(symb, args, arity) NewNodeByKind (RecordNode, (symb), (args), (arity))
# define NewMatchNode(symb, args, arity) NewNodeByKind (MatchNode, (symb), (args), (arity))
# define NewCons(element) NewNormalNode (ConsSymbol, element, 2)
# define NewNil() NewNormalNode (NilSymbol, NIL, 0)
# define NewFalse() NewNormalNode (FalseSymbol, NIL, 0)
# define NewTrue() NewNormalNode (TrueSymbol, NIL, 0)
extern NodeP NewIntNode (int value);
extern ImpRules NewRule (unsigned line_number, TypeAlts typeAlternative, NodeP rule_root, ScopeP scope);
extern NodeIdP NewNodeId (IdentP nid);
extern StrictNodeIdP NewStrictNodeId (NodeIdP node_id, StrictNodeIdP next);
extern StrictNodeIdP NewStrictIdent (Ident ident, StrictNodeIdP next);
extern TypeVar NewTypeVar (IdentP nid);
extern UniVar NewUniVar (IdentP nid);
extern NodeDefs NewNodeDefinition (NodeIdP nid, NodeP node);
extern SymbolP NewSymbol (SymbKind symbolKind);
extern TypeNode NewTypeNode (Annotation annot, AttributeKind attr, SymbolP symb, TypeArgs args, int arity);
extern TypeArgs NewTypeArgument (TypeNode pattern);
extern TypeNode NewTypeVarNode (TypeVar node_id,Annotation annot, AttributeKind attr);
extern RuleTypes NewRuleType (TypeAlts type_alt, unsigned line_nr);
extern NodeP NewSelectNode (SymbolP selectSymbol, NodeIdP selectId, int arity);
extern NodeP NewScopeNode (NodeP node, NodeDefP node_defs,ImpRuleS *imp_rules);
extern NodeIdP BuildSelect (NodeP node, NodeDefs **node_defs_p);
extern NodeIdP BuildSelectors (NodeP pattern, NodeP node, NodeDefs **node_defs_p);
extern SymbolP NewSelectSymbol (int arity);
extern SymbolP NewTupleTypeSymbol (int arity);
extern SymbolP NewListFunctionSymbol (void);
extern ImpRules NewImpRule (unsigned line_number,TypeAlts typeAlternative,NodeP rule_root);
extern RuleAltP NewRuleAlt (void);
extern NodeIdP FreshNodeId (NodeP node, NodeDefs **node_defs_h);
extern TypeArgs ConvertFieldsToTypeArguments (FieldList fields);
extern char *CopyString (char *to, char *from, int *rest_size);