diff options
Diffstat (limited to 'backendC')
44 files changed, 808 insertions, 147 deletions
diff --git a/backendC/CleanCompilerSources/apple_main.c b/backendC/CleanCompilerSources/apple_main.c index 2734724..5cb16f2 100644 --- a/backendC/CleanCompilerSources/apple_main.c +++ b/backendC/CleanCompilerSources/apple_main.c @@ -1,4 +1,10 @@ +#include "compiledefines.h" + +#ifdef KARBON +# define TARGET_API_MAC_CARBON 1 +#endif + #include <stdio.h> #include <unix.h> #include <SIOUX.h> @@ -15,6 +21,7 @@ #include "Gestalt.h" #include "AERegistry.h" +#include "types.t" #include "system.h" #include "path_cache.h" #include "compiler.h" @@ -23,6 +30,7 @@ extern void clear_inline_cache (void); #undef BACKGROUND #define MW_DEBUG 0 +#define NO68K #ifndef BACKGROUND # undef NO_REDIRECT_STDFILES @@ -40,22 +48,22 @@ extern void clear_inline_cache (void); static Boolean gAppleEventsFlag, gQuitFlag; static long gSleepVal; -static pascal OSErr DoAEOpenApplication (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon) +static pascal OSErr DoAEOpenApplication (const AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,unsigned long refCon) { return noErr; } -static pascal OSErr DoAEOpenDocuments (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent, long refCon) +static pascal OSErr DoAEOpenDocuments (const AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,unsigned long refCon) { return errAEEventNotHandled; } -static pascal OSErr DoAEPrintDocuments (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon) +static pascal OSErr DoAEPrintDocuments (const AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,unsigned long refCon) { return errAEEventNotHandled; } -static pascal OSErr DoAEQuitApplication (AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,long refCon) +static pascal OSErr DoAEQuitApplication (const AppleEvent *theAppleEvent,AppleEvent *replyAppleEvent,unsigned long refCon) { gQuitFlag = true; return noErr; @@ -68,15 +76,19 @@ extern int CallCompiler (int argc,char **argv); #ifdef CODE_GENERATOR # ifdef __cplusplus extern "C" { int generate_code (int,char **); } +# ifndef NO68K extern int generate_code68 (int,char **); +# endif # else extern int generate_code (int,char **); +# ifndef NO68K extern int generate_code68__FiPPc (int,char **); - #define generate_code68 generate_code68__FiPPc +#define generate_code68 generate_code68__FiPPc +# endif # endif #endif -#ifdef LINKER +#if defined (LINKER) && !defined (NO68K) # ifdef __cplusplus extern "C" { int link_application_argc_argv (int,char **); } # else @@ -104,7 +116,7 @@ int do_command (char *command) ++p; while (*p!='\0' && argc<256){ - if (*p=='>' || *p=='„'){ + if (*p=='>' || *p=='³'){ int redirection_char; char *file_name; @@ -153,7 +165,7 @@ int do_command (char *command) freopen (file_name,"w",stdout); redirect_stdout=1; #endif - } else if (redirection_char=='„' && redirect_stderr==0){ + } else if (redirection_char=='³' && redirect_stderr==0){ #ifndef NO_REDIRECT_STDFILES freopen (file_name,"w",stderr); redirect_stderr=1; @@ -215,6 +227,10 @@ int do_command (char *command) */ if (argc>0){ +#ifdef CLEAN2 + if (0) + ; +#else if (!strcmp (argv[0],"cocl")){ if (argc>=2 && !strcmp ("-clear_cache",argv[1])){ result=CallCompiler (argc-2,&argv[2]); @@ -224,13 +240,16 @@ int do_command (char *command) } else result=CallCompiler (argc-1,&argv[1]); } +#endif #ifdef CODE_GENERATOR else if (!strcmp (argv[0],"cg")) result=generate_code (argc,&argv[0]); +# ifndef NO68K else if (!strcmp (argv[0],"cg68")) result=generate_code68 (argc,&argv[0]); +# endif #endif -#ifdef LINKER +#if defined (LINKER) && !defined (NO68K) else if (!strcmp (argv[0],"linker")) result=link_application_argc_argv (argc,&argv[0]); #endif @@ -255,7 +274,13 @@ int do_command (char *command) static char script_string[16001]; -static pascal OSErr do_script_apple_event (AppleEvent *apple_event,AppleEvent *replyAppleEvent,long refCon) +#ifdef CLEAN2 +int compiler_id; +#else +extern int compiler_id; +#endif + +pascal OSErr do_script_apple_event (const AppleEvent *apple_event,AppleEvent *replyAppleEvent,unsigned long refCon) { DescType returned_type; long actual_size; @@ -272,7 +297,13 @@ static pascal OSErr do_script_apple_event (AppleEvent *apple_event,AppleEvent *r #if !MW_DEBUG error=do_command (script_string); #endif - + + if (compiler_id>=0){ + error += (compiler_id+1)<<1; + + compiler_id = -1; + } + 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); @@ -337,16 +368,22 @@ int /*clean_compiler_*/ main (void) EventRecord mainEventRec; Boolean eventFlag; +#ifndef KARBON SetApplLimit (GetApplLimit() - 200*1024); InitGraf (&qd.thePort); InitFonts(); +#endif FlushEvents (everyEvent,0); #ifndef BACKGROUND +# ifndef KARBON InitWindows(); +# endif InitCursor(); +# ifndef KARBON InitMenus(); +# endif #endif _fcreator='3PRM'; @@ -360,7 +397,7 @@ int /*clean_compiler_*/ main (void) else gAppleEventsFlag = false; -#ifdef STDIO_WINDOW +#if defined (STDIO_WINDOW) SIOUXSettings.autocloseonquit=1; SIOUXSettings.showstatusline=0; SIOUXSettings.asktosaveonclose=0; diff --git a/backendC/CleanCompilerSources/backend.c b/backendC/CleanCompilerSources/backend.c index 6d22e0c..7dd78eb 100644 --- a/backendC/CleanCompilerSources/backend.c +++ b/backendC/CleanCompilerSources/backend.c @@ -1,8 +1,9 @@ #define CODE_INLINE_FLAG #define DYNAMIC_TYPE 1 -# include "system.h" # include "compiledefines.h" +# include "types.t" +# include "system.h" # include "syntaxtr.t" # include "codegen_types.h" # include "statesgen.h" @@ -1022,6 +1023,52 @@ BELiteralSymbol (BESymbKind kind, CleanString value) return (symbol); } /* BELiteralSymbol */ +#if STRICT_LISTS +void BEPredefineListConstructorSymbol(int arity,int constructorIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness) +{ + BEModuleP module; + SymbolP symbol_p; + + Assert (moduleIndex == kPredefinedModuleIndex); + + Assert ((unsigned int) moduleIndex < gBEState.be_nModules); + module = &gBEState.be_modules [moduleIndex]; + + Assert ((unsigned int) constructorIndex < module->bem_nConstructors); + + symbol_p=module->bem_constructors [constructorIndex]; + + Assert (symbol_p->symb_kind == erroneous_symb); + + symbol_p->symb_kind = symbolKind; + symbol_p->symb_arity = arity; + symbol_p->symb_head_strictness=head_strictness; + symbol_p->symb_tail_strictness=tail_strictness; +} + +void BEPredefineListTypeSymbol(int typeIndex,int moduleIndex,BESymbKind symbolKind,int head_strictness,int tail_strictness) +{ + BEModuleP module; + SymbolP symbol_p; + + Assert (moduleIndex == kPredefinedModuleIndex); + + Assert ((unsigned int) moduleIndex < gBEState.be_nModules); + module = &gBEState.be_modules [moduleIndex]; + + Assert ((unsigned int) typeIndex < module->bem_nTypes); + + symbol_p=module->bem_types [typeIndex]; + + Assert (symbol_p->symb_kind == erroneous_symb); + + symbol_p->symb_kind = symbolKind; + symbol_p->symb_arity = 1; + symbol_p->symb_head_strictness=head_strictness; + symbol_p->symb_tail_strictness=tail_strictness; +} +#endif + void BEPredefineConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind) { @@ -2532,6 +2579,26 @@ BEGenerateCode (CleanString outputFile) gBEState.be_icl.beicl_module->im_rules = rule; outputFileName = ConvertCleanString (outputFile); + +#if 0 + { + File f; + + f=fopen ("Rules","w"); + if (f){ + ImpRuleS *rule; + + for (rule=gBEState.be_icl.beicl_module->im_rules; rule!=NULL; rule=rule->rule_next){ + PrintImpRule (rule,4,f); + + if (rule->rule_next!=NULL) + FPutC ('\n',f); + } + fclose (f); + } + } +#endif + CodeGeneration (gBEState.be_icl.beicl_module, outputFileName); return (!CompilerError); diff --git a/backendC/CleanCompilerSources/backend.h b/backendC/CleanCompilerSources/backend.h index 0c46787..70d9e2a 100644 --- a/backendC/CleanCompilerSources/backend.h +++ b/backendC/CleanCompilerSources/backend.h @@ -200,6 +200,14 @@ Clean (BEBoolSymbol :: Bool BackEnd -> (BESymbolP, BackEnd)) BESymbolP BELiteralSymbol (BESymbKind kind, CleanString value); Clean (BELiteralSymbol :: BESymbKind String BackEnd -> (BESymbolP, BackEnd)) +/* +void BEPredefineListConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness); +Clean (BEPredefineListConstructorSymbol :: Int Int Int BESymbKind Int Int BackEnd -> BackEnd) + +void BEPredefineListTypeSymbol (int typeIndex, int moduleIndex, BESymbKind symbolKind,int head_strictness,int tail_strictness); +Clean (BEPredefineListTypeSymbol :: Int Int BESymbKind Int Int BackEnd -> BackEnd) +*/ + void BEPredefineConstructorSymbol (int arity, int constructorIndex, int moduleIndex, BESymbKind symbolKind); Clean (BEPredefineConstructorSymbol :: Int Int Int BESymbKind BackEnd -> BackEnd) diff --git a/backendC/CleanCompilerSources/backendsupport.c b/backendC/CleanCompilerSources/backendsupport.c index 98fb777..b2d4fe2 100644 --- a/backendC/CleanCompilerSources/backendsupport.c +++ b/backendC/CleanCompilerSources/backendsupport.c @@ -1,3 +1,6 @@ + +# include "compiledefines.h" +# include "types.t" # include "system.h" # include "comsupport.h" # include "backendsupport.h" @@ -30,6 +33,36 @@ AssertionFailed (char *conditionString, char *file, int line) Debugger (); } #else +# ifdef _MAC_ + { + FILE *f; + + f=fopen ("AssertionFailedError","w"); + if (f!=NULL){ + FPrintF (f, "Error in backend: File %s, Line %d (%s)\n", file, line, conditionString); + fclose (f); + } + } +# endif Debugger (); #endif } /* AssertionFailed */ + +void +fatal_backend_error (char *s) +{ + FPrintF (StdError, "Error in backend: %s\n", s); + +#ifdef _MAC_ + { + FILE *f; + + f=fopen ("AssertionFailedError","w"); + if (f!=NULL){ + FPrintF (f, "Error in backend: %s\n", s); + fclose (f); + } + } +#endif + Debugger (); +} diff --git a/backendC/CleanCompilerSources/backendsupport.h b/backendC/CleanCompilerSources/backendsupport.h index d0ea9eb..084ff30 100644 --- a/backendC/CleanCompilerSources/backendsupport.h +++ b/backendC/CleanCompilerSources/backendsupport.h @@ -12,6 +12,8 @@ typedef struct clean_string {int length; char chars [1]; } *CleanString; extern void AssertionFailed (char *conditionString, char *file, int line); # define Assert(condition) {if (!(condition)) AssertionFailed ("!(" #condition ")", __FILE__, __LINE__);} +extern void fatal_backend_error (char *s); + /* Memory management ================= diff --git a/backendC/CleanCompilerSources/buildtree.c b/backendC/CleanCompilerSources/buildtree.c index 61b6a74..471b33a 100644 --- a/backendC/CleanCompilerSources/buildtree.c +++ b/backendC/CleanCompilerSources/buildtree.c @@ -1,3 +1,5 @@ + +# include "compiledefines.h" # include "types.t" # include "syntaxtr.t" # include "comsupport.h" @@ -15,6 +17,15 @@ SymbolP BasicTypeSymbols [Nr_Of_Basic_Types], EmptyTypeSymbol, TupleTypeSymbols [MaxNodeArity]; +#if STRICT_LISTS +SymbolP + StrictListSymbol, StrictConsSymbol, StrictNilSymbol, + UnboxedListSymbol, UnboxedConsSymbol, UnboxedNilSymbol, + TailStrictListSymbol, TailStrictConsSymbol, TailStrictNilSymbol, + StrictTailStrictListSymbol, StrictTailStrictConsSymbol, StrictTailStrictNilSymbol, + UnboxedTailStrictListSymbol, UnboxedTailStrictConsSymbol, UnboxedTailStrictNilSymbol; +#endif + char BasicTypeIds [] = BASIC_TYPE_IDS_STRING; IdentP gArrayIdents [NrOfArrayInstances]; diff --git a/backendC/CleanCompilerSources/buildtree.h b/backendC/CleanCompilerSources/buildtree.h index d91ef3b..7f330c5 100644 --- a/backendC/CleanCompilerSources/buildtree.h +++ b/backendC/CleanCompilerSources/buildtree.h @@ -53,6 +53,15 @@ extern NodeP NewNodeByKind (NodeKind nodeKind, SymbolP symb, Args args, int arit # define NewNil() NewNormalNode (NilSymbol, NIL, 0) # define NewFalse() NewNormalNode (FalseSymbol, NIL, 0) # define NewTrue() NewNormalNode (TrueSymbol, NIL, 0) + +#if STRICT_LISTS +# define NewStrictNil() NewNormalNode (StrictNilSymbol, NIL, 0) +# define NewUnboxedNil() NewNormalNode (UnboxedNilSymbol, NIL, 0) +# define NewTailStrictNil() NewNormalNode (TailStrictNilSymbol, NIL, 0) +# define NewStrictTailStrictNil() NewNormalNode (StrictTailStrictNilSymbol, NIL, 0) +# define NewUnboxedTailStrictNil() NewNormalNode (UnboxedTailStrictNilSymbol, NIL, 0) +#endif + extern NodeP NewIntNode (int value); extern ImpRules NewRule (unsigned line_number, TypeAlts typeAlternative, NodeP rule_root, ScopeP scope); @@ -101,6 +110,14 @@ extern SymbolP BasicTypeSymbols [], TrueSymbol, FalseSymbol, TupleSymbol, ListSymbol, ConsSymbol, NilSymbol, ApplySymbol, ApplyTypeSymbol, SelectSymbols[], FailSymbol, IfSymbol, AllSymbol, EmptyTypeSymbol; +#if STRICT_LISTS +extern SymbolP + StrictListSymbol, StrictConsSymbol, StrictNilSymbol, + UnboxedListSymbol, UnboxedConsSymbol, UnboxedNilSymbol, + TailStrictListSymbol, TailStrictConsSymbol, TailStrictNilSymbol, + StrictTailStrictListSymbol, StrictTailStrictConsSymbol, StrictTailStrictNilSymbol, + UnboxedTailStrictListSymbol, UnboxedTailStrictConsSymbol, UnboxedTailStrictNilSymbol; +#endif extern SymbolP TupleTypeSymbols []; IdentP UseArrayFunctionId (ArrayFunKind kind); diff --git a/backendC/CleanCompilerSources/checker.h b/backendC/CleanCompilerSources/checker.h index 6380ec4..1a0121d 100644 --- a/backendC/CleanCompilerSources/checker.h +++ b/backendC/CleanCompilerSources/checker.h @@ -7,6 +7,9 @@ extern Ident AnnotatedId, ListId, TupleId, ConsId, NilId, ApplyId, SelectId, IfId, FailId, DeltaBId, AndId, OrId, StdArrayId, ArrayFunctionIds [], ArrayId, StrictArrayId, UnboxedArrayId, ArrayClassId; +#if STRICT_LISTS +extern Ident StrictListId,UnboxedListId,TailStrictListId,StrictTailStrictListId,UnboxedTailStrictListId; +#endif #ifdef CLEAN2 extern Ident DynamicId; #endif diff --git a/backendC/CleanCompilerSources/checker_2.c b/backendC/CleanCompilerSources/checker_2.c index 3502cc2..3a7694b 100644 --- a/backendC/CleanCompilerSources/checker_2.c +++ b/backendC/CleanCompilerSources/checker_2.c @@ -12,6 +12,7 @@ #define MOVE_CURRIED_APPLICATIONS #define MOVE_FUNCTIONS_IN_LAMBDAS +#include "compiledefines.h" #include "types.t" #include "system.h" #include "syntaxtr.t" diff --git a/backendC/CleanCompilerSources/checksupport.c b/backendC/CleanCompilerSources/checksupport.c index 9605040..70f7406 100644 --- a/backendC/CleanCompilerSources/checksupport.c +++ b/backendC/CleanCompilerSources/checksupport.c @@ -1,4 +1,5 @@ +#include "compiledefines.h" #include "types.t" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/checktypedefs_2.c b/backendC/CleanCompilerSources/checktypedefs_2.c index beb51ce..23ebcc3 100644 --- a/backendC/CleanCompilerSources/checktypedefs_2.c +++ b/backendC/CleanCompilerSources/checktypedefs_2.c @@ -8,6 +8,7 @@ #define COMPLEX_ABSTYPES +#include "compiledefines.h" #include "types.t" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/cocl.c b/backendC/CleanCompilerSources/cocl.c index b423459..2d91077 100644 --- a/backendC/CleanCompilerSources/cocl.c +++ b/backendC/CleanCompilerSources/cocl.c @@ -1,9 +1,9 @@ #include "compiledefines.h" -#include "system.h" -#include <ctype.h> #include "comsupport.h" #include "settings.h" +#include "system.h" +#include <ctype.h> #include "compiler.h" #include "version.h" diff --git a/backendC/CleanCompilerSources/codegen.c b/backendC/CleanCompilerSources/codegen.c index d3dba60..6109d4a 100644 --- a/backendC/CleanCompilerSources/codegen.c +++ b/backendC/CleanCompilerSources/codegen.c @@ -4,6 +4,8 @@ #define SHARE_UPDATE_CODE 0 /* also in codegen1.c */ #define SELECTORS_FIRST 1 /* also in codegen2.c */ +#include "compiledefines.h" +#include "types.t" #include "system.h" #include "syntaxtr.t" #include "comsupport.h" @@ -26,7 +28,6 @@ # if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION #include "tuple_tail_recursion.h" # endif -#include "dbprint.h" static char *ECodeBlock = "incorrect number of output parameters"; diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c index 64361f4..f41f5a8 100644 --- a/backendC/CleanCompilerSources/codegen1.c +++ b/backendC/CleanCompilerSources/codegen1.c @@ -9,8 +9,9 @@ #define FREE_STRICT_LHS_TUPLE_ELEMENTS 1 /* also in codegen2.c */ #define BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS 1 +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" @@ -88,6 +89,11 @@ LabDef tuple_lab = {NULL, "", False, "_Tuple", 0}; LabDef empty_lab = {NULL, "", False, "_", 0}; LabDef add_arg_lab = {NULL, "", False, "_add_arg", 0}; LabDef match_error_lab = {NULL, "", False, "_match_error", 0}; +#if STRICT_LISTS +LabDef conss_lab = {NULL, "", False, "_Conss", 0}; +LabDef consts_lab = {NULL, "", False, "_Consts", 0}; +LabDef conssts_lab = {NULL, "", False, "_Conssts", 0}; +#endif #ifdef CLEAN2 LabDef select_with_dictionary_lab = {NULL, "", False, "_select_with_dictionary", 0}; LabDef update_with_dictionary_lab = {NULL, "", False, "_update_with_dictionary", 0}; diff --git a/backendC/CleanCompilerSources/codegen1.h b/backendC/CleanCompilerSources/codegen1.h index d388317..a93e19d 100644 --- a/backendC/CleanCompilerSources/codegen1.h +++ b/backendC/CleanCompilerSources/codegen1.h @@ -16,6 +16,9 @@ extern char channel_code [],ext_nf_reducer_code[],nf_reducer_code[],hnf_reducer_ extern LabDef cycle_lab, reserve_lab, type_error_lab, indirection_lab, ind_lab, hnf_lab, cons_lab, nil_lab, tuple_lab, empty_lab, add_arg_lab, match_error_lab, +#if STRICT_LISTS + conss_lab,consts_lab,conssts_lab, +#endif #ifdef CLEAN2 select_with_dictionary_lab, update_with_dictionary_lab, #endif diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c index 4dcfd77..f1f738b 100644 --- a/backendC/CleanCompilerSources/codegen2.c +++ b/backendC/CleanCompilerSources/codegen2.c @@ -14,6 +14,8 @@ #define FREE_STRICT_LHS_TUPLE_ELEMENTS 1 /* also in codegen1.c */ #define SELECTORS_FIRST 1 /* also in codegen.c */ +#include "compiledefines.h" +#include "types.t" #include "system.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/codegen3.c b/backendC/CleanCompilerSources/codegen3.c index d1682c6..ba675c8 100644 --- a/backendC/CleanCompilerSources/codegen3.c +++ b/backendC/CleanCompilerSources/codegen3.c @@ -10,6 +10,8 @@ #define for_li(v,i,l,n) for(v=(l),i=0;v!=NULL;v=v->n,++i) #define for_ll(v1,v2,l1,l2,n1,n2) for(v1=(l1),v2=(l2);v1!=NULL;v1=v1->n1,v2=v2->n2) +#include "compiledefines.h" +#include "types.t" #include "system.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/comparser_2.c b/backendC/CleanCompilerSources/comparser_2.c index 3a257ae..c784f16 100644 --- a/backendC/CleanCompilerSources/comparser_2.c +++ b/backendC/CleanCompilerSources/comparser_2.c @@ -13,6 +13,7 @@ # undef H +# include "compiledefines.h" # include "types.t" # include "syntaxtr.t" @@ -119,6 +120,78 @@ InitParser (void) ListSymbol = NewSymbol (list_type); ConsSymbol = NewSymbol (cons_symb); NilSymbol = NewSymbol (nil_symb); + +#if STRICT_LISTS + ListSymbol->symb_head_strictness=0; + ListSymbol->symb_tail_strictness=0; + + ConsSymbol->symb_head_strictness=0; + ConsSymbol->symb_tail_strictness=0; + + NilSymbol->symb_head_strictness=0; + NilSymbol->symb_tail_strictness=0; + + StrictListSymbol= NewSymbol (list_type); + StrictListSymbol->symb_head_strictness=1; + StrictListSymbol->symb_tail_strictness=0; + + UnboxedListSymbol= NewSymbol (list_type); + UnboxedListSymbol->symb_head_strictness=2; + UnboxedListSymbol->symb_tail_strictness=0; + + TailStrictListSymbol= NewSymbol (list_type); + TailStrictListSymbol->symb_head_strictness=0; + TailStrictListSymbol->symb_tail_strictness=1; + + StrictTailStrictListSymbol= NewSymbol (list_type); + StrictTailStrictListSymbol->symb_head_strictness=1; + StrictTailStrictListSymbol->symb_tail_strictness=1; + + UnboxedTailStrictListSymbol= NewSymbol (list_type); + UnboxedTailStrictListSymbol->symb_head_strictness=2; + UnboxedTailStrictListSymbol->symb_tail_strictness=1; + + StrictConsSymbol= NewSymbol (cons_symb); + StrictConsSymbol->symb_head_strictness=1; + StrictConsSymbol->symb_tail_strictness=0; + + UnboxedConsSymbol= NewSymbol (cons_symb); + UnboxedConsSymbol->symb_head_strictness=2; + UnboxedConsSymbol->symb_tail_strictness=0; + + TailStrictConsSymbol= NewSymbol (cons_symb); + TailStrictConsSymbol->symb_head_strictness=0; + TailStrictConsSymbol->symb_tail_strictness=1; + + StrictTailStrictConsSymbol= NewSymbol (cons_symb); + StrictTailStrictConsSymbol->symb_head_strictness=1; + StrictTailStrictConsSymbol->symb_tail_strictness=1; + + UnboxedTailStrictConsSymbol= NewSymbol (cons_symb); + UnboxedTailStrictConsSymbol->symb_head_strictness=2; + UnboxedTailStrictConsSymbol->symb_tail_strictness=1; + + StrictNilSymbol = NewSymbol (nil_symb); + StrictNilSymbol->symb_head_strictness=1; + StrictNilSymbol->symb_tail_strictness=0; + + UnboxedNilSymbol = NewSymbol (nil_symb); + UnboxedNilSymbol->symb_head_strictness=2; + UnboxedNilSymbol->symb_tail_strictness=0; + + TailStrictNilSymbol = NewSymbol (nil_symb); + TailStrictNilSymbol->symb_head_strictness=0; + TailStrictNilSymbol->symb_tail_strictness=1; + + StrictTailStrictNilSymbol = NewSymbol (nil_symb); + StrictTailStrictNilSymbol->symb_head_strictness=1; + StrictTailStrictNilSymbol->symb_tail_strictness=1; + + UnboxedTailStrictNilSymbol = NewSymbol (nil_symb); + UnboxedTailStrictNilSymbol->symb_head_strictness=2; + UnboxedTailStrictNilSymbol->symb_tail_strictness=1; +#endif + ApplySymbol = NewSymbol (apply_symb); FailSymbol = NewSymbol (fail_symb); AllSymbol = NewSymbol (all_symb); diff --git a/backendC/CleanCompilerSources/compiledefines.h b/backendC/CleanCompilerSources/compiledefines.h index 2157bb8..b7d762d 100644 --- a/backendC/CleanCompilerSources/compiledefines.h +++ b/backendC/CleanCompilerSources/compiledefines.h @@ -17,3 +17,7 @@ #define IMPORT_OBJ_AND_LIB 1 #define WRITE_DCL_MODIFICATION_TIME 1 + +#define STRICT_LISTS 0 + +#undef KARBON
\ No newline at end of file diff --git a/backendC/CleanCompilerSources/compiler.c b/backendC/CleanCompilerSources/compiler.c index fe3125f..be619f6 100644 --- a/backendC/CleanCompilerSources/compiler.c +++ b/backendC/CleanCompilerSources/compiler.c @@ -1,8 +1,9 @@ #undef PROFILE +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/comsupport.c b/backendC/CleanCompilerSources/comsupport.c index a3e5201..bb0d320 100644 --- a/backendC/CleanCompilerSources/comsupport.c +++ b/backendC/CleanCompilerSources/comsupport.c @@ -14,6 +14,8 @@ Version: 1.0 */ +#include "compiledefines.h" +#include "types.t" #include "system.h" #include "sizes.h" #include "cmdline.h" @@ -323,6 +325,17 @@ void FatalCompError (char *mod, char *proc, char *mess) OpenedFile = (File) NIL; } #ifdef CLEAN2 +# ifdef _MAC_ + { + FILE *f; + + f=fopen ("FatalCompError","w"); + if (f!=NULL){ + FPrintF (f,"Fatal Error in %s:%s \"%s\"\n", mod, proc, mess); + fclose (f); + } + } +# endif exit (1); #else longjmp (ExitEnv, 1); @@ -669,6 +682,20 @@ void ErrorInCompiler (char *mod, char *proc, char *msg) FPrintF (StdError,"Error in compiler: Module %s, Function %s, \"%s\"\n",mod,proc,msg); #ifdef CLEAN2 +# ifdef _MAC_ + { + FILE *f; + + f=fopen ("ErrorInCompiler","w"); + if (f!=NULL){ + if (CurrentModule!=NULL) + FPrintF (f,"Error in compiler while compiling %s.icl: Module %s, Function %s, \"%s\"\n",CurrentModule,mod,proc,msg); + else + FPrintF (f,"Error in compiler: Module %s, Function %s, \"%s\"\n",mod,proc,msg); + fclose (f); + } + } +# endif exit (1); #endif } diff --git a/backendC/CleanCompilerSources/dbprint.c b/backendC/CleanCompilerSources/dbprint.c index 2e3fc36..a864bdf 100644 --- a/backendC/CleanCompilerSources/dbprint.c +++ b/backendC/CleanCompilerSources/dbprint.c @@ -1,4 +1,6 @@ +#include "compiledefines.h" +#include "types.t" #include "system.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c index d9c9512..80ecb14 100644 --- a/backendC/CleanCompilerSources/instructions.c +++ b/backendC/CleanCompilerSources/instructions.c @@ -6,6 +6,7 @@ #pragma segment instructions #include "compiledefines.h" +#include "comsupport.h" #include "system.h" #include <ctype.h> @@ -18,7 +19,6 @@ #include "codegen_types.h" #include "codegen1.h" #include "codegen2.h" -#include "comsupport.h" #include "instructions.h" #include "statesgen.h" #include "version.h" @@ -3254,15 +3254,23 @@ void GenSystemImports (void) GenImpLab_node_entry (indirection_lab.lab_name,"_eaind"); GenImpDesc ("e_system_dif"); GenImpLab_node_entry ("e_system_nif","e_system_eaif"); + GenImpLab ("e_system_sif"); + GenImpDesc ("e_system_dAP"); GenImpLab_node_entry ("e_system_nAP","e_system_eaAP"); - - GenImpLab ("e_system_sif"); GenImpLab ("e_system_sAP"); - GenImpDesc (cons_lab.lab_name); + GenImpDesc (nil_lab.lab_name); + GenImpDesc (cons_lab.lab_name); +#if STRICT_LISTS + GenImpDesc (conss_lab.lab_name); + GenImpLab_node_entry ("n_Conss","ea_Conss"); + GenImpDesc (consts_lab.lab_name); + GenImpLab_node_entry ("n_Consts","ea_Consts"); + GenImpDesc (conssts_lab.lab_name); + GenImpLab_node_entry ("n_Conssts","ea_Conssts"); +#endif GenImpDesc (tuple_lab.lab_name); - for (selnum=1; selnum<=NrOfGlobalSelectors; ++selnum){ put_directive_b (impdesc); FPrintF (OutFile,D_PREFIX "%s.%d",glob_sel,selnum); @@ -3285,11 +3293,6 @@ void GenParameters (Bool input, Parameters params, int asp, int bsp) { int is_first_parameter; -/* RWS ... ??? */ - if (params==NULL) - return; -/* ... RWS */ - if (input) put_instruction_ (Iin); else diff --git a/backendC/CleanCompilerSources/mac.h b/backendC/CleanCompilerSources/mac.h index 9b55823..07aea6a 100644 --- a/backendC/CleanCompilerSources/mac.h +++ b/backendC/CleanCompilerSources/mac.h @@ -66,5 +66,5 @@ extern int open_dcl_file_for_block_reading (char *fname,File *file_p); extern int read_next_block_from_dcl_file (char *buffer); #if WRITE_DCL_MODIFICATION_TIME -extern int open_dcl_file_for_block_reading_with_file_time (char *file_name,File *file_p,unsigned long *file_time_p); +extern int open_dcl_file_for_block_reading_with_file_time (char *file_name,File *file_p,FileTime *file_time_p); #endif
\ No newline at end of file diff --git a/backendC/CleanCompilerSources/mac_io.c b/backendC/CleanCompilerSources/mac_io.c index e169074..bd2b55e 100644 --- a/backendC/CleanCompilerSources/mac_io.c +++ b/backendC/CleanCompilerSources/mac_io.c @@ -1,4 +1,10 @@ +#include "compiledefines.h" + +#ifdef KARBON +# define TARGET_API_MAC_CARBON 1 +#endif + #define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n) #if defined (applec) || defined (__MWERKS__) || defined (__MRC__) @@ -18,6 +24,7 @@ #include "compiledefines.h" #ifndef _SYSTEM_ +# include "types.t" # include "system.h" #endif @@ -61,35 +68,96 @@ static unsigned char *copy_c_to_p_string (char *c_string,char *p_string) return (unsigned char*) p_string; } -static FileTime FindFileTime (char *fname,int wd_ref_num) -{ - int err; - FileParam fpb; - char p_string [256]; +#ifdef KARBON + static int FindFileUTCDateTime0 (char *fname,UTCDateTime *file_time_p) + { + int err; + FSCatalogInfo catalog_info; + FSRef fs_ref; + FSSpec fs_spec; - fpb.ioNamePtr=copy_c_to_p_string (fname,p_string); - fpb.ioFDirIndex=0; - fpb.ioFVersNum=0; - fpb.ioVRefNum=wd_ref_num; + copy_c_to_p_string (fname,(char*)&fs_spec.name); + fs_spec.parID=0; + fs_spec.vRefNum=0; -#ifdef mpwc - err = PBGetFInfoSync ((ParmBlkPtr)&fpb); + err = FSpMakeFSRef (&fs_spec,&fs_ref); + if (err) + return 0; + + err = FSGetCatalogInfo (&fs_ref,kFSCatInfoContentMod,&catalog_info,NULL,NULL,NULL); + if (err) + return 0; + else { + *file_time_p=catalog_info.contentModDate; + + return 1; + } + } + + static int FindFileUTCDateTime (char *fname,struct vd_id vd_id,UTCDateTime *file_time_p) + { + int err; + FSCatalogInfo catalog_info; + FSRef fs_ref; + FSSpec fs_spec; + + copy_c_to_p_string (fname,(char*)&fs_spec.name); + fs_spec.parID=vd_id.directory_id; + fs_spec.vRefNum=vd_id.volume_id; + + err = FSpMakeFSRef (&fs_spec,&fs_ref); + if (err) + return 0; + + err = FSGetCatalogInfo (&fs_ref,kFSCatInfoContentMod,&catalog_info,NULL,NULL,NULL); + if (err!=0) + return 0; + else { + *file_time_p=catalog_info.contentModDate; + + return 1; + } + } +#else + static FileTime FindFileTime (char *fname,int wd_ref_num) + { + int err; + FileParam fpb; + char p_string [256]; + + fpb.ioNamePtr=copy_c_to_p_string (fname,p_string); + fpb.ioFDirIndex=0; + fpb.ioFVersNum=0; + fpb.ioVRefNum=wd_ref_num; + +#ifdef KARBON + err = PBHGetFInfo ((HParmBlkPtr)&fpb,0); #else - err = PBGetFInfo (&fpb, 0); +# ifdef mpwc + err = PBGetFInfoSync ((ParmBlkPtr)&fpb); +# else + err = PBGetFInfo (&fpb, 0); +# endif #endif - if (err) - return NoFile; - else - return fpb.ioFlMdDat; -} + if (err) + return NoFile; + else + return fpb.ioFlMdDat; + } +#endif char *PATHLIST; #ifdef mpwc struct path_list { +# ifdef KARBON + struct vd_id path_vd_id; + struct vd_id path_clean_system_files_vd_id; +# else short path_wd_ref_num; short path_clean_system_files_wd_ref_num; +# endif struct path_list * path_next; #if defined (__MWERKS__) || defined (__MRC__) char path_name[]; @@ -102,12 +170,18 @@ static struct path_list *path_list=NULL; static void add_directory_to_path_list (char *path_name,struct path_list **old_path_list_h) { - short wd_ref_num,clean_system_files_wd_ref_num; struct path_list *new_path,**last_path_p; int path_name_length; char p_string [256]; +#ifdef KARBON + struct vd_id vd_id,clean_system_files_vd_id; + FSSpec fs_spec; + FSRef fs_ref; +#else + short wd_ref_num,clean_system_files_wd_ref_num; CInfoPBRec fpb; WDPBRec wd_pb; +#endif int err,root_path; root_path=0; @@ -125,6 +199,24 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p } } +#ifdef KARBON + vd_id.volume_id=0; + vd_id.directory_id=0; + err = FSMakeFSSpec (0,0,path_name ? copy_c_to_p_string (path_name,p_string) : (unsigned char*)"\001:",&fs_spec); + if (err==0){ + err = FSpMakeFSRef (&fs_spec,&fs_ref); + if (err==0){ + FSCatalogInfo catalog_info; + + err = FSGetCatalogInfo (&fs_ref,kFSCatInfoVolume|kFSCatInfoNodeID,&catalog_info,NULL,NULL,NULL); + + if (err==0){ + vd_id.volume_id=catalog_info.volume; + vd_id.directory_id=catalog_info.nodeID; + } + } + } +#else if (path_name) fpb.hFileInfo.ioNamePtr=copy_c_to_p_string (path_name,p_string); else @@ -135,6 +227,7 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p fpb.hFileInfo.ioDirID=0; err = PBGetCatInfoSync (&fpb); +#endif if (err!=0){ #ifdef FOLDER_DOES_NOT_EXIST_ERRORS @@ -148,6 +241,7 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p return; } +#ifndef KARBON wd_pb.ioNamePtr=fpb.hFileInfo.ioNamePtr; wd_pb.ioWDProcID='ClCo'; @@ -169,6 +263,7 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p } wd_ref_num=wd_pb.ioVRefNum; +#endif #ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS if (path_name){ @@ -178,7 +273,38 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p strcat (path_name,":Clean System Files"); } else path_name="Clean System Files"; + +# ifdef KARBON + clean_system_files_vd_id.volume_id=0; + clean_system_files_vd_id.directory_id=0; + err = FSMakeFSSpec (0,0,copy_c_to_p_string (path_name,p_string),&fs_spec); + + if (err==fnfErr){ + long dir_id; + + err=FSpDirCreate (&fs_spec,smSystemScript,&dir_id); + } + + if (err==0){ + err = FSpMakeFSRef (&fs_spec,&fs_ref); + if (err==0){ + FSCatalogInfo catalog_info; + + err = FSGetCatalogInfo (&fs_ref,kFSCatInfoVolume|kFSCatInfoNodeID,&catalog_info,NULL,NULL,NULL); + + if (err==0){ + clean_system_files_vd_id.volume_id=catalog_info.volume; + clean_system_files_vd_id.directory_id=catalog_info.nodeID; + } + } + } + if (err!=0){ + fprintf (stderr,"cannot create folder '%s'\n",path_name); + + return; + } +# else fpb.hFileInfo.ioNamePtr=copy_c_to_p_string (path_name,p_string); fpb.hFileInfo.ioVRefNum =0; fpb.hFileInfo.ioFDirIndex=0; @@ -213,6 +339,7 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p } clean_system_files_wd_ref_num=wd_pb.ioVRefNum; +# endif path_name_length=strlen (path_name)-strlen (":Clean System Files"); if (path_name_length<0) @@ -236,8 +363,16 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p struct path_list *old_path_list_p; for (; (old_path_list_p=*old_path_list_h)!=NULL; old_path_list_h=&old_path_list_p->path_next){ - if (old_path_list_p->path_wd_ref_num==wd_ref_num && + if ( +#ifdef KARBON + old_path_list_p->path_vd_id.volume_id==vd_id.volume_id && + old_path_list_p->path_vd_id.directory_id==vd_id.directory_id && + old_path_list_p->path_clean_system_files_vd_id.volume_id==clean_system_files_vd_id.volume_id && + old_path_list_p->path_clean_system_files_vd_id.directory_id==clean_system_files_vd_id.directory_id && +#else + old_path_list_p->path_wd_ref_num==wd_ref_num && old_path_list_p->path_clean_system_files_wd_ref_num==clean_system_files_wd_ref_num && +#endif !strcmp (old_path_list_p->path_name,path_name)) { *old_path_list_h=old_path_list_p->path_next; @@ -250,8 +385,13 @@ static void add_directory_to_path_list (char *path_name,struct path_list **old_p } new_path=(struct path_list*)Alloc (1,sizeof (struct path_list)+1+path_name_length); +#ifdef KARBON + new_path->path_vd_id=vd_id; + new_path->path_clean_system_files_vd_id=clean_system_files_vd_id; +#else new_path->path_wd_ref_num=wd_ref_num; new_path->path_clean_system_files_wd_ref_num=clean_system_files_wd_ref_num; +#endif strcpy (new_path->path_name,path_name); new_path->path_next=NULL; @@ -387,14 +527,20 @@ extern char *clean_abc_path; /* imported from clm.c */ #endif for_l (path_elem,path_list,path_next){ - short wd_ref_num; +#ifdef KARBON + UTCDateTime file_time; + + if (FindFileUTCDateTime (path,path_elem->path_vd_id,&file_time)){ +#else unsigned long file_time; + short wd_ref_num; wd_ref_num=path_elem->path_wd_ref_num; file_time=FindFileTime (path,wd_ref_num); if (file_time!=NoFile){ +#endif strcpy (path,path_elem->path_name); #ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS @@ -411,8 +557,13 @@ extern char *clean_abc_path; /* imported from clm.c */ #if USE_PATH_CACHE if (kind==dclFile) - cache_dcl_path (file_name,path_elem->path_wd_ref_num, - path_elem->path_clean_system_files_wd_ref_num,file_time,path_elem->path_name); + cache_dcl_path (file_name, +# ifdef KARBON + path_elem->path_vd_id,path_elem->path_clean_system_files_vd_id, +# else + path_elem->path_wd_ref_num,path_elem->path_clean_system_files_wd_ref_num, +# endif + file_time,path_elem->path_name); #endif *file_time_p=file_time; @@ -424,6 +575,9 @@ extern char *clean_abc_path; /* imported from clm.c */ strcpy (path,file_name); strcat (path,file_extension); +#ifdef KARBON + return FindFileUTCDateTime0 (path,file_time_p); +#else { unsigned long file_time; @@ -434,7 +588,8 @@ extern char *clean_abc_path; /* imported from clm.c */ *file_time_p=file_time; return True; } - } + } +#endif } #endif @@ -503,19 +658,33 @@ extern char *clean_abc_path; /* imported from clm.c */ #else for_l (path_elem,path_list,path_next){ #endif +#ifdef KARBON + struct vd_id vd_id; + FileTime file_time; + +# ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS + if (in_clean_system_files_folder) + vd_id=path_elem->path_clean_system_files_vd_id; + else +# endif + vd_id=path_elem->path_vd_id; + + if (FindFileUTCDateTime (path,vd_id,&file_time)){ +#else short wd_ref_num; unsigned long file_time; -#ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS +# ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS if (in_clean_system_files_folder) wd_ref_num=path_elem->path_clean_system_files_wd_ref_num; else -#endif +# endif wd_ref_num=path_elem->path_wd_ref_num; file_time=FindFileTime (path,wd_ref_num); if (file_time!=NoFile){ +#endif strcpy (path,path_elem->path_name); #ifndef NO_CLEAN_SYSTEM_FILES_FOLDERS @@ -537,8 +706,13 @@ extern char *clean_abc_path; /* imported from clm.c */ #if USE_PATH_CACHE if (kind==dclFile && !in_clean_system_files_folder) - cache_dcl_path (file_name,path_elem->path_wd_ref_num, - path_elem->path_clean_system_files_wd_ref_num,file_time,path_elem->path_name); + cache_dcl_path (file_name, +# ifdef KARBON + path_elem->path_vd_id,path_elem->path_clean_system_files_vd_id, +# else + path_elem->path_wd_ref_num,path_elem->path_clean_system_files_wd_ref_num, +# endif + file_time,path_elem->path_name); #endif return True; } @@ -559,7 +733,14 @@ extern char *clean_abc_path; /* imported from clm.c */ strcat (path,file_extension); - return FindFileTime (path,0); +# ifdef KARBON + { + FileTime file_time; + return FindFileUTCDateTime0 (path,&file_time); + } +# else + return FindFileTime (path,0)!=NoFile; +# endif } #else static Bool findfilepath (char *wname, FileKind kind, char *path) @@ -573,7 +754,11 @@ extern char *clean_abc_path; /* imported from clm.c */ strcpy (path,wname); strcat (path,file_extension); +# ifdef KARBON + if (FindFileUTCDateTime0 (path) != NoFile) +# else if (FindFileTime (path,0) != NoFile) +# endif return True; pathelem = PATHLIST; @@ -593,7 +778,11 @@ extern char *clean_abc_path; /* imported from clm.c */ strcat (path, wname); strcat (path,file_extension); +#ifdef KARBON + if (FindFileUTCDateTime0 (path) != NoFile) +#else if (FindFileTime (path,0) != NoFile) +#endif return True; /* if all else fails, exit the loop */ @@ -885,7 +1074,8 @@ long FTell (File f) { return ftell ((FILE *) f); } /* FTell */ - + +#ifndef KARBON FileTime FGetFileTime (char *fname, FileKind kind) { char path[MAXPATHLEN]; @@ -896,17 +1086,34 @@ FileTime FGetFileTime (char *fname, FileKind kind) /* FPrintF (StdOut, "timing %s\n", fname); */ if (res) +#ifdef KARBON + return FindFileUTCDateTime0 (path); +#else return FindFileTime (path,0); +#endif else return NoFile; -} /* FGetFileTime */ +} +#endif #ifdef WRITE_DCL_MODIFICATION_TIME void FWriteFileTime (FileTime file_time,File f) { DateTimeRec date_and_time; +# ifdef KARBON + { + LocalDateTime local_date_and_time; + LongDateRec long_date_and_time; + SInt64 long_file_time; + ConvertUTCToLocalDateTime (&file_time,&local_date_and_time); + long_file_time=((SInt64)local_date_and_time.highSeconds<<32) | local_date_and_time.lowSeconds; + LongSecondsToDate (&long_file_time,&long_date_and_time); + date_and_time=long_date_and_time.od.oldDate; + } +# else SecondsToDate (file_time,&date_and_time); +# endif fprintf (f,"%04d%02d%02d%02d%02d%02d", date_and_time.year,date_and_time.month,date_and_time.day, @@ -928,7 +1135,7 @@ void DoError (char *fmt, ...) (void) vfprintf (stderr, fmt, args); va_end (args); -} /* DoError */ +} void DoFatalError (char *fmt, ...) { va_list args; @@ -940,8 +1147,7 @@ void DoFatalError (char *fmt, ...) va_end (args); exit (0); -} /* DoFatalError */ - +} void CmdError (char *errormsg,...) { va_list args; @@ -953,17 +1159,17 @@ void CmdError (char *errormsg,...) fputc ('\n', stdout); va_end (args); -} /* CmdError */ +} extern long GetMainModuleVolume (void); long GetMainModuleVolume (void) { return 0; -} /* GetMainModuleVolume */ +} static void Nothing (void) { -} /* Nothing */ +} static void (*interfunct) (void) = Nothing; @@ -971,7 +1177,7 @@ void (*SetSignal (void (*f) (void))) (void) { void (*oldf) () = interfunct; interfunct = f; return oldf; -} /* SetSignal */ +} int CheckInterrupt () { diff --git a/backendC/CleanCompilerSources/macros_2.c b/backendC/CleanCompilerSources/macros_2.c index 0a63a9b..a7b974a 100644 --- a/backendC/CleanCompilerSources/macros_2.c +++ b/backendC/CleanCompilerSources/macros_2.c @@ -3,6 +3,8 @@ Author: John van Groningen */ +#include "compiledefines.h" +#include "types.t" #include "types.t" #include "system.h" #include "syntaxtr.t" @@ -14,4 +16,3 @@ #include "checktypedefs.h" struct local_def *free_ldefs; - diff --git a/backendC/CleanCompilerSources/optimisations.c b/backendC/CleanCompilerSources/optimisations.c index bb83056..f0ffede 100644 --- a/backendC/CleanCompilerSources/optimisations.c +++ b/backendC/CleanCompilerSources/optimisations.c @@ -3,6 +3,8 @@ Author: John van Groningen */ +#include "compiledefines.h" +#include "types.t" #include "system.h" #include "syntaxtr.t" #include "comsupport.h" @@ -1549,7 +1551,11 @@ static void optimise_normal_node (Node node) #else if ((BETWEEN (int_denot,real_denot,symbol->symb_kind) || symbol->symb_kind==string_denot +# if STRICT_LISTS + || (BETWEEN (tuple_symb,nil_symb,symbol->symb_kind) && !(symbol->symb_kind==cons_symb && (symbol->symb_head_strictness || symbol->symb_tail_strictness))) +# else || BETWEEN (tuple_symb,nil_symb,symbol->symb_kind) +# endif ) && node->node_state.state_kind==OnA){ #endif node->node_state.state_kind=StrictOnA; @@ -1903,6 +1909,10 @@ static Bool try_insert_constructor_update_node (NodeP node,FreeUniqueNodeIdsP *f break; } case cons_symb: +#if STRICT_LISTS + if ((node->node_symbol->symb_head_strictness || node->node_symbol->symb_tail_strictness) && IsLazyStateKind (node->node_state.state_kind)) + return False; +#endif return insert_unique_fill_node (node,f_node_ids,2,0); case tuple_symb: return insert_unique_fill_node (node,f_node_ids,node->node_arity,0); @@ -3394,7 +3404,7 @@ static ImpRuleS **OptimiseRule (ImpRuleS *rule) new_rules=new_rule->rule_next; alt=new_rule->rule_alts; - DetermineStatesOfRootNodeAndDefs (alt->alt_rhs_root,alt->alt_rhs_defs,alt->alt_lhs_root->node_state,0); + DetermineStatesOfRootNodeAndDefs (alt->alt_rhs_root,&alt->alt_rhs_defs,alt->alt_lhs_root->node_state,0); ReorderNodeDefinitionsAndDetermineUsedEntries (&alt->alt_rhs_defs,alt->alt_rhs_root); new_rule->rule_next=rule->rule_next; diff --git a/backendC/CleanCompilerSources/overloading_2.c b/backendC/CleanCompilerSources/overloading_2.c index ed5a04e..b79912f 100644 --- a/backendC/CleanCompilerSources/overloading_2.c +++ b/backendC/CleanCompilerSources/overloading_2.c @@ -4,8 +4,9 @@ Author: Sjaak Smetsers */ +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/path_cache.c b/backendC/CleanCompilerSources/path_cache.c index e2b0eef..c8b7325 100644 --- a/backendC/CleanCompilerSources/path_cache.c +++ b/backendC/CleanCompilerSources/path_cache.c @@ -1,18 +1,30 @@ +#if 0 +#define KARBON +#define TARGET_API_MAC_CARBON 1 +#endif + #include "compiledefines.h" +#include "types.t" #include "system.h" #include <stdlib.h> #include <stdio.h> #include <string.h> +#include <Files.h> #include "path_cache.h" struct path_cache_list { char * pcache_path; +#ifdef KARBON + struct vd_id pcache_vd_id; + struct vd_id pcache_clean_system_files_vd_id; +#else short pcache_wd_ref_num; short pcache_clean_system_files_wd_ref_num; - FileTime pcache_dcl_time; +#endif + FileTime pcache_dcl_time; struct path_cache_list * pcache_next; struct file_block * pcache_file_blocks; #if defined (__MWERKS__) || defined (__MRC__) @@ -49,8 +61,13 @@ static int simple_hash (char *name) return sum & 31; } -void cache_dcl_path (char *file_name,short wd_ref_num,short clean_system_files_wd_ref_num, - unsigned long file_time,char *path) +void cache_dcl_path (char *file_name, +#ifdef KARBON + struct vd_id vd_id,struct vd_id clean_system_files_vd_id, +#else + short wd_ref_num,short clean_system_files_wd_ref_num, +#endif + FileTime file_time,char *path) { int hash_value,file_name_length; struct path_cache_list **pcache_elem_p,*new_pcache_elem; @@ -71,8 +88,13 @@ void cache_dcl_path (char *file_name,short wd_ref_num,short clean_system_files_w if (new_pcache_elem!=NULL){ strcpy (new_pcache_elem->pcache_file_name,file_name); new_pcache_elem->pcache_path=path; +#ifdef KARBON + new_pcache_elem->pcache_vd_id=vd_id; + new_pcache_elem->pcache_clean_system_files_vd_id=clean_system_files_vd_id; +#else new_pcache_elem->pcache_wd_ref_num=wd_ref_num; new_pcache_elem->pcache_clean_system_files_wd_ref_num=clean_system_files_wd_ref_num; +#endif new_pcache_elem->pcache_dcl_time=file_time; new_pcache_elem->pcache_next=NULL; new_pcache_elem->pcache_file_blocks=NULL; @@ -95,8 +117,15 @@ int search_dcl_path_in_cache (char *file_name,struct search_dcl_path_in_cache_re struct path_cache_list *pcache_elem; pcache_elem=*pcache_elem_p; +#ifdef KARBON +/* + r->fs_spec=pcache_elem->pcache_vd_id; + r->clean_system_files_fs_spec=pcache_elem->pcache_clean_system_files_fs_spec; +*/ +#else r->wd_ref_num=pcache_elem->pcache_wd_ref_num; r->clean_system_files_wd_ref_num=pcache_elem->pcache_clean_system_files_wd_ref_num; +#endif r->file_time=pcache_elem->pcache_dcl_time; r->path=pcache_elem->pcache_path; diff --git a/backendC/CleanCompilerSources/path_cache.h b/backendC/CleanCompilerSources/path_cache.h index 68718a9..f3a9afc 100644 --- a/backendC/CleanCompilerSources/path_cache.h +++ b/backendC/CleanCompilerSources/path_cache.h @@ -1,11 +1,26 @@ -extern void cache_dcl_path (char *file_name,short wd_ref_num,short clean_system_files_wd_ref_num, - unsigned long file_time,char *path); +#ifdef KARBON + struct vd_id { + FSVolumeRefNum volume_id; + long directory_id; + }; +#endif + +extern void cache_dcl_path (char *file_name, +#ifdef KARBON + struct vd_id vd_id,struct vd_id clean_system_files_vd_id, +#else + short wd_ref_num,short clean_system_files_wd_ref_num, +#endif + FileTime file_time,char *path); struct search_dcl_path_in_cache_result { +#ifdef KARBON +#else short wd_ref_num; short clean_system_files_wd_ref_num; - unsigned long file_time; +#endif + FileTime file_time; char * path; }; diff --git a/backendC/CleanCompilerSources/pattern_match.c b/backendC/CleanCompilerSources/pattern_match.c index ff2e15e..9c335d9 100644 --- a/backendC/CleanCompilerSources/pattern_match.c +++ b/backendC/CleanCompilerSources/pattern_match.c @@ -11,6 +11,7 @@ #include <stdio.h> +#include "compiledefines.h" #include "types.t" #include "syntaxtr.t" #include "pattern_match.h" diff --git a/backendC/CleanCompilerSources/result_state_database.c b/backendC/CleanCompilerSources/result_state_database.c index d910db0..c9e92ae 100644 --- a/backendC/CleanCompilerSources/result_state_database.c +++ b/backendC/CleanCompilerSources/result_state_database.c @@ -10,6 +10,7 @@ #include <stdio.h> +#include "compiledefines.h" #include "types.t" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/sa.c b/backendC/CleanCompilerSources/sa.c index f26bf4e..054e9e8 100644 --- a/backendC/CleanCompilerSources/sa.c +++ b/backendC/CleanCompilerSources/sa.c @@ -31,6 +31,8 @@ #define SHOW_STRICT_EXPORTED_TUPLE_ELEMENTS #define MORE_ANNOTS 1 +#include "compiledefines.h" +#include "types.t" #include "system.h" #include "settings.h" #include "sizes.h" @@ -113,6 +115,13 @@ static Fun * inffunct_sym, /* the E2 id */ * botmemfunct_sym; /* the E3 id */ +#if STRICT_LISTS +# ifndef _DB_ +static +# endif +Fun *strict_cons_sym,*tail_strict_cons_sym,*strict_tail_strict_cons_sym; +#endif + static ExpRepr top; static ExpRepr bottom; static ExpRepr inf; @@ -2183,6 +2192,15 @@ static Exp ConvertNode (Node node, NodeId nid) e->e_hnf = True; break; case cons_symb: +#if STRICT_LISTS + if (node->node_symbol->symb_head_strictness){ + e->e_fun = node->node_symbol->symb_tail_strictness ? strict_tail_strict_cons_sym : strict_cons_sym; + break; + } else if (node->node_symbol->symb_tail_strictness){ + e->e_fun = tail_strict_cons_sym; + break; + } +#endif e->e_hnf = True; e->e_fun = conssym; break; @@ -2377,8 +2395,8 @@ static Exp ConvertNode (Node node, NodeId nid) newrecordexp->e_args[i] = NULL; /* now fill in the updates of the new record */ - for (arg = node->node_arguments->arg_next; arg; arg = arg->arg_next) - { field_nr = arg->arg_node->node_symbol->symb_def->sdef_sel_field_number; + for_l (arg,node->node_arguments->arg_next,arg_next){ + field_nr = arg->arg_node->node_symbol->symb_def->sdef_sel_field_number; newrecordexp->e_args[field_nr] = ConvertNode (arg->arg_node->node_arguments->arg_node, Null); } @@ -2484,6 +2502,15 @@ static Exp convert_pattern (SymbolP symbol_p,int arity,NodeIdListElementP node_i e->e_hnf = True; break; case cons_symb: +#if STRICT_LISTS + if (symbol_p->symb_head_strictness){ + e->e_fun = symbol_p->symb_tail_strictness ? strict_tail_strict_cons_sym : strict_cons_sym; + break; + } else if (symbol_p->symb_tail_strictness){ + e->e_fun = tail_strict_cons_sym; + break; + } +#endif e->e_hnf = True; e->e_fun = conssym; break; @@ -3082,6 +3109,39 @@ static void init_predefined_symbols (void) InitStrictResult (& f->fun_strictresult); f++; +#if STRICT_LISTS + strict_cons_sym = f; + f->fun_symbol = NULL; + f->fun_arity = 2; + f->fun_kind = Constructor; + f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; + f->fun_single = False; + InitStrictInfo (f->fun_strictargs,HnfStrict); + InitStrictResult (&f->fun_strictresult); + ++f; + + tail_strict_cons_sym = f; + f->fun_symbol = NULL; + f->fun_arity = 2; + f->fun_kind = Constructor; + f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; + f->fun_single = False; + InitStrictInfo (&f->fun_strictargs[1],HnfStrict); + InitStrictResult (&f->fun_strictresult); + ++f; + + strict_tail_strict_cons_sym = f; + f->fun_symbol = NULL; + f->fun_arity = 2; + f->fun_kind = Constructor; + f->fun_strictargs = InitNewStrictInfos (2,NotStrict);; + f->fun_single = False; + InitStrictInfo (f->fun_strictargs,HnfStrict); + InitStrictInfo (&f->fun_strictargs[1],HnfStrict); + InitStrictResult (&f->fun_strictresult); + ++f; +#endif + if_sym = f; f->fun_symbol = Null; f->fun_arity = 3; diff --git a/backendC/CleanCompilerSources/set_scope_numbers.c b/backendC/CleanCompilerSources/set_scope_numbers.c index 993e211..9d0018e 100644 --- a/backendC/CleanCompilerSources/set_scope_numbers.c +++ b/backendC/CleanCompilerSources/set_scope_numbers.c @@ -1,6 +1,7 @@ +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/settings.c b/backendC/CleanCompilerSources/settings.c index a09d306..b46894a 100644 --- a/backendC/CleanCompilerSources/settings.c +++ b/backendC/CleanCompilerSources/settings.c @@ -1,4 +1,6 @@ +#include "compiledefines.h" +#include "types.t" #include "system.h" #include "settings.h" diff --git a/backendC/CleanCompilerSources/statesgen.c b/backendC/CleanCompilerSources/statesgen.c index 8e7b970..09f7d35 100644 --- a/backendC/CleanCompilerSources/statesgen.c +++ b/backendC/CleanCompilerSources/statesgen.c @@ -11,8 +11,9 @@ #pragma segment statesgen +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" @@ -1510,13 +1511,13 @@ static Bool AdjustState (StateS *old_state_p, StateS newstate) return False; } -static void DetermineStateOfThenOrElse (Args t_or_e_args, NodeDefs t_or_e_defs, StateS demstate,int local_scope) +static void DetermineStateOfThenOrElse (Args t_or_e_args, NodeDefs *t_or_e_defs, StateS demstate,int local_scope) { Node node; node=t_or_e_args->arg_node; - if (node->node_kind==NodeIdNode && t_or_e_defs==NULL){ + if (node->node_kind==NodeIdNode && *t_or_e_defs==NULL){ NodeId node_id; node_id=node->node_node_id; @@ -1693,11 +1694,16 @@ static Bool ArgsInAStrictContext (StateP arg_state_p,Args argn, int local_scope) selector_node=arg->arg_node; selector_number=selector_node->node_symbol->symb_def->sdef_sel_field_number; - + +#if 1 + type_arg_number=selector_number; +#else + /* Codewarrior 6 optimizer bug */ while (type_arg_number!=selector_number){ ++type_arg_number; } - +#endif + if (!IsLazyState (record_arg_states[type_arg_number])){ if (semi_strict ? ArgInAStrictContext (selector_node->node_arguments,StrictState,True,local_scope) @@ -1727,6 +1733,14 @@ static Bool NodeInAStrictContext (Node node,StateS demanded_state,int local_scop rootsymb = node->node_symbol; switch (rootsymb->symb_kind){ case cons_symb: +#if STRICT_LISTS + if (node->node_arity==2){ + if (rootsymb->symb_head_strictness) + parallel = DetermineStrictArgContext (node->node_arguments,StrictState,local_scope); + if (rootsymb->symb_tail_strictness) + parallel = DetermineStrictArgContext (node->node_arguments->arg_next,StrictState,local_scope); + } +#endif if (ShouldDecrRefCount) DecrRefCountCopiesOfArgs (node->node_arguments IF_OPTIMIZE_LAZY_TUPLE_RECURSION(local_scope)); case nil_symb: @@ -2244,10 +2258,10 @@ static void DetermineStatesIfRootNode (Node node, StateS demstate,int local_scop AdjustState (&node->node_state, demstate); ++scope; - DetermineStateOfThenOrElse (condpart->arg_next,node->node_then_node_defs,demstate,new_local_scope); + DetermineStateOfThenOrElse (condpart->arg_next,&node->node_then_node_defs,demstate,new_local_scope); ++scope; - DetermineStateOfThenOrElse (condpart->arg_next->arg_next,node->node_else_node_defs,demstate,new_local_scope); + DetermineStateOfThenOrElse (condpart->arg_next->arg_next,&node->node_else_node_defs,demstate,new_local_scope); } static void DetermineStatesSwitchRootNode (Node root_node, StateS demstate, int local_scope) @@ -2265,14 +2279,12 @@ static void DetermineStatesSwitchRootNode (Node root_node, StateS demstate, int case_alt_node_p=node->node_arguments->arg_node; /* Codewarrior bug if (case_alt_node_p->node_kind==PushNode){ */ - if (node->node_arguments->arg_node->node_kind==PushNode){ - DetermineStatesOfRootNodeAndDefs (case_alt_node_p->node_arguments->arg_next->arg_node, - node->node_node_defs, demstate, local_scope); - } + if (node->node_arguments->arg_node->node_kind==PushNode) + DetermineStatesOfRootNodeAndDefs (case_alt_node_p->node_arguments->arg_next->arg_node,&node->node_node_defs,demstate,local_scope); else - DetermineStatesOfRootNodeAndDefs (node->node_arguments->arg_node, node->node_node_defs, demstate, local_scope); + DetermineStatesOfRootNodeAndDefs (node->node_arguments->arg_node,&node->node_node_defs,demstate,local_scope); } else if (node->node_kind==DefaultNode){ - DetermineStatesOfRootNodeAndDefs (node->node_arguments->arg_node, node->node_node_defs, demstate, local_scope); + DetermineStatesOfRootNodeAndDefs (node->node_arguments->arg_node,&node->node_node_defs,demstate,local_scope); } else error_in_function ("DetermineStatesSwitchRootNode"); } @@ -2580,11 +2592,21 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat StateP unique_state_p; unique_state_p=CompAllocType (StateS); +# if STRICT_LISTS + if (symbol->symb_head_strictness) + *unique_state_p=StrictState; + else +# endif *unique_state_p=LazyState; unique_state_p->state_mark |= STATE_UNIQUE_MASK; node_id_p->nid_lhs_state_p_=unique_state_p; } else +# if STRICT_LISTS + if (symbol->symb_head_strictness) + node_id_p->nid_lhs_state_p_=&StrictState; + else +# endif node_id_p->nid_lhs_state_p_=&LazyState; node_ids=node_ids->nidl_next; @@ -2596,7 +2618,11 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat StateP unique_state_p; unique_state_p=CompAllocType (StateS); - +# if STRICT_LISTS + if (symbol->symb_tail_strictness) + *unique_state_p=StrictState; + else +# endif *unique_state_p=LazyState; unique_state_p->state_mark |= STATE_UNIQUE_MASK; if ((node_id_state_p->state_mark & STATE_UNIQUE_TYPE_ARGUMENTS_MASK) && (node_id_state_p->state_unq_type_args & 1)){ @@ -2629,6 +2655,19 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat } } else # endif +# if STRICT_LISTS + if (symbol->symb_kind==cons_symb && (symbol->symb_head_strictness || symbol->symb_tail_strictness) && case_alt_node_p->node_arity==2){ + NodeIdP node_id_p; + + node_id_p=node_ids->nidl_node_id; + node_id_p->nid_lhs_state_p_= symbol->symb_head_strictness ? &StrictState : &LazyState; + node_id_p->nid_ref_count_copy=node_id_p->nid_refcount; + + node_id_p=node_ids->nidl_next->nidl_node_id; + node_id_p->nid_lhs_state_p_= symbol->symb_tail_strictness ? &StrictState : &LazyState; + node_id_p->nid_ref_count_copy=node_id_p->nid_refcount; + } else +# endif set_lazy_push_node_id_states (node_ids); } } @@ -2666,10 +2705,10 @@ static void DetermineStatesOfNodeAndDefs (Node root_node,NodeDefs node_defs,Stat } #endif -void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs rootdef,StateS demstate,int local_scope) +void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs *rootdef,StateS demstate,int local_scope) { #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS - DetermineStatesOfNodeAndDefs (root_node,rootdef,demstate,local_scope); + DetermineStatesOfNodeAndDefs (root_node,*rootdef,demstate,local_scope); #else ShouldDecrRefCount = True; @@ -2684,8 +2723,8 @@ void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs rootdef,StateS de } else DetermineStatesRootNode (root_node,NULL,demstate,local_scope); - if (rootdef) - DetermineStatesOfNodeDefs (rootdef,local_scope); + if (*rootdef) + DetermineStatesOfNodeDefs (*rootdef,local_scope); #endif } @@ -2796,7 +2835,7 @@ void GenerateStatesForRule (ImpRuleS *rule) scope=1; if (alt->alt_kind==Contractum){ - DetermineStatesOfRootNodeAndDefs (alt->alt_rhs_root,alt->alt_rhs_defs,alt->alt_lhs_root->node_state,0); + DetermineStatesOfRootNodeAndDefs (alt->alt_rhs_root,&alt->alt_rhs_defs,alt->alt_lhs_root->node_state,0); #ifdef OBSERVE_ARRAY_SELECTS_IN_PATTERN set_states_of_array_selects_in_pattern (alt); diff --git a/backendC/CleanCompilerSources/statesgen.h b/backendC/CleanCompilerSources/statesgen.h index b158bd1..63c6bdd 100644 --- a/backendC/CleanCompilerSources/statesgen.h +++ b/backendC/CleanCompilerSources/statesgen.h @@ -18,7 +18,7 @@ extern void DetermineSharedAndAnnotatedNodes (ImpRules rules,SymbolP *im_symbols extern void DetermineStateOfArrayElem (Symbol elemtype, States state); extern void ExamineTypesAndLhsOfSymbols (Symbol symbs); extern void ImportSymbols (Symbol symbols); -extern void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs rootdef,StateS demstate,int local_scope); +extern void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs *rootdef,StateS demstate,int local_scope); extern unsigned next_def_number; diff --git a/backendC/CleanCompilerSources/syntaxtr.t b/backendC/CleanCompilerSources/syntaxtr.t index aa337bd..6259035 100644 --- a/backendC/CleanCompilerSources/syntaxtr.t +++ b/backendC/CleanCompilerSources/syntaxtr.t @@ -77,22 +77,6 @@ typedef enum { erroneous_symb } SymbKind; -#ifdef THINK_C -#define DSymbKind(v) ( \ - v==definition?"definition": \ - v==int_denot?"int_denot": \ - v==tuple_symb?"tuple_symb": \ - v==cons_symb?"cons_symb": \ - v==nil_symb?"nil_symb": \ - v==select_symb?"select_symb": \ - v==apply_symb?"apply_symb": \ - v==if_symb?"if_symb": \ - v==newsymbol?"newsymbol": \ - v==emptysymbol?"emptysymbol": \ - v==field_symbol_list?"field_symbol_list": \ - "") -#endif - #if D STRUCT (state,State){ @@ -184,6 +168,11 @@ STRUCT (symbol,Symbol) { unsigned symb_infix_assoc:2; /* Assoc */ }; +#if STRICT_LISTS +# define symb_head_strictness symb_infix_priority /* 0=lazy,1=strict,2=unboxed */ +# define symb_tail_strictness symb_infix_assoc /* 0=lazy,1=strict */ +#endif + #define symb_ident symb_val.val_ident #define symb_def symb_val.val_def #define symb_int symb_val.val_int @@ -605,20 +594,6 @@ typedef enum { SwitchNode, CaseNode, DefaultNode, PushNode, GuardNode, TupleSelectorsNode, FillUniqueNode /* nodes in codegen */ } NodeKind; -#ifdef THINK_C -#define DNodeKind(v) ( \ - v==IfNode?"IfNode": \ - v==NormalNode?"NormalNode": \ - v==SelectorNode?"SelectorNode": \ - v==NodeIdNode?"NodeIdNode": \ - v==RecordNode?"RecordNode": \ - v==UpdateNode?"UpdateNode": \ - v==IdentNode?"IdentNode": \ - v==ApplyNode?"ApplyNode": \ - v==PrefixNode?"PrefixNode" \ - :"") -#endif - #define SELECTOR_U 2 #define SELECTOR_F 3 #define SELECTOR_L 4 diff --git a/backendC/CleanCompilerSources/system.h b/backendC/CleanCompilerSources/system.h index 2d964ff..d200b95 100644 --- a/backendC/CleanCompilerSources/system.h +++ b/backendC/CleanCompilerSources/system.h @@ -6,7 +6,7 @@ */ #define _SYSTEM_ -#define _WINDOWS_ +#undef _WINDOWS_ #if defined (applec) || (defined (__MWERKS__) && !defined (_WINDOWS_)) || defined (__MRC__) # define _MAC_ diff --git a/backendC/CleanCompilerSources/tcsupport_2.c b/backendC/CleanCompilerSources/tcsupport_2.c index 173f6e1..6c514e9 100644 --- a/backendC/CleanCompilerSources/tcsupport_2.c +++ b/backendC/CleanCompilerSources/tcsupport_2.c @@ -6,8 +6,9 @@ #pragma options (!macsbug_names) +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/typechecker2_2.c b/backendC/CleanCompilerSources/typechecker2_2.c index f882816..e1a9386 100644 --- a/backendC/CleanCompilerSources/typechecker2_2.c +++ b/backendC/CleanCompilerSources/typechecker2_2.c @@ -4,8 +4,9 @@ Author: Sjaak Smetsers */ +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/typechecker_2.c b/backendC/CleanCompilerSources/typechecker_2.c index 19a27c6..4f75cbd 100644 --- a/backendC/CleanCompilerSources/typechecker_2.c +++ b/backendC/CleanCompilerSources/typechecker_2.c @@ -6,8 +6,9 @@ #pragma options (!macsbug_names) +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" diff --git a/backendC/CleanCompilerSources/typeconv_2.c b/backendC/CleanCompilerSources/typeconv_2.c index 6a1c0fb..7f828f7 100644 --- a/backendC/CleanCompilerSources/typeconv_2.c +++ b/backendC/CleanCompilerSources/typeconv_2.c @@ -1,16 +1,14 @@ /* - Version 1.0 26/08/1994 - Author: Sjaak Smetsers - */ #define STATES_GENERATED #define STORE_UNIQUE_ATTRIBUTES_IN_TYPE_NODES +#include "compiledefines.h" +#include "types.t" #include "system.h" - #include "settings.h" #include "syntaxtr.t" #include "comsupport.h" @@ -479,7 +477,17 @@ static void PrintNode (TypeNode node, Bool brackets, Bool strict_context, Bool p } case list_type: FPutC ('[', StdListTypes); +#if STRICT_LISTS + if (node->type_node_symbol->symb_head_strictness==1) + FPutC ('!', StdListTypes); + else if (node->type_node_symbol->symb_head_strictness==2) + FPutC ('#', StdListTypes); +#endif PrintArguments (node -> type_node_arguments, ',', cDontPrintBrackets, cNotInAStrictContext, NULL); +#if STRICT_LISTS + if (node->type_node_symbol->symb_tail_strictness) + FPutC ('!', StdListTypes); +#endif FPutC (']', StdListTypes); break; case array_type: diff --git a/backendC/CleanCompilerSources/types.t b/backendC/CleanCompilerSources/types.t index 74feca2..9a58e36 100644 --- a/backendC/CleanCompilerSources/types.t +++ b/backendC/CleanCompilerSources/types.t @@ -2,7 +2,7 @@ #if !defined (_THE__TYPES_) #define _THE__TYPES_ -#define _WINDOWS_ +#undef _WINDOWS_ #if (defined (__MWERKS__) && !defined (_WINDOWS_)) || defined (__MRC__) # define POWER 1 @@ -62,21 +62,25 @@ typedef struct opt_liststricttypes:1; } CompilerOptions; - -#endif - #ifdef _WINDOWS_ -#include <stdarg.h> -#define FileTime FILETIME -#ifdef __MWERKS__ +# include <stdarg.h> +# define FileTime FILETIME +# ifdef __MWERKS__ # include <x86_prefix.h> -#else +# else # define _X86_ -#endif -#include <windef.h> -#include <winbase.h> +# endif +# include <windef.h> +# include <winbase.h> #else +# ifdef KARBON +#include <UTCUtils.h> +typedef UTCDateTime FileTime; +# else typedef unsigned long FileTime; +# endif #endif #define NoFile ((FileTime) 0) + +#endif |