Commit 8fa77df3 authored by cvs2snv's avatar cvs2snv
Browse files

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.
definition module backend;
//1.3
from StdString import String;
//3.1
:: *UWorld :== Int;
:: *BackEnd; // :== Int;
:: BESymbolP; // :== Int;
:: BETypeNodeP; // :== Int;
:: BETypeArgP; // :== Int;
:: BETypeAltP; // :== Int;
:: BENodeP; // :== Int;
:: BEArgP; // :== Int;
:: BERuleAltP; // :== Int;
:: BEImpRuleP; // :== Int;
:: BETypeP; // :== Int;
:: BEFlatTypeP; // :== Int;
:: BETypeVarP; // :== Int;
:: BETypeVarListP; // :== Int;
:: BEConstructorListP; // :== Int;
:: BEFieldListP; // :== Int;
:: BENodeIdP; // :== Int;
:: BENodeDefP; // :== Int;
:: BEStrictNodeIdP; // :== Int;
:: BECodeParameterP; // :== Int;
:: BECodeBlockP; // :== Int;
:: BEStringListP; // :== Int;
:: BEAnnotation :== Int;
:: BEAttribution :== Int;
:: BESymbKind :== Int;
:: BEArrayFunKind :== Int;
:: BESelectorKind :== Int;
:: BEUpdateKind :== Int;
BEGetVersion :: (!Int,!Int,!Int);
// void BEGetVersion(int* current,int* oldestDefinition,int* oldestImplementation);
BEInit :: !Int !UWorld -> (!BackEnd,!UWorld);
// BackEnd BEInit(int argc);
BEFree :: !BackEnd !UWorld -> UWorld;
// void BEFree(BackEnd backEnd);
BEArg :: !String !BackEnd -> BackEnd;
// void BEArg(CleanString arg);
BEDeclareModules :: !Int !BackEnd -> BackEnd;
// void BEDeclareModules(int nModules);
BEDeclarePredefinedSymbols :: !Int !Int !BackEnd -> BackEnd;
// void BEDeclarePredefinedSymbols(int nConstructors,int nTypes);
BESpecialArrayFunctionSymbol :: !BEArrayFunKind !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BESpecialArrayFunctionSymbol(BEArrayFunKind arrayFunKind,int functionIndex,int moduleIndex);
BEDictionarySelectFunSymbol :: !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEDictionarySelectFunSymbol();
BEDictionaryUpdateFunSymbol :: !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEDictionaryUpdateFunSymbol();
BEFunctionSymbol :: !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEFunctionSymbol(int functionIndex,int moduleIndex);
BEConstructorSymbol :: !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEConstructorSymbol(int constructorIndex,int moduleIndex);
BEFieldSymbol :: !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEFieldSymbol(int fieldIndex,int moduleIndex);
BETypeSymbol :: !Int !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BETypeSymbol(int typeIndex,int moduleIndex);
BEDontCareDefinitionSymbol :: !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEDontCareDefinitionSymbol();
BEBoolSymbol :: !Bool !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEBoolSymbol(int value);
BELiteralSymbol :: !BESymbKind !String !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BELiteralSymbol(BESymbKind kind,CleanString value);
BEPredefineConstructorSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd;
// void BEPredefineConstructorSymbol(int arity,int constructorIndex,int moduleIndex,BESymbKind symbolKind);
BEPredefineTypeSymbol :: !Int !Int !Int !BESymbKind !BackEnd -> BackEnd;
// void BEPredefineTypeSymbol(int arity,int typeIndex,int moduleIndex,BESymbKind symbolKind);
BEBasicSymbol :: !Int !BackEnd -> (!BESymbolP,!BackEnd);
// BESymbolP BEBasicSymbol(BESymbKind kind);
BEVarTypeNode :: !String !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BEVarTypeNode(CleanString name);
BETypeVars :: !BETypeVarP !BETypeVarListP !BackEnd -> (!BETypeVarListP,!BackEnd);
// BETypeVarListP BETypeVars(BETypeVarP typeVar,BETypeVarListP typeVarList);
BENoTypeVars :: !BackEnd -> (!BETypeVarListP,!BackEnd);
// BETypeVarListP BENoTypeVars();
BENormalTypeNode :: !BESymbolP !BETypeArgP !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BENormalTypeNode(BESymbolP symbol,BETypeArgP args);
BEAnnotateTypeNode :: !BEAnnotation !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BEAnnotateTypeNode(BEAnnotation annotation,BETypeNodeP typeNode);
BEAttributeTypeNode :: !BEAttribution !BETypeNodeP !BackEnd -> (!BETypeNodeP,!BackEnd);
// BETypeNodeP BEAttributeTypeNode(BEAttribution attribution,BETypeNodeP typeNode);
BENoTypeArgs :: !BackEnd -> (!BETypeArgP,!BackEnd);
// BETypeArgP BENoTypeArgs();
BETypeArgs :: !BETypeNodeP !BETypeArgP !BackEnd -> (!BETypeArgP,!BackEnd);
// BETypeArgP BETypeArgs(BETypeNodeP node,BETypeArgP nextArgs);
BETypeAlt :: !BETypeNodeP !BETypeNodeP !BackEnd -> (!BETypeAltP,!BackEnd);
// BETypeAltP BETypeAlt(BETypeNodeP lhs,BETypeNodeP rhs);
BENormalNode :: !BESymbolP !BEArgP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BENormalNode(BESymbolP symbol,BEArgP args);
BEMatchNode :: !Int !BESymbolP !BENodeP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BEMatchNode(int arity,BESymbolP symbol,BENodeP node);
BETupleSelectNode :: !Int !Int !BENodeP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BETupleSelectNode(int arity,int index,BENodeP node);
BEIfNode :: !BENodeP !BENodeP !BENodeP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BEIfNode(BENodeP cond,BENodeP then,BENodeP elsje);
BEGuardNode :: !BENodeP !BENodeDefP !BEStrictNodeIdP !BENodeP !BENodeDefP !BEStrictNodeIdP !BENodeP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BEGuardNode(BENodeP cond,BENodeDefP thenNodeDefs,BEStrictNodeIdP thenStricts,BENodeP then,BENodeDefP elseNodeDefs,BEStrictNodeIdP elseStricts,BENodeP elsje);
BESelectorNode :: !BESelectorKind !BESymbolP !BEArgP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BESelectorNode(BESelectorKind selectorKind,BESymbolP fieldSymbol,BEArgP args);
BEUpdateNode :: !BEArgP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BEUpdateNode(BEArgP args);
BENodeIdNode :: !BENodeIdP !BEArgP !BackEnd -> (!BENodeP,!BackEnd);
// BENodeP BENodeIdNode(BENodeIdP nodeId,BEArgP args);
BENoArgs :: !BackEnd -> (!BEArgP,!BackEnd);
// BEArgP BENoArgs();
BEArgs :: !BENodeP !BEArgP !BackEnd -> (!BEArgP,!BackEnd);
// BEArgP BEArgs(BENodeP node,BEArgP nextArgs);
BERuleAlt :: !Int !BENodeDefP !BENodeP !BENodeDefP !BEStrictNodeIdP !BENodeP !BackEnd -> (!BERuleAltP,!BackEnd);
// BERuleAltP BERuleAlt(int line,BENodeDefP lhsDefs,BENodeP lhs,BENodeDefP rhsDefs,BEStrictNodeIdP lhsStrictNodeIds,BENodeP rhs);
BERuleAlts :: !BERuleAltP !BERuleAltP !BackEnd -> (!BERuleAltP,!BackEnd);
// BERuleAltP BERuleAlts(BERuleAltP alt,BERuleAltP alts);
BENoRuleAlts :: !BackEnd -> (!BERuleAltP,!BackEnd);
// BERuleAltP BENoRuleAlts();
BEDeclareNodeId :: !Int !Int !String !BackEnd -> BackEnd;
// void BEDeclareNodeId(int sequenceNumber,int lhsOrRhs,CleanString name);
BENodeId :: !Int !BackEnd -> (!BENodeIdP,!BackEnd);
// BENodeIdP BENodeId(int sequenceNumber);
BEWildCardNodeId :: !BackEnd -> (!BENodeIdP,!BackEnd);
// BENodeIdP BEWildCardNodeId();
BENodeDef :: !Int !BENodeP !BackEnd -> (!BENodeDefP,!BackEnd);
// BENodeDefP BENodeDef(int sequenceNumber,BENodeP node);
BENoNodeDefs :: !BackEnd -> (!BENodeDefP,!BackEnd);
// BENodeDefP BENoNodeDefs();
BENodeDefs :: !BENodeDefP !BENodeDefP !BackEnd -> (!BENodeDefP,!BackEnd);
// BENodeDefP BENodeDefs(BENodeDefP nodeDef,BENodeDefP nodeDefs);
BEStrictNodeId :: !BENodeIdP !BackEnd -> (!BEStrictNodeIdP,!BackEnd);
// BEStrictNodeIdP BEStrictNodeId(BENodeIdP nodeId);
BENoStrictNodeIds :: !BackEnd -> (!BEStrictNodeIdP,!BackEnd);
// BEStrictNodeIdP BENoStrictNodeIds();
BEStrictNodeIds :: !BEStrictNodeIdP !BEStrictNodeIdP !BackEnd -> (!BEStrictNodeIdP,!BackEnd);
// BEStrictNodeIdP BEStrictNodeIds(BEStrictNodeIdP strictNodeId,BEStrictNodeIdP strictNodeIds);
BERule :: !Int !Int !BETypeAltP !BERuleAltP !BackEnd -> (!BEImpRuleP,!BackEnd);
// BEImpRuleP BERule(int functionIndex,int isCaf,BETypeAltP type,BERuleAltP alts);
BEDeclareRuleType :: !Int !Int !String !BackEnd -> BackEnd;
// void BEDeclareRuleType(int functionIndex,int moduleIndex,CleanString name);
BEDefineRuleType :: !Int !Int !BETypeAltP !BackEnd -> BackEnd;
// void BEDefineRuleType(int functionIndex,int moduleIndex,BETypeAltP typeAlt);
BEAdjustArrayFunction :: !BEArrayFunKind !Int !Int !BackEnd -> BackEnd;
// void BEAdjustArrayFunction(BEArrayFunKind arrayFunKind,int functionIndex,int moduleIndex);
BENoRules :: !BackEnd -> (!BEImpRuleP,!BackEnd);
// BEImpRuleP BENoRules();
BERules :: !BEImpRuleP !BEImpRuleP !BackEnd -> (!BEImpRuleP,!BackEnd);
// BEImpRuleP BERules(BEImpRuleP rule,BEImpRuleP rules);
BETypes :: !BETypeP !BETypeP !BackEnd -> (!BETypeP,!BackEnd);
// BETypeP BETypes(BETypeP type,BETypeP types);
BENoTypes :: !BackEnd -> (!BETypeP,!BackEnd);
// BETypeP BENoTypes();
BEFlatType :: !BESymbolP !BETypeVarListP !BackEnd -> (!BEFlatTypeP,!BackEnd);
// BEFlatTypeP BEFlatType(BESymbolP symbol,BETypeVarListP arguments);
BEAlgebraicType :: !BEFlatTypeP !BEConstructorListP !BackEnd -> BackEnd;
// void BEAlgebraicType(BEFlatTypeP lhs,BEConstructorListP constructors);
BERecordType :: !Int !BEFlatTypeP !BETypeNodeP !BEFieldListP !BackEnd -> BackEnd;
// void BERecordType(int moduleIndex,BEFlatTypeP lhs,BETypeNodeP constructorType,BEFieldListP fields);
BEAbsType :: !BEFlatTypeP !BackEnd -> BackEnd;
// void BEAbsType(BEFlatTypeP lhs);
BEConstructors :: !BEConstructorListP !BEConstructorListP !BackEnd -> (!BEConstructorListP,!BackEnd);
// BEConstructorListP BEConstructors(BEConstructorListP constructor,BEConstructorListP constructors);
BENoConstructors :: !BackEnd -> (!BEConstructorListP,!BackEnd);
// BEConstructorListP BENoConstructors();
BEConstructor :: !BETypeNodeP !BackEnd -> (!BEConstructorListP,!BackEnd);
// BEConstructorListP BEConstructor(BETypeNodeP type);
BEDeclareField :: !Int !Int !String !BackEnd -> BackEnd;
// void BEDeclareField(int fieldIndex,int moduleIndex,CleanString name);
BEField :: !Int !Int !BETypeNodeP !BackEnd -> (!BEFieldListP,!BackEnd);
// BEFieldListP BEField(int fieldIndex,int moduleIndex,BETypeNodeP type);
BEFields :: !BEFieldListP !BEFieldListP !BackEnd -> (!BEFieldListP,!BackEnd);
// BEFieldListP BEFields(BEFieldListP field,BEFieldListP fields);
BENoFields :: !BackEnd -> (!BEFieldListP,!BackEnd);
// BEFieldListP BENoFields();
BEDeclareConstructor :: !Int !Int !String !BackEnd -> BackEnd;
// void BEDeclareConstructor(int constructorIndex,int moduleIndex,CleanString name);