diff options
Diffstat (limited to 'backendC/CleanCompilerSources/instructions.c')
| -rw-r--r-- | backendC/CleanCompilerSources/instructions.c | 3403 |
1 files changed, 3403 insertions, 0 deletions
diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c new file mode 100644 index 0000000..6616c8d --- /dev/null +++ b/backendC/CleanCompilerSources/instructions.c @@ -0,0 +1,3403 @@ +/* + (Concurrent) Clean Compiler: ABC instructions + Authors: Sjaak Smetsers & John van Groningen +*/ + +#pragma segment instructions + +#include "compiledefines.h" +#include "system.h" + +#include <ctype.h> + +#include "syntaxtr.t" +#include "checksupport.h" + +#include "settings.h" +#include "sizes.h" +#include "codegen_types.h" +#include "codegen1.h" +#include "codegen2.h" +#include "comsupport.h" +#include "instructions.h" +#include "statesgen.h" +#include "version.h" + +#define BINARY_ABC 0 +#undef MEMORY_PROFILING_WITH_N_STRING + +#define PutSOutFile(s) FPutS ((s),OutFile) +#define PutCOutFile(s) FPutC ((s),OutFile) + +static void error_in_function (char *m) +{ + ErrorInCompiler ("instructions.c",m,""); +} + +#ifdef _STANDALONE_ +/* also defined in project.c, only needed for stand alone compiler */ + +#define N_DoDebug 0 +#define N_DoReuseUniqueNodes 1 +#define N_DoParallel 2 + +#define N_NoDescriptors 3 +/* +#define N_NoMemoryProfiling 3 +*/ +#define N_DoStrictnessAnalysis 4 +#define N_NoTimeProfiling 5 + +#define N_ExportLocalLabels 6 +/* +#define N_DoVerbose 6 +*/ +#define N_DoWarning 7 +#define N_System 8 + +static void ConvertOptionsToString (CompilerOptions options,char *optstring) +{ + optstring[N_DoDebug] = DoDebug ? '1' : '0'; + optstring[N_DoReuseUniqueNodes] = !DoReuseUniqueNodes ? '1' : '0'; + optstring[N_DoParallel] = DoParallel ? '1' : '0'; + + optstring[N_NoDescriptors] = !DoDescriptors ? '1' : '0'; +/* + optstring[N_NoMemoryProfiling] = !DoProfiling ? '1' : '0'; +*/ + optstring[N_DoStrictnessAnalysis] = DoStrictnessAnalysis ? '1' : '0'; + + optstring[N_NoTimeProfiling] = !DoTimeProfiling ? '1' : '0'; + optstring[N_ExportLocalLabels] = ExportLocalLabels ? '1' : '0'; +/* + optstring[N_DoVerbose] = DoVerbose ? '1' : '0'; +*/ + optstring[N_DoWarning] = DoWarning ? '1' : '0'; + optstring[N_System] = '0'; + optstring[NR_OPTIONS] = '\0'; +} +#else +# define N_System 8 +# include "cginterface.t" +# include "project.h" +#endif + +#define D_PREFIX "d" +#define N_PREFIX "n" +#define L_PREFIX "l" + +#define EA_PREFIX "ea" +#define S_PREFIX "s" + +#define R_PREFIX "r" +#define RECORD_N_PREFIX "c" +#define RECORD_D_PREFIX "t" +#define CONSTRUCTOR_R_PREFIX "k" + +#define LOCAL_D_PREFIX "d" + +File OutFile; +char *ABCFileName; + +Bool OpenABCFile (char *fname) +{ + OutFile = FOpen (fname, abcFile, "w"); + + if (OutFile!=NULL){ +#if defined (THINK_C) || defined (POWER) + setvbuf ((FILE*) OutFile, NULL, _IOFBF, 8192); +#endif + OpenedFile = OutFile; + ABCFileName = fname; + return True; + } else + return False; +} + +void WriteLastNewlineToABCFile (void) +{ + FPutC ('\n',OutFile); +} + +void CloseABCFile (char *fname) +{ + if (OutFile){ +#ifdef THINK_C + int file_io_error; + + file_io_error=ferror (OutFile); +#endif + if (FClose (OutFile) != 0 +#ifdef THINK_C + || file_io_error +#endif + ){ + CompilerError = True; + CurrentLine = 0; + + StaticMessage (True, "<open file>", "Write error (disk full?)"); + } + if (CompilerError) + FDelete (fname, abcFile); + OpenedFile = (File) NIL; + } +} + +static Bool DescriptorNeeded (SymbDef sdef) +{ + return (sdef->sdef_exported || + (sdef->sdef_kind!=IMPRULE && sdef->sdef_kind!=SYSRULE) || + sdef->sdef_mark & SDEF_USED_CURRIED_MASK) || + ((DoParallel || DoDescriptors) && (sdef->sdef_mark & (SDEF_USED_CURRIED_MASK | SDEF_USED_LAZILY_MASK))); +} + +/* extern Ident StdArrayId; */ + +static void GenLabel (Label label) +{ + if (label->lab_issymbol){ + SymbDef def; + char *module_name; + + def=label->lab_symbol; +/* module_name = def->sdef_arfun<NoArrayFun ? StdArrayId->ident_name : label->lab_mod; */ + + module_name = label->lab_mod; + + if (module_name!=NULL) + FPrintF (OutFile,"e_%s_%s%s",module_name,label->lab_pref,def->sdef_ident->ident_name); + else if (DoDebug){ + if (def->sdef_kind==IMPRULE) + FPrintF (OutFile, "%s%s.%u",label->lab_pref,def->sdef_ident->ident_name,def->sdef_number); + else + FPrintF (OutFile, "%s%s",label->lab_pref,def->sdef_ident->ident_name); + } else if (def->sdef_number==0) + FPrintF (OutFile, "%s%s",label->lab_pref,def->sdef_ident->ident_name); + else if (label->lab_pref[0] == '\0') + FPrintF (OutFile,LOCAL_D_PREFIX "%u",def->sdef_number); + else + FPrintF (OutFile,"%s%u",label->lab_pref,def->sdef_number); + } else { + FPutS (label->lab_pref,OutFile); + FPutS (label->lab_name,OutFile); + } + if (label->lab_post!=0) + FPrintF (OutFile,".%u",label->lab_post); +} + +static void GenGetWL (int offset) +{ + FPrintF (OutFile, "\n\tgetWL %d", offset); +} + +static void GenPutWL (int offset) +{ + FPrintF (OutFile, "\n\tputWL %d", offset); +} + +static void GenRelease (void) +{ + FPutS ("\n\trelease", OutFile); +} + +static void TreatWaitListBeforeFill (int offset, FillKind fkind) +{ + if (DoParallel && fkind != NormalFill) + GenGetWL (offset); +} + +static void TreatWaitListAfterFill (int offset, FillKind fkind) +{ + if (DoParallel){ + switch (fkind){ + case ReleaseAndFill:GenRelease (); break; + case PartialFill: GenPutWL (offset); break; + default: break; + } + } +} + +#if !BINARY_ABC + +#define put_instructionb(a) put_instruction(I##a) +#define put_instruction_b(a) put_instruction_(I##a) +#define put_directive_b(a) put_directive_(D##a) +#define put_arguments_i_b(i1) FPrintF (OutFile,"%s",(i1)) +#define put_arguments_in_b(i1,n1) FPrintF (OutFile,"%s %d",(i1),(n1)) +#define put_arguments_n_b(n1) FPrintF (OutFile,"%d",(n1)) +#define put_arguments_nn_b(n1,n2) FPrintF (OutFile,"%d %d",(n1),(n2)) +#define put_arguments_nnn_b(n1,n2,n3) FPrintF (OutFile,"%d %d %d",(n1),(n2),(n3)) +#define put_arguments_nnnn_b(n1,n2,n3,n4) FPrintF (OutFile,"%d %d %d %d",(n1),(n2),(n3),(n4)) +#define put_arguments_nnnnn_b(n1,n2,n3,n4,n5) FPrintF (OutFile,"%d %d %d %d %d",(n1),(n2),(n3),(n4),(n5)) +#define put_arguments_n__b(n1) FPrintF (OutFile,"%d ",(n1)) +#define put_arguments_nn__b(n1,n2) FPrintF (OutFile,"%d %d ",(n1),(n2)) +#define put_arguments__n_b(n1) FPrintF (OutFile," %d",(n1)) +#define put_arguments__nn_b(n1,n2) FPrintF (OutFile," %d %d",(n1),(n2)) +#define put_arguments__n__b(n1) FPrintF (OutFile," %d ",(n1)) + +#else + +/* +#define put_instructionb(a) put_instruction_code(C##a) +#define put_instruction_b(a) put_instruction_code(C##a) +#define put_directive_b(a) put_instruction_code(C##a) +*/ + +#define put_instructionb(a) if (DoDebug) put_instruction(I##a); else put_instruction_code(C##a) +#define put_instruction_b(a) if (DoDebug) put_instruction_(I##a); else put_instruction_code(C##a) +#define put_directive_b(a) if (DoDebug) put_directive_(D##a); else put_instruction_code(C##a) + +static void put_n (long n) +{ + while (!(n>=-64 && n<=63)){ + FPutC (128+(n & 127),OutFile); + n=n>>7; + } + + FPutC (n+64,OutFile); +} + +static long integer_string_to_integer (char *s_p) +{ + long integer; + int minus_sign,last_char; + + minus_sign=0; + last_char=*s_p++; + if (last_char=='+' || last_char=='-'){ + if (last_char=='-') + minus_sign=!minus_sign; + last_char=*s_p++;; + } + + integer=last_char-'0'; + last_char=*s_p++;; + + while ((unsigned)(last_char-'0')<10u){ + integer*=10; + integer+=last_char-'0'; + last_char=*s_p++;; + } + + if (minus_sign) + integer=-integer; + + return integer; +} + +static void put_arguments_i_b (char *i1) +{ + if (DoDebug) + FPrintF (OutFile,"%s",(i1)); + else + put_n (integer_string_to_integer (i1)); +} + +static void put_arguments_in_b (char *i1,long n1) +{ + if (DoDebug) + FPrintF (OutFile,"%s %d",(i1),(n1)); + else { + put_n (integer_string_to_integer (i1)); + put_n (n1); + } +} + +static void put_arguments_n_b (long n1) +{ + if (DoDebug) + FPrintF (OutFile,"%d",(n1)); + else + put_n (n1); +} + +static void put_arguments_nn_b (long n1,long n2) +{ + if (DoDebug) + FPrintF (OutFile,"%d %d",(n1),(n2)); + else { + put_n (n1); + put_n (n2); + } +} + +static void put_arguments_nnn_b (long n1,long n2,long n3) +{ + if (DoDebug) + FPrintF (OutFile,"%d %d %d",(n1),(n2),(n3)); + else { + put_n (n1); + put_n (n2); + put_n (n3); + } +} + +static void put_arguments_nnnn_b (long n1,long n2,long n3,long n4) +{ + if (DoDebug) + FPrintF (OutFile,"%d %d %d %d",(n1),(n2),(n3),(n4)); + else { + put_n (n1); + put_n (n2); + put_n (n3); + put_n (n4); + } +} + +static void put_arguments_nnnnn_b (long n1,long n2,long n3,long n4,long n5) +{ + if (DoDebug) + FPrintF (OutFile,"%d %d %d %d %d",(n1),(n2),(n3),(n4),(n5)); + else { + put_n (n1); + put_n (n2); + put_n (n3); + put_n (n4); + put_n (n5); + } +} + +static void put_arguments_n__b (long n1) +{ + if (DoDebug) + FPrintF (OutFile,"%d ",(n1)); + else + put_n (n1); +} + +static void put_arguments__n_b (long n1) +{ + if (DoDebug) + FPrintF (OutFile," %d",(n1)); + else { + FPutC (' ',OutFile); + put_n (n1); + } +} + +static void put_arguments__n__b (long n1) +{ + if (DoDebug) + FPrintF (OutFile," %d ",(n1)); + else { + FPutC (' ',OutFile); + put_n (n1); + } +} + +static void put_arguments_nn__b (long n1,long n2) +{ + if (DoDebug) + FPrintF (OutFile,"%d %d ",(n1),(n2)); + else { + put_n (n1); + put_n (n2); + } +} + +static void put_arguments__nn_b (long n1,long n2) +{ + if (DoDebug) + FPrintF (OutFile," %d %d",(n1),(n2)); + else { + FPutC (' ',OutFile); + put_n (n1); + put_n (n2); + } +} + +enum { + Cbuild=136, + Cbuildh, + CbuildI, + CbuildB_b, + CbuildC_b, + CbuildI_b, + CbuildR_b, + CbuildF_b, + Ceq_desc, + CeqD_b, + CeqI_a, + CeqI_b, + Cfill, + Cfillh, + CfillI, + CfillB_b, + CfillC_b, + CfillF_b, + CfillI_b, + CfillR_b, + Cfill_a, + Cjmp, + Cjmp_false, + Cjmp_true, + Cjsr, + Cjsr_eval, + Cpop_a, + Cpop_b, + CpushB_a, + CpushC_a, + CpushI_a, + CpushF_a, + CpushR_a, + CpushD, + CpushI, + Cpush_a, + Cpush_b, + Cpush_arg, + Cpush_args, + Cpush_args_u, + Cpush_node, + Cpush_node_u, + Cpush_r_args, + Cpush_r_args_a, + Cpush_r_args_b, + Cpush_r_args_u, + Crepl_arg, + Crepl_args, + Crepl_r_args, + Crepl_r_args_a, + Crtn, + Cupdate_a, + Cupdate_b, + Cupdatepop_a, + Cupdatepop_b, + + Cd, + Co, + Cimpdesc, + Cimplab, + Cn +}; +#endif + +#define IbuildB "buildB" +#define IbuildC "buildC" +#define IbuildI "buildI" +#define IbuildR "buildR" +#define IbuildS "buildS" + +#define IbuildB_b "buildB_b" +#define IbuildC_b "buildC_b" +#define IbuildF_b "buildF_b" +#define IbuildI_b "buildI_b" +#define IbuildR_b "buildR_b" + +#define IfillB "fillB" +#define IfillC "fillC" +#define IfillI "fillI" +#define IfillR "fillR" +#define IfillS "fillS" + +#define IfillB_b "fillB_b" +#define IfillC_b "fillC_b" +#define IfillI_b "fillI_b" +#define IfillR_b "fillR_b" +#define IfillF_b "fillF_b" + +#define IeqB_a "eqB_a" +#define IeqC_a "eqC_a" +#define IeqI_a "eqI_a" +#define IeqR_a "eqR_a" +#define IeqS_a "eqS_a" + +#define IeqAC_a "eqAC_a" + +#define IeqB_b "eqB_b" +#define IeqC_b "eqC_b" +#define IeqI_b "eqI_b" +#define IeqR_b "eqR_b" + +#define IpushB "pushB" +#define IpushI "pushI" +#define IpushC "pushC" +#define IpushR "pushR" + +#define IpushD "pushD" + +#define IpushB_a "pushB_a" +#define IpushC_a "pushC_a" +#define IpushI_a "pushI_a" +#define IpushR_a "pushR_a" +#define IpushF_a "pushF_a" + +#define IpushD_a "pushD_a" + +#define Ipush_array "push_array" +#define Ipush_arraysize "push_arraysize" +#define Iselect "select" +#define Iupdate "update" +#define Ireplace "replace" + +#define Ipush_arg "push_arg" +#define Ipush_args "push_args" +#define Ipush_args_u "push_args_u" +#define Ipush_r_args "push_r_args" +#define Ipush_r_args_u "push_r_args_u" +#define Ipush_r_args_a "push_r_args_a" +#define Ipush_r_args_b "push_r_args_b" +#define Irepl_arg "repl_arg" +#define Irepl_args "repl_args" +#define Irepl_r_args "repl_r_args" +#define Irepl_r_args_a "repl_r_args_a" + +#define Ipush_node "push_node" +#define Ipush_node_u "push_node_u" + +#define Ifill "fill" +#define Ifillcp "fillcp" +#define Ifill_u "fill_u" +#define Ifillcp_u "fillcp_u" +#define Ifillh "fillh" +#define Ifill1 "fill1" +#define Ifill2 "fill2" + +#define Ibuild "build" +#define Ibuildh "buildh" +#define Ibuild_u "build_u" +#define IbuildAC "buildAC" + +#define Ifill_r "fill_r" +#define Ifill1_r "fill1_r" +#define Ifill2_r "fill2_r" +#define Ifill3_r "fill3_r" + +#define Ibuild_r "build_r" + +#define Ifill_a "fill_a" + +#define Ipush_a "push_a" +#define Ipush_b "push_b" + +#define Ijsr_eval "jsr_eval" + +#define Ipop_a "pop_a" +#define Ipop_b "pop_b" +#define Ieq_desc "eq_desc" +#define IeqD_b "eqD_b" + +#define Ijmp_false "jmp_false" +#define Ijmp_true "jmp_true" +#define Ijmp "jmp" +#define Ijsr "jsr" + +#define Icreate "create" +#define Iprint "print" + +#define Iupdate_a "update_a" +#define Iupdate_b "update_b" +#define Iupdatepop_a "updatepop_a" +#define Iupdatepop_b "updatepop_b" +#define Iupdate_b "update_b" +#define Ipop_a "pop_a" +#define Ipop_b "pop_b" + +#define Iget_node_arity "get_node_arity" +#define Iget_desc_arity "get_desc_arity" + +#define Ipush_arg_b "push_arg_b" + +#define Irtn "rtn" + +#define Ijmp_eval "jmp_eval" +#define Ijmp_eval_upd "jmp_eval_upd" + +#define Ihalt "halt" + +#define Itestcaf "testcaf" +#define Ipushcaf "pushcaf" +#define Ifillcaf "fillcaf" + +#define Iin "in" +#define Iout "out" + +static void put_instruction (char *instruction) +{ + FPutC ('\n',OutFile); + FPutC ('\t',OutFile); + FPutS (instruction,OutFile); +} + +static void put_instruction_ (char *instruction) +{ + FPutC ('\n',OutFile); + FPutC ('\t',OutFile); + FPutS (instruction,OutFile); + FPutC (' ',OutFile); +} + +static void put_instruction_code (int instruction_code) +{ + FPutC (instruction_code,OutFile); +} + +#define Dkeep "keep" +#define Dd "d" +#define Do "o" +#define Dimpdesc "impdesc" +#define Dimplab "implab" +#define Dexport "export" +#define Dn "n" +#define Dnu "nu" +#define Dn_string "n_string" +#define Ddesc "desc" +#define Ddescn "descn" +#define Ddescexp "descexp" +#define Drecord "record" +#define Dmodule "module" +#define Ddepend "depend" +#define Dcomp "comp" +#define Dcode "code" +#define Dstart "start" +#define Dstring "string" +#define Dcaf "caf" +#define Dendinfo "endinfo" + +#define Dpb "pb" +#define Dpd "pd" +#define Dpn "pn" +#define Dpl "pl" +#define Dpld "pld" +#define Dpt "pt" +#define Dpe "pe" + +static void put_directive (char *directive) +{ + FPutC ('\n',OutFile); + FPutC ('.',OutFile); + FPutS (directive,OutFile); +} + +static void put_directive_ (char *directive) +{ + FPutC ('\n',OutFile); + FPutC ('.',OutFile); + FPutS (directive,OutFile); + FPutC (' ',OutFile); +} + +static void put_first_directive_ (char *directive) +{ + FPutC ('.',OutFile); + FPutS (directive,OutFile); + FPutC (' ',OutFile); +} + +void BuildBasicFromB (ObjectKind kind,int b_offset) +{ + switch (kind){ + case IntObj: + case ProcIdObj: + case RedIdObj: + put_instruction_b (buildI_b); break; + case BoolObj: + put_instruction_b (buildB_b); break; + case CharObj: + put_instruction_b (buildC_b); break; + case RealObj: + put_instruction_b (buildR_b); break; + case FileObj: + put_instruction_b (buildF_b); break; + default: + error_in_function ("BuildBasicFromB"); + return; + } + + put_arguments_n_b (b_offset); +} + +void FillBasicFromB (ObjectKind kind, int boffs, int aoffs, FillKind fkind) +{ + TreatWaitListBeforeFill (aoffs, fkind); + switch (kind){ + case IntObj: + case ProcIdObj: /* we assume proc_id and red_id */ + case RedIdObj: /* to be integers */ + put_instruction_b (fillI_b); break; + case BoolObj: + put_instruction_b (fillB_b); break; + case CharObj: + put_instruction_b (fillC_b); break; + case RealObj: + put_instruction_b (fillR_b); break; + case FileObj: + put_instruction_b (fillF_b); break; + default: + error_in_function ("FillBasicFromB"); + return; + } + put_arguments_nn_b (boffs,aoffs); + TreatWaitListAfterFill (aoffs, fkind); +} + +void BuildBasic (ObjectKind obj,SymbValue val) +{ + switch (obj){ + case IntObj: + put_instruction_b (buildI); + put_arguments_i_b (val.val_int); + break; + case BoolObj: + put_instruction_ (IbuildB); + if (val.val_bool) + FPrintF (OutFile, "TRUE"); + else + FPrintF (OutFile, "FALSE"); + break; + case CharObj: + put_instruction_ (IbuildC); + FPrintF (OutFile, "%s", val.val_char); + break; + case RealObj: + put_instruction_ (IbuildR); + FPrintF (OutFile, "%s", val.val_real); + break; + case StringObj: + put_instruction_ (IbuildS); + FPrintF (OutFile, "%s", val.val_string); + break; + default: + error_in_function ("BuildBasic"); + return; + } +} + +void FillBasic (ObjectKind obj, SymbValue val, int offset, FillKind fkind) +{ + TreatWaitListBeforeFill (offset, fkind); + switch (obj){ + case IntObj: + put_instruction_b (fillI); + put_arguments_in_b (val.val_int,offset); + break; + case BoolObj: + put_instruction_ (IfillB); + if (val.val_bool) + FPrintF (OutFile, "TRUE %d", offset); + else + FPrintF (OutFile, "FALSE %d", offset); + break; + case CharObj: + put_instruction_ (IfillC); + FPrintF (OutFile, "%s %d", val.val_char, offset); + break; + case RealObj: + put_instruction_ (IfillR); + FPrintF (OutFile, "%s %d", val.val_real, offset); + break; + case StringObj: + put_instruction_ (IfillS); + FPrintF (OutFile, "%s %d", val.val_string, offset); + break; + default: + error_in_function ("FillBasic"); + return; + } + TreatWaitListAfterFill (offset, fkind); +} + +void IsBasic (ObjectKind obj, SymbValue val, int offset) +{ + switch (obj){ + case IntObj: + put_instruction_b (eqI_a); + put_arguments_in_b (val.val_int,offset); + break; + case BoolObj: + put_instruction_ (IeqB_a); + if (val.val_bool) + FPrintF (OutFile, "TRUE %d", offset); + else + FPrintF (OutFile, "FALSE %d", offset); + break; + case CharObj: + put_instruction_ (IeqC_a); + FPrintF (OutFile, "%s %d", val.val_char, offset); break; + case RealObj: + put_instruction_ (IeqR_a); + FPrintF (OutFile, "%s %d", val.val_real, offset); break; + case StringObj: + put_instruction_ (IeqS_a); + FPrintF (OutFile, "%s %d", val.val_string, offset); break; + default: + error_in_function ("IsBasic"); + return; + } +} + +void IsString (SymbValue val) +{ + put_instruction_ (IeqAC_a); + FPrintF (OutFile, "%s",val.val_string); +} + +void PushBasic (ObjectKind obj, SymbValue val) +{ + switch (obj){ + case IntObj: + put_instruction_b (pushI); + put_arguments_i_b (val.val_int); + break; + case BoolObj: + put_instruction_ (IpushB); + if (val.val_bool) + FPutS ("TRUE", OutFile); + else + FPutS ("FALSE", OutFile); + break; + case CharObj: + put_instruction_ (IpushC); + FPrintF (OutFile, "%s", val.val_char); break; + case RealObj: + put_instruction_ (IpushR); + FPrintF (OutFile, "%s", val.val_real); break; + default: + error_in_function ("PushBasic"); + return; + } +} + +void GenPushReducerId (int i) +{ + put_instruction_b (pushI); + put_arguments_n_b (i); +} + +void GenPushArgNr (int argnr) +{ + put_instruction_b (pushI); + put_arguments_n_b (argnr); +} + +void EqBasic (ObjectKind obj, SymbValue val, int offset) +{ + switch (obj){ + case IntObj: + put_instruction_b (eqI_b); + put_arguments_in_b (val.val_int,offset); + break; + case BoolObj: + put_instruction_ (IeqB_b); + if (val.val_bool) + FPrintF (OutFile, "TRUE %d", offset); + else + FPrintF (OutFile, "FALSE %d", offset); + break; + case CharObj: + put_instruction_ (IeqC_b); + FPrintF (OutFile, "%s %d", val.val_char, offset); break; + case RealObj: + put_instruction_ (IeqR_b); + FPrintF (OutFile, "%s %d", val.val_real, offset); break; + default: + error_in_function ("EqBasic"); + return; + } +} + +void PushBasicFromAOnB (ObjectKind kind,int offset) +{ + switch (kind){ + case IntObj: + case ProcIdObj: + case RedIdObj: + put_instruction_b (pushI_a); + break; + case BoolObj: + put_instruction_b (pushB_a); + break; + case CharObj: + put_instruction_b (pushC_a); + break; + case RealObj: + put_instruction_b (pushR_a); + break; + case FileObj: + put_instruction_b (pushF_a); + break; + default: + error_in_function ("PushBasicFromAOnB"); + return; + } + put_arguments_n_b (offset); +} + +void GenPushD_a (int a_offset) +{ + put_instruction_ (IpushD_a); + FPrintF (OutFile,"%d",a_offset); +} + +void PushBasicOnB (ObjectKind obj, int offset) +{ + int i; + + for (i = ObjectSizes[obj]; i > 0; i--) + GenPushB (offset + ObjectSizes[obj] - 1); +} + +void UpdateBasic (int size, int srcoffset, int dstoffset) +{ + if (srcoffset < dstoffset){ + int i; + + for (i=size-1; i >= 0; i--) + GenUpdateB (srcoffset+i, dstoffset+i); + } else if (srcoffset > dstoffset){ + int i; + + for (i=0; i < size; i++) + GenUpdateB (srcoffset+i, dstoffset+i); + } +} + +static Bool IsDirective (Instructions instruction, char *directive) +{ + char *s; + + s=instruction->instr_this; + while (isspace(*s)) + ++s; + if (*s!='.') + return False; + + for (; *directive; ++directive) + if (*directive!=*++s) + return False; + + return True; +} + +static Bool IsInlineFromCurrentModule (SymbDef def) +{ + RuleAlts alt; + Instructions instruction, next; + /* + if (def->sdef_kind!=IMPRULE) + return False; + */ + alt=def->sdef_rule->rule_alts; + + if (alt->alt_kind!=ExternalCall || !alt->alt_rhs_code->co_is_abc_code) + return False; + + instruction=alt->alt_rhs_code->co_instr; + + if (!IsDirective(instruction, "inline")) + return False; + + for (instruction=instruction->instr_next;(next=instruction->instr_next)!=NULL;instruction=next) + ; + + return (IsDirective(instruction, "end")); +} + +/* + For ABC to target machine code generation we supply the abc code + with special stack layout directives. The routines for doing this + are 'GenBStackElems', 'GenStackLayoutOfNode' and 'GenStackLayoutOfState'. +*/ + +static char BElems[] = BASIC_ELEMS_STRING; + +static void GenBStackElems (StateS state) +{ + if (IsSimpleState (state)){ + if (state.state_kind == OnB) + FPutC (BElems [(int) state.state_object], OutFile); + } else { + int arity; + States argstates; + + switch (state.state_type){ + case TupleState: + argstates = state.state_tuple_arguments; + break; + case RecordState: + argstates = state.state_record_arguments; + break; + case ArrayState: + return; + default: + error_in_function ("GenBStackElems"); + return; + } + for (arity=0; arity < state.state_arity; ++arity) + GenBStackElems (argstates[arity]); + } +} + +static void GenABStackElems (StateS state) +{ + if (IsSimpleState (state)){ + if (state.state_kind == OnB) + FPutC (BElems [(int) state.state_object], OutFile); + else + FPutC ('a', OutFile); + + } else { + int arity; + States argstates; + + switch (state.state_type){ + case TupleState: + argstates = state.state_tuple_arguments; + break; + case RecordState: + argstates = state.state_record_arguments; + break; + case ArrayState: + FPutC ('a', OutFile); + return; + default: + error_in_function ("GenABStackElems"); + return; + } + for (arity=0; arity < state.state_arity; arity++) + GenABStackElems (argstates[arity]); + } +} + +void GenDStackLayout (int asize,int bsize,Args fun_args) +{ + if (DoStackLayout){ + put_directive_b (d); + if (bsize > 0){ + put_arguments_nn__b (asize,bsize); + + while (fun_args!=NULL){ + GenBStackElems (fun_args->arg_state); + fun_args=fun_args->arg_next; + } + } else + put_arguments_nn_b (asize,0); + } +} + +void GenOStackLayout (int asize,int bsize,Args fun_args) +{ + if (DoStackLayout){ + put_directive_b (o); + if (bsize > 0){ + put_arguments_nn__b (asize,bsize); + + while (fun_args!=NULL){ + GenBStackElems (fun_args->arg_state); + fun_args=fun_args->arg_next; + } + } else + put_arguments_nn_b (asize,0); + } +} + +static void CallFunction2 (Label label, SymbDef def, Bool isjsr, StateS root_state, Args fun_args, int arity) +{ + int ain,aout,bin,bout; + Args arg; + + ain=0; + bin=0; + + if (fun_args != NULL){ + for (arg = fun_args; arg; arg = arg -> arg_next) + AddSizeOfState (arg -> arg_state, &ain, &bin); + } else + ain = arity; + DetermineSizeOfState (root_state, &aout, &bout); + + if (IsSimpleState (root_state) && (root_state.state_kind!=OnB && root_state.state_kind!=StrictRedirection)) + ain++; + + if (label->lab_mod && label->lab_mod==CurrentModule) + label->lab_mod = NULL; + + label->lab_pref = s_pref; + + if (def->sdef_kind==SYSRULE){ + char *instr; + + instr= def->sdef_ident->ident_instructions; + + if (instr && *instr!='\0'){ + char *tail; + + for (; *instr != '\0'; instr = tail){ + for (tail = instr; *tail != '\n'; tail++) + ; + *tail = '\0'; + FPrintF (OutFile, "\n%s", instr); + *tail++ = '\n'; + } + if (!isjsr) + GenRtn (aout, bout, root_state); + } else { + if (def->sdef_ident->ident_environ && instr==NULL) + { char *previous_module = CurrentModule; + char *previous_ext = CurrentExt; + + CurrentModule = def->sdef_module; + CurrentExt = GetFileExtension (abcFile); + + StaticMessage (False, "%D", "no inline code for this rule", def); + + CurrentModule = previous_module; + CurrentExt = previous_ext; + + def->sdef_ident->ident_environ = (char *) NIL; + } + GenDStackLayout (ain, bin, fun_args); + if (isjsr){ + GenJsr (label); + GenOStackLayoutOfState (aout, bout, root_state); + } else + GenJmp (label); + } + } else if (def->sdef_kind==IMPRULE && IsInlineFromCurrentModule (def)){ + Instructions instruction, last, first, next; + + instruction=def->sdef_rule->rule_alts->alt_rhs_code->co_instr; + instruction=instruction->instr_next; + first=instruction; + + last=NULL; + for (;(next=instruction->instr_next)!=NULL;instruction=next) + last=instruction; + + last->instr_next=NULL; + GenInstructions (first); + last->instr_next=instruction; + + if (!isjsr) + GenRtn (aout, bout, root_state); + } else { + GenDStackLayout (ain, bin, fun_args); + if (isjsr){ + GenJsr (label); + GenOStackLayoutOfState (aout, bout, root_state); + } else + GenJmp (label); + } +} + +void CallFunction (Label label, SymbDef def, Bool isjsr, Node root) +{ + if (def->sdef_arfun<NoArrayFun) + CallArrayFunction (def,isjsr,&root->node_state); + else + CallFunction2 (label, def, isjsr, root->node_state, root->node_arguments, root->node_arity); +} + +static void GenArraySize (Label elemdesc, int asize, int bsize) +{ + put_instruction_ (Ipush_arraysize); + GenLabel (elemdesc); + FPrintF (OutFile, " %d %d", asize, bsize); +} + +static void GenArraySelect (Label elemdesc, int asize, int bsize) +{ + put_instruction_ (Iselect); + GenLabel (elemdesc); + FPrintF (OutFile, " %d %d", asize, bsize); +} + +static void GenArrayUpdate (Label elemdesc, int asize, int bsize) +{ + put_instruction_ (Iupdate); + GenLabel (elemdesc); + FPrintF (OutFile, " %d %d", asize, bsize); +} + +static void GenArrayReplace (Label elemdesc, int asize, int bsize) +{ + put_instruction_ (Ireplace); + GenLabel (elemdesc); + FPrintF (OutFile, " %d %d", asize, bsize); +} + +extern Symbol UnboxedArrayFunctionSymbols []; + +static Label ApplyLabel; +static StateS ApplyState; + +extern SymbDef ApplyDef; /* from codegen2.c */ + +static void ApplyOperatorToArrayAndIndex (Bool is_jsr) +{ + GenPushA (0); + GenCreate (-1); + GenFillArray (3, 0, NormalFill); + + GenUpdateA (0, 2); + + BuildBasicFromB (IntObj,0); + + GenPopB (SizeOfInt); + + GenUpdateA (0, 4); + + GenPopA (2); + + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + CallFunction2 (ApplyLabel, ApplyDef, is_jsr, ApplyState, NULL, 2); +} + +static void ApplyOperatorToArrayElem (int asize, int bsize, ObjectKind kind) +{ + if (asize==0){ + GenPushA (0); + + BuildBasicFromB (kind,0); + + GenUpdateA (0, 2); + GenPopB (bsize); + GenPopA (1); + } + + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); +} + +static void UnpackResultTuple (int asize,int bsize,ObjectKind kind) +{ + GenReplArgs (2, 2); + if (asize==0){ + PushBasicFromAOnB (kind, 0); + GenPopA (1); + } + GenPushArray (asize); + GenUpdateA (0,1+asize); + GenPopA (1); +} + +void CallArrayFunction (SymbDef array_def,Bool is_jsr,StateP node_state_p) +{ + LabDef elem_desc; + int asize, bsize; + Bool elem_is_lazy; + StateS array_state; + ArrayFunKind fkind; + StateP function_state_p; + + fkind = (ArrayFunKind)array_def->sdef_arfun; + function_state_p = array_def->sdef_rule_type->rule_type_state_p; + + if (function_state_p[0].state_type==SimpleState && function_state_p[0].state_object==UnknownObj){ + StateS elem_state; + + switch (fkind){ + case CreateArrayFun: + case _CreateArrayFun: + array_state=function_state_p[-1]; + break; + case _UnqArraySelectNextFun: + case _UnqArraySelectLastFun: + case _ArrayUpdateFun: + if (function_state_p[1].state_type==TupleState) + array_state=function_state_p[1].state_tuple_arguments[0]; + else + error_in_function ("CallArrayFunction"); + break; + default: + array_state=function_state_p[1]; + } + + elem_state = array_state.state_array_arguments [0]; + + if (array_state.state_type==ArrayState && (array_state.state_mark & STATE_UNBOXED_ARRAY_MASK)){ + if (ApplyLabel == NULL){ + ApplyLabel = CompAllocType (LabDef); + ConvertSymbolToLabel (ApplyLabel, ApplyDef); + } + + switch (fkind){ + case CreateArrayFun: + case _CreateArrayFun: + GenPushA (0); + BuildBasicFromB (IntObj,0); + GenPopB (SizeOfInt); + + GenUpdateA (0, 2); + GenPopA (1); + + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + + if (fkind!=_CreateArrayFun) + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + + GenPushArray (0); + GenUpdateA (0, 1); + GenPopA (1); + + break; + case ArraySelectFun: + if (elem_state.state_kind==StrictOnA) + ApplyOperatorToArrayAndIndex (is_jsr); + else { + ApplyOperatorToArrayAndIndex (True); + PushBasicFromAOnB (elem_state.state_object, 0); + GenPopA (1); + } + break; + case UnqArraySelectFun: +#ifdef OBSERVE_ARRAY_SELECTS_IN_PATTERN + DetermineSizeOfState (elem_state,&asize,&bsize); + ApplyOperatorToArrayAndIndex (True); + if (node_state_p->state_type==TupleState + && node_state_p->state_tuple_arguments[1].state_type==SimpleState + && node_state_p->state_tuple_arguments[1].state_kind==Undefined) + { + GenReplArg (2,1); + if (asize==0){ + PushBasicFromAOnB (elem_state.state_object,0); + GenPopA (1); + } + } else + UnpackResultTuple (asize,bsize,elem_state.state_object); + break; +#endif + case _UnqArraySelectFun: + DetermineSizeOfState (elem_state,&asize,&bsize); + ApplyOperatorToArrayAndIndex (True); + UnpackResultTuple (asize, bsize, elem_state.state_object); + break; + case _UnqArraySelectNextFun: + case _UnqArraySelectLastFun: + DetermineSizeOfState (elem_state,&asize,&bsize); + + GenCreate (-1); + GenFillArray (3, 0, NormalFill); + GenCreate (-1); + GenFillArray (3, 0, NormalFill); + GenBuildh (&tuple_lab,2); + + GenUpdateA (0, 2); + + BuildBasicFromB (IntObj,0); + + GenPopB (SizeOfInt); + + GenUpdateA (0, 4); + + GenPopA (2); + + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + + UnpackResultTuple (asize, bsize, elem_state.state_object); + break; + + case _ArrayUpdateFun: + DetermineSizeOfState (elem_state,&asize,&bsize); + + GenCreate (-1); + GenFillArray (3, 0, NormalFill); + GenCreate (-1); + GenFillArray (3, 0, NormalFill); + GenBuildh (&tuple_lab,2); + + GenUpdateA (0, 2); + + BuildBasicFromB (IntObj,0); + GenPopB (SizeOfInt); + + GenUpdateA (0, 4); + + GenPopA (2); + + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + + ApplyOperatorToArrayElem (asize, bsize, elem_state.state_object); + + GenPushArray (0); + GenUpdateA (0, 1); + GenPopA (1); + break; + case ArrayUpdateFun: + DetermineSizeOfState (elem_state,&asize,&bsize); + + ApplyOperatorToArrayAndIndex (True); + ApplyOperatorToArrayElem (asize,bsize,elem_state.state_object); + + GenPushArray (0); + GenUpdateA (0, 1); + GenPopA (1); + break; + case ArrayReplaceFun: + DetermineSizeOfState (elem_state,&asize,&bsize); + + ApplyOperatorToArrayAndIndex (True); + ApplyOperatorToArrayElem (asize,bsize,elem_state.state_object); + UnpackResultTuple (asize,bsize,elem_state.state_object); + break; + case ArraySizeFun: + GenCreate (-1); + GenFillArray (2, 0, NormalFill); + GenUpdateA (0, 2); + + GenPopA (1); + + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + + PushBasicFromAOnB (IntObj, 0); + GenPopA (1); + break; + case UnqArraySizeFun: + GenCreate (-1); + GenFillArray (2, 0, NormalFill); + GenUpdateA (0, 2); + + GenPopA (1); + + CallFunction2 (ApplyLabel, ApplyDef, True, ApplyState, NULL, 2); + + UnpackResultTuple (0, SizeOfInt, IntObj); + + break; + + } + if (! is_jsr){ + DetermineSizeOfState (function_state_p[-1], & asize, & bsize); + GenRtn (asize,bsize,function_state_p[-1]); + } + return; + } + else + { GenPopA (1); + elem_desc = BasicDescriptors [UnknownObj]; + asize = 1; + bsize = 0; + elem_is_lazy = elem_state.state_type==SimpleState && elem_state.state_kind==OnA; + } + } else { + switch (fkind){ + case CreateArrayFun: + case _CreateArrayFun: + array_state = function_state_p[-1]; + break; + case _UnqArraySelectNextFun: + case _UnqArraySelectLastFun: + case _ArrayUpdateFun: + if (function_state_p[0].state_type==TupleState) + array_state=function_state_p[0].state_tuple_arguments[0]; + else + error_in_function ("CallArrayFunction"); + break; + default: + array_state = function_state_p[0]; + } + + if (array_state.state_type == ArrayState){ + StateS elem_state = array_state.state_array_arguments [0]; + DetermineArrayElemDescr (elem_state, & elem_desc); + DetermineSizeOfState (elem_state, & asize, & bsize); + elem_is_lazy = elem_state.state_type==SimpleState && elem_state.state_kind==OnA; + } else + error_in_function ("CallArrayFunction"); + } + + switch (fkind){ + case CreateArrayFun: + put_instruction_ ("create_array"); + GenLabel (&elem_desc); + FPrintF (OutFile," %d %d",asize,bsize); + break; + case _CreateArrayFun: + put_instruction_ ("create_array_"); + GenLabel (&elem_desc); + FPrintF (OutFile," %d %d",asize,bsize); + break; + case ArraySelectFun: + GenArraySelect (&elem_desc,asize,bsize); + if (elem_is_lazy){ + if (is_jsr) + GenJsrEval (0); + else { + GenJmpEval (); + return; + } + } + break; + case UnqArraySelectFun: +#ifdef OBSERVE_ARRAY_SELECTS_IN_PATTERN + if (! (node_state_p->state_type==TupleState + && node_state_p->state_tuple_arguments[1].state_type==SimpleState + && node_state_p->state_tuple_arguments[1].state_kind==Undefined)) + { + GenPushA (0); + } + GenArraySelect (&elem_desc,asize,bsize); + break; +#endif + case _UnqArraySelectFun: + GenPushA (0); + GenArraySelect (&elem_desc,asize,bsize); + break; + case _UnqArraySelectNextFun: + case _UnqArraySelectLastFun: + { + int record_or_array_a_size,record_or_array_b_size; + + if (node_state_p->state_type!=TupleState) + error_in_function ("CallArrayFunction"); + + DetermineSizeOfState (node_state_p->state_tuple_arguments[1],&record_or_array_a_size,&record_or_array_b_size); + + if (record_or_array_b_size>0){ + int i; + + GenPushB (record_or_array_b_size); + + for (i=record_or_array_b_size; i>=0; --i) + GenUpdateB (i,i+1); + + GenPopB (1); + } + + GenArraySelect (&elem_desc,asize,bsize); + break; + } + case _ArrayUpdateFun: + { + int i,result_a_size,result_b_size; + + DetermineSizeOfState (*node_state_p,&result_a_size,&result_b_size); + + if (asize!=0){ + for (i=0; i<asize; ++i) + GenPushA (result_a_size+asize); + + for (i=result_a_size-1; i>=0; --i) + GenUpdateA (i+asize+1,i+asize+1+asize); + + for (i=asize-1; i>=0; --i) + GenUpdateA (i,i+1+asize); + + GenPopA (asize); + } + + if (result_b_size!=0){ + int b_size_with_index; + + b_size_with_index=bsize+1; + + for (i=0; i<b_size_with_index; ++i) + GenPushB (result_b_size+b_size_with_index-1); + + for (i=result_b_size-1; i>=0; --i) + GenUpdateB (i+b_size_with_index,i+b_size_with_index+b_size_with_index); + + for (i=b_size_with_index-1; i>=0; --i) + GenUpdateB (i,i+b_size_with_index); + + GenPopB (b_size_with_index); + } + + GenArrayUpdate (&elem_desc,asize,bsize); + + for (i=0; i<result_a_size; ++i) + GenKeep (0,i+1); + + GenPopA (1); + + break; + } + case ArrayUpdateFun: + GenArrayUpdate (& elem_desc, asize, bsize); + break; + case ArrayReplaceFun: + GenArrayReplace (& elem_desc, asize, bsize); + break; + case ArraySizeFun: + GenArraySize (& elem_desc, asize, bsize); + break; + case UnqArraySizeFun: + GenPushA (0); + GenArraySize (& elem_desc, asize, bsize); + break; + } + + if (! is_jsr){ + DetermineSizeOfState (*node_state_p,&asize,&bsize); + GenRtn (asize,bsize,*node_state_p); + } +} + +void GenNewContext (Label contlab, int offset) +{ + FPrintF (OutFile, "\n\tset_entry "); + GenLabel (contlab); + FPrintF (OutFile, " %d", offset); +} + +void GenSetDefer (int offset) +{ + FPrintF (OutFile, "\n\tset_defer %d", offset); +} + +void GenReplArgs (int arity, int nrargs) +{ + if (nrargs > 0){ + put_instruction_b (repl_args); + put_arguments_nn_b (arity,nrargs); + } else + GenPopA (1); +} + +void GenReplArg (int arity, int argnr) +{ + put_instruction_b (repl_arg); + put_arguments_nn_b (arity,argnr); +} + +void GenPushArgs (int offset, int arity, int nrargs) +{ + if (nrargs > 0){ + put_instruction_b (push_args); + put_arguments_nnn_b (offset,arity,nrargs); + } +} + +void GenPushArgsU (int offset, int arity, int nrargs) +{ + if (nrargs > 0){ + put_instruction_b (push_args_u); + put_arguments_nnn_b (offset,arity,nrargs); + } +} + +void GenPushArg (int offset, int arity, int argnr) +{ + put_instruction_b (push_arg); + put_arguments_nnn_b (offset,arity,argnr); +} + +void GenPushRArgs (int offset, int nr_a_args, int nr_b_args) +{ + if (nr_a_args + nr_b_args > 0){ + put_instruction_b (push_r_args); + put_arguments_nnn_b (offset,nr_a_args,nr_b_args); + } +} + +void GenPushRArgsU (int offset,int n_a_args,int n_b_args) +{ + if (n_a_args + n_b_args > 0){ + put_instruction_b (push_r_args_u); + put_arguments_nnn_b (offset,n_a_args,n_b_args); + } +} + +void GenPushRArgA (int offset, int tot_nr_a_args, int tot_nr_b_args, int args_nr, int nr_a_args) +{ + if (nr_a_args > 0){ + put_instruction_b (push_r_args_a); + put_arguments_nnnnn_b (offset,tot_nr_a_args,tot_nr_b_args,args_nr,nr_a_args); + } +} + +void GenPushRArgB (int offset, int tot_nr_a_args, int tot_nr_b_args, int args_nr, int nr_b_args) +{ + if (nr_b_args > 0){ + put_instruction_b (push_r_args_b); + put_arguments_nnnnn_b (offset,tot_nr_a_args,tot_nr_b_args,args_nr,nr_b_args); + } +} + +void GenReplRArgs (int nr_a_args, int nr_b_args) +{ + if (nr_a_args + nr_b_args > 0){ + put_instruction_b (repl_r_args); + put_arguments_nn_b (nr_a_args,nr_b_args); + } else + GenPopA (1); +} + +void GenReplRArgA (int tot_nr_a_args, int tot_nr_b_args, int args_nr, int nr_a_args) +{ + if (nr_a_args > 0){ + put_instruction_b (repl_r_args_a); + put_arguments_nnnn_b (tot_nr_a_args,tot_nr_b_args,args_nr,nr_a_args); + } else + GenPopA (1); +} + +void GenPushNode (Label contlab, int arity) +{ + put_instruction_b (push_node); + GenLabel (contlab); + put_arguments__n_b (arity); +} + +void GenPushNodeU (Label contlab,int a_size,int b_size) +{ + put_instruction_b (push_node_u); + GenLabel (contlab); + put_arguments__nn_b (a_size,b_size); +} + +void GenFill (Label symblab, int arity,Label contlab, int offset, FillKind fkind) +{ + TreatWaitListBeforeFill (offset, fkind); + + put_instruction_b (fill); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + put_arguments__n__b (arity); + + GenLabel (contlab); + + put_arguments__n_b (offset); + + if (arity < 0) + arity = 1; + TreatWaitListAfterFill (offset-arity, fkind); +} + +void GenFillU (Label symblab,int a_size,int b_size,Label contlab,int offset) +{ + put_instruction_ (Ifill_u); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + FPrintF (OutFile," %d %d ",a_size,b_size); + + GenLabel (contlab); + + put_arguments__n_b (offset); +} + +void GenFillcp (Label symblab,int arity,Label contlab,int offset,char bits[]) +{ + put_instruction_b (fillcp); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + put_arguments__n__b (arity); + + GenLabel (contlab); + + put_arguments__n_b (offset); + + FPrintF (OutFile," %s",bits); +} + +void GenFillcpU (Label symblab,int a_size,int b_size,Label contlab,int offset,char bits[]) +{ + put_instruction_b (fillcp_u); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + FPrintF (OutFile," %d %d ",a_size,b_size); + + GenLabel (contlab); + + put_arguments__n_b (offset); + + FPrintF (OutFile," %s",bits); +} + +void GenFillh (Label symblab, int arity, int offset, FillKind fkind) +{ + TreatWaitListBeforeFill (offset, fkind); + + put_instruction_b (fillh); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + put_arguments__nn_b (arity,offset); + + if (arity < 0) + arity = 1; + TreatWaitListAfterFill (offset-arity, fkind); +} + +void GenFill1 (Label symblab,int arity,int offset,char bits[]) +{ + put_instruction_ (Ifill1); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + FPrintF (OutFile," %d %d %s",arity,offset,bits); +} + +void GenFill2 (Label symblab,int arity,int offset,char bits[]) +{ + put_instruction_ (Ifill2); + GenLabel (symblab); + FPrintF (OutFile," %d %d %s",arity,offset,bits); +} + +void GenBuild (Label symblab,int arity,Label contlab) +{ + put_instruction_b (build); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + put_arguments__n__b (arity); + + GenLabel (contlab); +} + +void GenBuildh (Label symblab,int arity) +{ + put_instruction_b (buildh); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + put_arguments__n_b (arity); +} + +void GenBuildU (Label symblab,int a_size,int b_size,Label contlab) +{ + put_instruction_ (Ibuild_u); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + FPrintF (OutFile," %d %d ",a_size,b_size); + + GenLabel (contlab); +} + +void GenBuildArray (int argoffset) +{ + GenPushA (argoffset); + GenBuildh (& BasicDescriptors [ArrayObj], 1); +} + +void GenBuildString (SymbValue val) +{ + put_instruction_ (IbuildAC); + FPrintF (OutFile, "%s", val.val_string); +} + +static void GenFieldLabel (Label label,char *record_name) +{ + SymbDef def; + + def = (SymbDef) label->lab_name; + + if (label->lab_mod) + FPrintF (OutFile,"e_%s_%s%s.%s", + label->lab_mod,label->lab_pref,record_name,def->sdef_ident->ident_name); + else if (DoDebug){ + if (def->sdef_kind==IMPRULE) + FPrintF (OutFile, "%s%s.%s.%u", + label->lab_pref,record_name,def->sdef_ident->ident_name,def->sdef_number); + else + FPrintF (OutFile, "%s%s.%s",label->lab_pref,record_name,def->sdef_ident->ident_name); + } else if (def->sdef_number==0) + FPrintF (OutFile, "%s%s",label->lab_pref,def->sdef_ident->ident_name); + else if (label->lab_pref[0] == '\0') + FPrintF (OutFile,LOCAL_D_PREFIX "%u",def->sdef_number); + else + FPrintF (OutFile,"%s%u",label->lab_pref,def->sdef_number); +} + +void GenBuildFieldSelector (Label symblab,Label contlab,char *record_name,int arity) +{ + put_instruction_b (build); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenFieldLabel (symblab,record_name); + else + FPutS (empty_lab.lab_name, OutFile); + + put_arguments__n__b (arity); + + GenFieldLabel (contlab,record_name); +} + +void GenFieldLabelDefinition (Label label,char *record_name) +{ + FPutS ("\n", OutFile); + GenFieldLabel (label,record_name); +} + +void GenFillFieldSelector (Label symblab,Label contlab,char *record_name,int arity,int offset,FillKind fkind) +{ + TreatWaitListBeforeFill (offset,fkind); + + put_instruction_b (fill); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenFieldLabel (symblab,record_name); + else + FPutS (empty_lab.lab_name, OutFile); + + put_arguments__n__b (arity); + + GenFieldLabel (contlab,record_name); + + put_arguments__n_b (offset); + + TreatWaitListAfterFill (offset-1,fkind); +} + +void GenFillR (Label symblab,int nr_a_args,int nr_b_args,int rootoffset,int a_offset,int b_offset,FillKind fkind,Bool pop_args) +{ + TreatWaitListBeforeFill (rootoffset, fkind); + + put_instruction_ (Ifill_r); + + if (! symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + if (nr_a_args==0) + a_offset=0; + if (nr_b_args==0) + b_offset=0; + + FPrintF (OutFile, " %d %d %d %d %d",nr_a_args,nr_b_args,rootoffset,a_offset,b_offset); + + if (pop_args){ + GenPopA (nr_a_args); + GenPopB (nr_b_args); + TreatWaitListAfterFill (rootoffset-nr_a_args, fkind); + } else + TreatWaitListAfterFill (rootoffset, fkind); +} + +void GenFill1R (Label symblab,int n_a_args,int n_b_args,int rootoffset,char bits[]) +{ + put_instruction_ (Ifill1_r); + + if (! symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + FPrintF (OutFile, " %d %d %d %s",n_a_args,n_b_args,rootoffset,bits); +} + +void GenFill2R (Label symblab,int n_a_args,int n_b_args,int rootoffset,char bits[]) +{ + put_instruction_ (Ifill2_r); + + if (! symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + FPrintF (OutFile, " %d %d %d %s",n_a_args,n_b_args,rootoffset,bits); +} + +void GenFill3R (Label symblab,int n_a_args,int n_b_args,int rootoffset,char bits[]) +{ + put_instruction_ (Ifill3_r); + + if (! symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + FPrintF (OutFile, " %d %d %d %s",n_a_args,n_b_args,rootoffset,bits); +} + +void GenBuildR (Label symblab,int nr_a_args,int nr_b_args,int a_offset,int b_offset,Bool pop_args) +{ + put_instruction_ (Ibuild_r); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + if (nr_a_args==0) + a_offset=0; + if (nr_b_args==0) + b_offset=0; + + FPrintF (OutFile, " %d %d %d %d",nr_a_args,nr_b_args,a_offset,b_offset); + + if (pop_args){ + if (nr_a_args>0){ + GenUpdateA (0,nr_a_args); + GenPopA (nr_a_args); + } + GenPopB (nr_b_args); + } +} + +void GenFillFromA (int src, int dst, FillKind fkind) +{ + if (src == dst) + return; + + TreatWaitListBeforeFill (dst, fkind); + put_instruction_b (fill_a); + put_arguments_nn_b (src,dst); + TreatWaitListAfterFill (dst, fkind); +} + +void GenFillArray (int argoffset, int rootoffset, FillKind fkind) +{ + GenPushA (argoffset); + GenFillh (&BasicDescriptors [ArrayObj], 1, rootoffset+1, fkind); +} + +void GenPushArray (int rootoffset) +{ + put_instruction_ (Ipush_array); + FPrintF (OutFile, "%d", rootoffset); +} + +void GenRtn (int asize, int bsize, StateS resultstate) +{ + GenDStackLayoutOfState (asize, bsize, resultstate); + put_instructionb (rtn); +} + +void GenPushA (int offset) +{ + if (offset<0) + error_in_function ("GenPushA"); + + put_instruction_b (push_a); + put_arguments_n_b (offset); +} + +void GenPushB (int offset) +{ + if (offset<0) + error_in_function ("GenPushB"); + + put_instruction_b (push_b); + put_arguments_n_b (offset); +} + +void GenJsrEval (int offset) +{ + put_instruction_b (jsr_eval); + put_arguments_n_b (offset); +} + +void GenJmpEval (void) +{ + put_instruction (Ijmp_eval); +} + +void GenPopA (int nr) +{ + if (nr > 0){ + put_instruction_b (pop_a); + put_arguments_n_b (nr); + } +} + +void GenPopB (int nr) +{ + if (nr > 0){ + put_instruction_b (pop_b); + put_arguments_n_b (nr); + } +} + +void GenEqDesc (Label symblab,int arity,int offset) +{ + put_instruction_b (eq_desc); + GenLabel (symblab); + put_arguments__nn_b (arity,offset); +} + +void GenEqD_b (Label symblab,int arity) +{ + put_instruction_b (eqD_b); + GenLabel (symblab); + put_arguments__n_b (arity); +} + +void GenExitFalse (Label to) +{ + put_instruction_ ("exit_false"); + GenLabel (to); +} + +void GenJmpFalse (Label to) +{ + put_instruction_b (jmp_false); + GenLabel (to); +} + +void GenJmpTrue (Label to) +{ + put_instruction_b (jmp_true); + GenLabel (to); +} + +void GenJmp (Label tolab) +{ + put_instruction_b (jmp); + GenLabel (tolab); +} + +void GenJsr (Label tolab) +{ + put_instruction_b (jsr); + GenLabel (tolab); +} + +void GenCreate (int arity) +{ + if (arity == -1) + put_instruction (Icreate); + else { + put_instruction_ (Icreate); + FPrintF (OutFile, "%d", arity); + } +} + +void GenDumpString (char *str) +{ + put_instruction_ (Iprint); + FPrintF (OutFile, "\"%s\"", str); + put_instruction (Ihalt); +} + +void GenLabelDefinition (Label lab) +{ + if (lab){ + FPutC ('\n', OutFile); + GenLabel (lab); + } +} + +void GenUpdateA (int src, int dst) +{ + if (src != dst){ + put_instruction_b (update_a); + put_arguments_nn_b (src,dst); + } +} + +void GenUpdatePopA (int src, int dst) +{ + if (src!=dst){ + if (dst!=0){ + put_instruction_b (updatepop_a); + put_arguments_nn_b (src,dst); + } else { + put_instruction_b (update_a); + put_arguments_nn_b (src,dst); + } + } else + if (dst > 0){ + put_instruction_b (pop_a); + put_arguments_n_b (dst); + } +} + +void GenUpdateB (int src, int dst) +{ + if (src != dst){ + put_instruction_b (update_b); + put_arguments_nn_b (src,dst); + } +} + +void GenUpdatePopB (int src, int dst) +{ + if (src!=dst){ + if (dst!=0){ + put_instruction_b (updatepop_b); + put_arguments_nn_b (src,dst); + } else { + put_instruction_b (update_b); + put_arguments_nn_b (src,dst); + } + } else + if (dst > 0) { + put_instruction_b (pop_b); + put_arguments_n_b (dst); + } +} + +void GenHalt (void) +{ + put_instruction (Ihalt); +} + +void GenSetRedId (int offset) +{ + FPrintF (OutFile, "\n\tset_red_id %d", offset); +} + +void GenNewParallelReducer (int offset, char *reducer_code) +{ + FPrintF (OutFile, "\n\tnew_ext_reducer %s %d", reducer_code, offset); +} + +void GenNewContInterleavedReducer (int offset) +{ + FPrintF (OutFile, "\n\tnew_int_reducer _cont_reducer %d", offset); + FPrintF (OutFile, "\n\tforce_cswitch", offset); +} + +void GenNewInterleavedReducer (int offset, char *reducer_code) +{ + FPrintF (OutFile, "\n\tnew_int_reducer %s %d", reducer_code, offset); +} + +void GenSendGraph (char *code, int graphoffs, int chanoffs) +{ + FPrintF (OutFile, "\n\tsend_graph %s %d %d", code, graphoffs, chanoffs); +} + +void GenCreateChannel (char *code) +{ + FPrintF (OutFile, "\n\tcreate_channel %s", code); +} + +void GenNewP (void) +{ + FPutS ("\n\tnewP", OutFile); +} + +void SetContinue (int offset) +{ + FPrintF (OutFile, "\n\tset_continue %d", offset); +} + +void SetContinueOnReducer (int offset) +{ + FPrintF (OutFile, "\n\tset_continue2 %d", offset); +} + +void GenGetNodeArity (int offset) +{ + put_instruction_ (Iget_node_arity); + FPrintF (OutFile, "%d", offset); +} + +static void GenGetDescArity (int offset) +{ + put_instruction_ (Iget_desc_arity); + FPrintF (OutFile, "%d", offset); +} + +void GenPushArgB (int offset) +{ + put_instruction_ (Ipush_arg_b); + FPrintF (OutFile, "%d", offset); +} + +void GenImport (SymbDef sdef) +{ + if (DoStackLayout){ + char *name; + + name = sdef->sdef_ident->ident_name; + + switch (sdef->sdef_kind){ + case DEFRULE: + case SYSRULE: + if (sdef->sdef_mark & (SDEF_USED_CURRIED_MASK | SDEF_USED_LAZILY_MASK)){ + put_directive_b (impdesc); + FPrintF (OutFile, "e_%s_" D_PREFIX "%s",sdef->sdef_module,name); + } + if (sdef->sdef_mark & SDEF_USED_STRICTLY_MASK && sdef->sdef_arfun==NoArrayFun){ + put_directive_b (implab); + FPrintF (OutFile,"e_%s_" S_PREFIX "%s",sdef->sdef_module,name); + } + break; + case FIELDSELECTOR: + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + char *record_name; + + record_name = sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + + put_directive_b (impdesc); + FPrintF (OutFile, "e_%s_" D_PREFIX "%s.%s",sdef->sdef_module,record_name,name); + + put_directive_b (implab); + + FPrintF (OutFile, "e_%s_" N_PREFIX "%s.%s",sdef->sdef_module,record_name,name); + + if (sdef->sdef_calledwithrootnode) + FPrintF (OutFile, " e_%s_" EA_PREFIX "%s.%s",sdef->sdef_module,record_name,name); + else if (sdef->sdef_returnsnode) + FPutS (" _",OutFile); + } + return; + case RECORDTYPE: + if (sdef->sdef_mark & (SDEF_USED_STRICTLY_MASK | SDEF_USED_LAZILY_MASK)){ + put_directive_b (impdesc); + FPrintF (OutFile, "e_%s_" R_PREFIX "%s",sdef->sdef_module,name); + } + + if (!sdef->sdef_strict_constructor) + return; + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + put_directive_b (impdesc); + FPrintF (OutFile, "e_%s_" RECORD_D_PREFIX "%s", sdef->sdef_module,name); + put_directive_b (implab); + FPrintF (OutFile, "e_%s_" RECORD_N_PREFIX "%s",sdef->sdef_module,name); + } + return; + case CONSTRUCTOR: + if (!sdef->sdef_strict_constructor) + return; + + if (sdef->sdef_mark & (SDEF_USED_STRICTLY_MASK | SDEF_USED_LAZILY_MASK)){ + put_directive_b (impdesc); + FPrintF (OutFile, "e_%s_" CONSTRUCTOR_R_PREFIX "%s",sdef->sdef_module,name); + } + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + put_directive_b (impdesc); + FPrintF (OutFile, "e_%s_" D_PREFIX "%s", sdef->sdef_module,name); + } + break; + default: + return; + } + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + put_directive_b (implab); + FPrintF (OutFile, "e_%s_" N_PREFIX "%s",sdef->sdef_module,name); + if ((sdef->sdef_calledwithrootnode || sdef->sdef_returnsnode) && + !(sdef->sdef_kind==CONSTRUCTOR && !sdef->sdef_strict_constructor)) + { + if (sdef->sdef_calledwithrootnode) + FPrintF (OutFile, " e_%s_" EA_PREFIX "%s",sdef->sdef_module,name); + else + FPutS (" _",OutFile); + } + } + } +} + +void GenExportStrictAndEaEntry (SymbDef sdef) +{ + char *name; + + name = sdef->sdef_ident->ident_name; + + put_directive_ (Dexport); + FPrintF (OutFile, "e_%s_" S_PREFIX "%s", CurrentModule,name); + + if (sdef->sdef_calledwithrootnode){ + put_directive_ (Dexport); + FPrintF (OutFile, "e_%s_%s%s", CurrentModule, ea_pref, name); + } +} + +void GenExportFieldSelector (SymbDef sdef) +{ + char *name; + char *record_name; + + name = sdef->sdef_ident->ident_name; + + record_name=sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" D_PREFIX "%s.%s",CurrentModule,record_name,name); + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" N_PREFIX "%s.%s",CurrentModule,record_name,name); + + if (sdef->sdef_calledwithrootnode){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" EA_PREFIX "%s.%s",CurrentModule,record_name,name); + } +} + +void GenExportEaEntry (SymbDef sdef) +{ + if (sdef->sdef_calledwithrootnode){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" EA_PREFIX "%s",CurrentModule,sdef->sdef_ident->ident_name); + } +} + +void GenDAStackLayout (int asize) +{ + if (DoStackLayout){ + put_directive_b (d); + put_arguments_nn_b (asize,0); + } +} + +void GenOAStackLayout (int asize) +{ + if (DoStackLayout){ + put_directive_b (o); + put_arguments_nn_b (asize,0); + } +} + +void GenDStackLayoutOfStates (int asize,int bsize,int n_states,StateP state_p) +{ + if (DoStackLayout){ + put_directive_b (d); + if (bsize > 0){ + int i; + + put_arguments_nn__b (asize,bsize); + + for (i=0; i<n_states; ++i) + GenBStackElems (state_p[i]); + } else + put_arguments_nn_b (asize,0); + } +} + +void GenOStackLayoutOfStates (int asize,int bsize,int n_states,StateP state_p) +{ + if (DoStackLayout){ + put_directive_b (o); + if (bsize > 0){ + int i; + + put_arguments_nn__b (asize,bsize); + + for (i=0; i<n_states; ++i) + GenBStackElems (state_p[i]); + } else + put_arguments_nn_b (asize,0); + } +} + +void GenDStackLayoutOfState (int asize, int bsize, StateS resultstate) +{ + if (DoStackLayout){ + put_directive_b (d); + if (bsize > 0){ + put_arguments_nn__b (asize,bsize); + GenBStackElems (resultstate); + } else + put_arguments_nn_b (asize,0); + } +} + +void GenOStackLayoutOfState (int asize, int bsize, StateS resultstate) +{ + if (DoStackLayout){ + put_directive_b (o); + if (bsize > 0){ + put_arguments_nn__b (asize,bsize); + GenBStackElems (resultstate); + } else + put_arguments_nn_b (asize,0); + } +} + +void GenJmpEvalUpdate (void) +{ + put_instruction (Ijmp_eval_upd); +} + +void GenNodeEntryDirective (int arity,Label label,Label label2) +{ + if (DoStackLayout){ + put_directive_b (n); + put_arguments_n__b (arity); + + if (DescriptorNeeded (label->lab_symbol)) + GenLabel (label); + else + FPutS (empty_lab.lab_name, OutFile); + + if (label2){ + FPutC (' ', OutFile); + GenLabel (label2); + } +#ifdef MEMORY_PROFILING_WITH_N_STRING + if (DoProfiling && arity>=0 && !DoParallel){ + put_directive_ (Dn_string); + FPrintF (OutFile,"\"%s\"",label->lab_symbol->sdef_ident->ident_name); + } +#endif + } +} + +void GenNodeEntryDirectiveForLabelWithoutSymbol (int arity,Label label,Label label2) +{ + if (DoStackLayout){ + put_directive_b (n); + put_arguments_n__b (arity); + + GenLabel (label); + + if (label2){ + FPutC (' ', OutFile); + GenLabel (label2); + } + +#ifdef MEMORY_PROFILING_WITH_N_STRING + if (DoProfiling && arity>=0 && !DoParallel){ + put_directive_ (Dn_string); + FPrintF (OutFile,"\"%s\"",label->lab_name); + } +#endif + } +} + +void GenNodeEntryDirectiveUnboxed (int a_size,int b_size,Label label,Label label2) +{ + if (DoStackLayout){ + put_directive_ (Dnu); + FPrintF (OutFile,"%d %d ",a_size,b_size); + + if (DescriptorNeeded (label->lab_symbol)) + GenLabel (label); + else + FPutS (empty_lab.lab_name, OutFile); + + if (label2){ + FPutC (' ', OutFile); + GenLabel (label2); + } + +# ifdef MEMORY_PROFILING_WITH_N_STRING + if (DoProfiling && !DoParallel){ + put_directive_ (Dn_string); + FPrintF (OutFile,"\"%s\"",label->lab_symbol->sdef_ident->ident_name); + } +# endif + } +} + +void GenFieldNodeEntryDirective (int arity,Label label,Label label2,char *record_name) +{ + if (DoStackLayout){ + put_directive_b (n); + put_arguments_n__b (arity); + + if (DescriptorNeeded (label->lab_symbol)) + GenFieldLabel (label,record_name); + else + FPutS (empty_lab.lab_name, OutFile); + + if (label2){ + FPutC (' ', OutFile); + GenFieldLabel (label2,record_name); + } + } +} + +void GenConstructorDescriptorAndExport (SymbDef sdef) +{ + char *name; + LabDef *add_argument_label; + + name = sdef->sdef_ident->ident_name; + + if (sdef->sdef_arity>0) + add_argument_label=&add_arg_lab; + else + add_argument_label=&hnf_lab; + + if (sdef->sdef_exported || ExportLocalLabels){ + put_directive_ (Dexport); + FPrintF (OutFile, "e_%s_" D_PREFIX "%s",CurrentModule,name); + put_directive_ (Ddesc); + FPrintF (OutFile, "e_%s_" D_PREFIX "%s %s %s %d 0 \"%s\"", + CurrentModule, name, hnf_lab.lab_name, add_argument_label->lab_name, + sdef->sdef_arity, name); + } else if (DoDebug){ + put_directive_ (Ddesc); + FPrintF (OutFile, D_PREFIX "%s %s %s %d 0 \"%s\"", + name,hnf_lab.lab_name, add_argument_label->lab_name, sdef->sdef_arity, name); + } else { + put_directive_ (Ddesc); + FPrintF (OutFile, LOCAL_D_PREFIX "%u %s %s %d 0 \"%s\"", + sdef->sdef_number, hnf_lab.lab_name, add_argument_label->lab_name, + sdef->sdef_arity, name); + } +} + +void GenRecordDescriptor (SymbDef sdef) +{ + int asize,bsize; + char *name; + StateS recstate; + + name = sdef->sdef_ident->ident_name; + + if (sdef->sdef_exported || ExportLocalLabels){ + put_directive_ (Dexport); + FPrintF (OutFile, "e_%s_" R_PREFIX "%s",CurrentModule,name); + put_directive_ (Drecord); + FPrintF (OutFile, "e_%s_" R_PREFIX "%s ",CurrentModule,name); + } else if (DoDebug){ + put_directive_ (Drecord); + FPrintF (OutFile, R_PREFIX "%s ",name); + } else { + put_directive_ (Drecord); + FPrintF (OutFile, R_PREFIX "%u ",sdef->sdef_number); + } + + recstate = sdef->sdef_record_state; + + GenABStackElems (recstate); + + DetermineSizeOfState (recstate,&asize,&bsize); + + FPrintF (OutFile, " %d %d \"%s\"",asize,bsize,name); +} + +void GenStrictConstructorDescriptor (SymbDef sdef,StateP constructor_arg_state_p) +{ + int asize,bsize,state_arity,arg_n; + char *name; + + name = sdef->sdef_ident->ident_name; + + if (sdef->sdef_exported || ExportLocalLabels){ + put_directive_ (Dexport); + FPrintF (OutFile, "e_%s_" CONSTRUCTOR_R_PREFIX "%s",CurrentModule,name); + put_directive_ (Drecord); + FPrintF (OutFile, "e_%s_" CONSTRUCTOR_R_PREFIX "%s ",CurrentModule,name); + } else if (DoDebug){ + put_directive_ (Drecord); + FPrintF (OutFile, CONSTRUCTOR_R_PREFIX "%s ",name); + } else { + put_directive_ (Drecord); + FPrintF (OutFile, CONSTRUCTOR_R_PREFIX "%u ",sdef->sdef_number); + } + + FPutC ('d', OutFile); + + state_arity=sdef->sdef_arity; + asize = 0; + bsize = 0; + + for (arg_n=0; arg_n<state_arity; ++arg_n){ + GenABStackElems (*constructor_arg_state_p); + AddSizeOfState (*constructor_arg_state_p,&asize,&bsize); + ++constructor_arg_state_p; + } + + FPrintF (OutFile, " %d %d \"%s\"", asize, bsize, name); +} + +void GenArrayFunctionDescriptor (SymbDef arr_fun_def, Label desclab, int arity) +{ + LabDef descriptor_label; + char *name; + + name = arr_fun_def->sdef_ident->ident_name; + + descriptor_label=*desclab; + descriptor_label.lab_pref=d_pref; + + if (arr_fun_def->sdef_mark & SDEF_USED_CURRIED_MASK) + put_directive_ (Ddesc); + else + put_directive_ (Ddescn); + + GenLabel (&descriptor_label); + + FPutC (' ', OutFile); + GenLabel (&empty_lab); + FPutC (' ', OutFile); + + if (arr_fun_def->sdef_mark & SDEF_USED_CURRIED_MASK){ + LabDef lazylab; + + lazylab = *desclab; + lazylab.lab_pref = l_pref; + GenLabel (&lazylab); + } + + FPrintF (OutFile, " %d 0 \"%s\"", arity, name); +} + +void GenFunctionDescriptorAndExportNodeAndDescriptor (SymbDef sdef) +{ + Ident name_id; + char *name; + + if (!DescriptorNeeded (sdef)) + return; + + name_id = sdef->sdef_ident; + name = name_id->ident_name; + + if (sdef->sdef_exported){ + put_directive_ (Ddescexp); + FPrintF (OutFile, "e_%s_" D_PREFIX "%s e_%s_" N_PREFIX "%s e_%s_" L_PREFIX "%s ", + CurrentModule,name,CurrentModule,name,CurrentModule,name); + } else { + if (sdef->sdef_mark & SDEF_USED_CURRIED_MASK){ + put_directive_ (Ddesc); + + if (DoDebug) + FPrintF (OutFile, D_PREFIX "%s.%u ", name,sdef->sdef_number); + else + FPrintF (OutFile, LOCAL_D_PREFIX "%u ", sdef->sdef_number); + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + if (DoDebug) + FPrintF (OutFile,N_PREFIX "%s.%u ",name,sdef->sdef_number); + else + FPrintF (OutFile,N_PREFIX "%u ",sdef->sdef_number); + } else + FPrintF (OutFile, "%s ", hnf_lab.lab_name); + + if (DoDebug) + FPrintF (OutFile,L_PREFIX "%s.%u ",name,sdef->sdef_number); + else + FPrintF (OutFile,L_PREFIX "%u ",sdef->sdef_number); + } else { + put_directive_ (Ddescn); + + if (DoDebug) + FPrintF (OutFile, D_PREFIX "%s.%u ", name,sdef->sdef_number); + else + FPrintF (OutFile, LOCAL_D_PREFIX "%u ", sdef->sdef_number); + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + if (DoDebug) + FPrintF (OutFile,N_PREFIX "%s.%u ",name,sdef->sdef_number); + else + FPrintF (OutFile,N_PREFIX "%u ",sdef->sdef_number); + } else + FPrintF (OutFile, "%s ", hnf_lab.lab_name); + } + } + + FPrintF (OutFile, "%d 0 \"", sdef->sdef_arity); + PrintSymbolOfIdent (name_id, 0, OutFile); + FPutC ('\"',OutFile); +} + +void GenConstructorFunctionDescriptorAndExportNodeAndDescriptor (SymbDef sdef) +{ + Ident name_id; + char *name; + + if (!DescriptorNeeded (sdef)) + return; + + name_id = sdef->sdef_ident; + name = name_id->ident_name; + + if (sdef->sdef_exported){ + put_directive_ (Ddescexp); + FPrintF (OutFile, "e_%s_" D_PREFIX "%s e_%s_" N_PREFIX "%s e_%s_" L_PREFIX "%s ", + CurrentModule,name,CurrentModule,name,CurrentModule,name); + } else if (ExportLocalLabels && (sdef->sdef_mark & SDEF_USED_CURRIED_MASK)!=0){ + put_directive_ (Ddescexp); + if (DoDebug) + FPrintF (OutFile, "e_%s_" D_PREFIX "%s e_%s_" N_PREFIX "%s " L_PREFIX "%s ", + CurrentModule,name,CurrentModule,name,name); + else + FPrintF (OutFile, "e_%s_" D_PREFIX "%s e_%s_" N_PREFIX "%s " L_PREFIX "%u ", + CurrentModule,name,CurrentModule,name,sdef->sdef_number); + } else { + if (sdef->sdef_mark & SDEF_USED_CURRIED_MASK){ + put_directive_ (Ddesc); + + if (DoDebug) + FPrintF (OutFile, D_PREFIX "%s ",name); + else + FPrintF (OutFile, LOCAL_D_PREFIX "%u ", sdef->sdef_number); + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + if (DoDebug) + FPrintF (OutFile,N_PREFIX "%s ",name); + else + FPrintF (OutFile,N_PREFIX "%u ",sdef->sdef_number); + } else + FPrintF (OutFile, "%s ", hnf_lab.lab_name); + + if (DoDebug) + FPrintF (OutFile,L_PREFIX "%s ",name); + else + FPrintF (OutFile,L_PREFIX "%u ",sdef->sdef_number); + } else { + if (ExportLocalLabels){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" N_PREFIX "%s",CurrentModule,name); + } + + put_directive_ (Ddescn); + + if (DoDebug) + FPrintF (OutFile, D_PREFIX "%s ", name); + else + FPrintF (OutFile, LOCAL_D_PREFIX "%u ", sdef->sdef_number); + + if (ExportLocalLabels) + FPrintF (OutFile,"e_%s_" N_PREFIX "%s ",CurrentModule,name); + else if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + if (DoDebug) + FPrintF (OutFile,N_PREFIX "%s ", name); + else + FPrintF (OutFile,N_PREFIX "%u ",sdef->sdef_number); + } else + FPrintF (OutFile, "%s ", hnf_lab.lab_name); + } + } + + FPrintF (OutFile, "%d 0 \"", sdef->sdef_arity); + PrintSymbolOfIdent (name_id, 0, OutFile); + FPutC ('\"',OutFile); +} + +#if OPTIMIZE_LAZY_TUPLE_RECURSION +void GenFunctionDescriptorForLazyTupleRecursion (SymbDef sdef,int tuple_result_arity) +{ + Ident name_id; + char *name; + + name_id = sdef->sdef_ident; + name = name_id->ident_name; + + put_directive_ (Ddescn); + + if (sdef->sdef_exported){ + FPrintF (OutFile,"e_%s_" D_PREFIX "%s.2 ",CurrentModule,name); + FPrintF (OutFile,"e_%s_" N_PREFIX "%s.2 ",CurrentModule,name); + } else if (DoDebug){ + FPrintF (OutFile,D_PREFIX "%s.%u.2 ",name,sdef->sdef_number); + FPrintF (OutFile,N_PREFIX "%s.%u.2 ",name,sdef->sdef_number); + } else { + FPrintF (OutFile,LOCAL_D_PREFIX "%u.2 ",sdef->sdef_number); + FPrintF (OutFile,N_PREFIX "%u.2 ",sdef->sdef_number); + } + + FPrintF (OutFile, "%d 0 \"",sdef->sdef_arity+tuple_result_arity); + PrintSymbolOfIdent (name_id,0,OutFile); + FPutC ('\"',OutFile); + +# if 1 + put_directive_ (Ddescn); + + if (sdef->sdef_exported){ + FPrintF (OutFile,"e_%s_" D_PREFIX "%s.3 ",CurrentModule,name); + FPrintF (OutFile,"e_%s_" N_PREFIX "%s.3 ",CurrentModule,name); + } else if (DoDebug){ + FPrintF (OutFile,D_PREFIX "%s.%u.3 ",name,sdef->sdef_number); + FPrintF (OutFile,N_PREFIX "%s.%u.3 ",name,sdef->sdef_number); + } else { + FPrintF (OutFile,LOCAL_D_PREFIX "%u.3 ",sdef->sdef_number); + FPrintF (OutFile,N_PREFIX "%u.3 ",sdef->sdef_number); + } + + FPrintF (OutFile, "%d 0 \"",sdef->sdef_arity+tuple_result_arity); + PrintSymbolOfIdent (name_id,0,OutFile); + FPutC ('\"',OutFile); +# endif +} +#endif + +void GenLazyRecordDescriptorAndExport (SymbDef sdef) +{ + char *name; + int arity; + + if (!DescriptorNeeded (sdef)) + return; + + name = sdef->sdef_ident->ident_name; + arity = sdef->sdef_cons_arity; + + if (sdef->sdef_exported){ + put_directive_ (Ddescexp); + FPrintF (OutFile, "e_%s_" RECORD_D_PREFIX "%s e_%s_" RECORD_N_PREFIX "%s _hnf %d 1 \"%s\"", + CurrentModule,name,CurrentModule,name,arity,name); + } else { + if (ExportLocalLabels){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" RECORD_N_PREFIX "%s",CurrentModule,name); + } + + put_directive_ (Ddescn); + if (DoDebug){ + FPrintF (OutFile,RECORD_D_PREFIX "%s ",name); + if (ExportLocalLabels) + FPrintF (OutFile,"e_%s_" RECORD_N_PREFIX "%s ",CurrentModule,name); + else + FPrintF (OutFile,RECORD_N_PREFIX "%s ",name); + } else { + FPrintF (OutFile,RECORD_D_PREFIX "%u ",sdef->sdef_number); + if (ExportLocalLabels) + FPrintF (OutFile,"e_%s_" RECORD_N_PREFIX "%s ",CurrentModule,name); + else + FPrintF (OutFile,RECORD_N_PREFIX "%u ",sdef->sdef_number); + } + + FPrintF (OutFile, "%d 1 \"%s\"",arity,name); + } +} + +void GenFieldSelectorDescriptor (SymbDef sdef,int has_gc_apply_entry) +{ + char *name; + int arity; + + if (!DescriptorNeeded (sdef)) + return; + + name = sdef->sdef_ident->ident_name; + arity = (sdef->sdef_kind == RECORDTYPE) ? sdef->sdef_cons_arity : sdef->sdef_arity; + + put_directive_ (Ddesc); + if (sdef->sdef_exported){ + char *record_name; + + record_name=sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + + if (has_gc_apply_entry) + FPrintF (OutFile, "e_%s_" D_PREFIX "%s.%s e_%s_" N_PREFIX "%s.%s e_%s_%s%s.%s %d 0 \"%s\"", + CurrentModule,record_name,name, + CurrentModule,record_name,name, + CurrentModule,l_pref,record_name,name, + arity, name); + else + FPrintF (OutFile, "e_%s_" D_PREFIX "%s.%s e_%s_" N_PREFIX "%s.%s _hnf %d 0 \"%s\"", + CurrentModule,record_name,name, + CurrentModule,record_name,name, + arity, name); + } else if ((sdef->sdef_mark & SDEF_USED_LAZILY_MASK) || has_gc_apply_entry){ + char *record_name; + + record_name = sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name; + + if (DoDebug) + FPrintF (OutFile, D_PREFIX "%s.%s ",record_name,name); + else + FPrintF (OutFile, LOCAL_D_PREFIX "%u ", sdef->sdef_number); + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + if (DoDebug) + FPrintF (OutFile, N_PREFIX "%s.%s ",record_name,name); + else + FPrintF (OutFile, N_PREFIX "%u ",sdef->sdef_number); + } else + FPrintF (OutFile, "%s ", hnf_lab.lab_name); + + if (has_gc_apply_entry){ + if (DoDebug) + FPrintF (OutFile, "%s%s.%s ",l_pref,record_name,name); + else + FPrintF (OutFile, "%s%u ",l_pref,sdef->sdef_number); + } else + FPrintF (OutFile, "%s ", hnf_lab.lab_name); + + FPrintF (OutFile, "%d 0 \"%s\"", arity, name); + } else if (DoDebug){ + FPrintF (OutFile, D_PREFIX "%s %s %s %d 0 \"%s\"", name, hnf_lab.lab_name, + hnf_lab.lab_name, arity, name); + } else + FPrintF (OutFile, LOCAL_D_PREFIX "%u %s %s %d 0 \"%s\"", sdef->sdef_number, + hnf_lab.lab_name, hnf_lab.lab_name, arity, name); +} + +void GenModuleDescriptor ( +#if WRITE_DCL_MODIFICATION_TIME + FileTime file_time +#else + void +#endif + ) +{ + put_directive_ (Dmodule); + FPrintF (OutFile, "m_%s \"%s\"", CurrentModule,CurrentModule); + +#if WRITE_DCL_MODIFICATION_TIME + if (WriteModificationTimes){ + FPutC (' ',OutFile); + FPutC ('\"',OutFile); + FWriteFileTime (file_time,OutFile); + FPutC ('\"',OutFile); + } +#endif +} + +void GenDepend (char *modname +#if WRITE_DCL_MODIFICATION_TIME + ,FileTime file_time +#endif + ) +{ +#ifndef _STANDALONE_ + AddDependency (modname); +#endif + put_directive_ (Ddepend); + FPrintF (OutFile, "\"%s\"",modname); + +#if WRITE_DCL_MODIFICATION_TIME + if (WriteModificationTimes){ + FPutC (' ',OutFile); + FPutC ('\"',OutFile); + FWriteFileTime (file_time,OutFile); + FPutC ('\"',OutFile); + } +#endif +} + +void GenStart (SymbDef startsymb) +{ + if (startsymb->sdef_module == CurrentModule){ + int arity; + + arity = startsymb->sdef_arity; + startsymb->sdef_mark |= SDEF_USED_LAZILY_MASK; + + put_directive_ (Dexport); + FPrintF (OutFile, "__%s_Start", CurrentModule); + GenOAStackLayout (0); + + FPrintF (OutFile, "\n__%s_Start", CurrentModule); + + if (arity!=0){ + put_instruction_b (buildI); + put_arguments_n_b (65536l); + } + + put_instruction_b (build); + + if (startsymb->sdef_exported) + FPrintF (OutFile, "e_%s_" D_PREFIX "Start",CurrentModule); + else if (DoDebug){ + if (DoParallel) + FPrintF (OutFile, D_PREFIX "Start.%u",startsymb->sdef_number); + else + FPutS (empty_lab.lab_name, OutFile); + } else { + if (DoParallel) + FPrintF (OutFile, LOCAL_D_PREFIX "%u",startsymb->sdef_number); + else + FPutS (empty_lab.lab_name, OutFile); + } + + put_arguments__n__b (arity); + + if (startsymb->sdef_exported) + FPrintF (OutFile, "e_%s_" N_PREFIX "Start",CurrentModule); + else if (DoDebug) + FPrintF (OutFile, N_PREFIX "Start.%u",startsymb->sdef_number); + else + FPrintF (OutFile, N_PREFIX "%u",startsymb->sdef_number); + + GenDAStackLayout (1); + put_instruction_b (jmp); + FPutS ("_driver", OutFile); + } +} + +void GenSelectorDescriptor (Label sellab,char *g_pref) +{ + put_directive_ (Ddesc); + FPrintF (OutFile, D_PREFIX "%s.%d %s%s.%d %s%s.%d 1 0 \"%s.%d\"", + sellab->lab_name, sellab->lab_post, + sellab->lab_pref, sellab->lab_name, sellab->lab_post, + g_pref, sellab->lab_name, sellab->lab_post, + sellab->lab_name, sellab->lab_post); +} + +void InitFileInfo (ImpMod imod) +{ + char option_string[NR_OPTIONS+1]; + CompilerOptions opts; + SymbDef start_sdef; + + start_sdef=imod->im_start; + +#ifndef _STANDALONE_ + MakeOptionsFromCurrentOptions (& opts); +#endif + ConvertOptionsToString (opts,option_string); + + if (imod->im_def_module!=NULL && imod->im_def_module->dm_system_module) + option_string[N_System]='1'; + + put_first_directive_ (Dcomp); + FPrintF (OutFile, "%d %s", VERSION,option_string); +#ifndef _STANDALONE_ + AddVersionAndOptions (VERSION, opts); +#endif + put_directive_ (Dcode); + FPrintF (OutFile, "%7ld %7ld %7ld", (long) 0, (long) 0, (long) 0); + + put_directive_ (Dstart); + if (start_sdef!=NULL){ + FPrintF (OutFile, "__%s_Start",start_sdef->sdef_module); + } else + FPutS ("_nostart_", OutFile); +} + +void GenNoMatchError (SymbDef sdef,int asp,int bsp,int string_already_generated) +{ + Bool desc_needed; + + desc_needed = DescriptorNeeded (sdef); + + GenPopA (asp); + GenPopB (bsp); + + put_instruction_b (pushD); + FPrintF (OutFile, "m_%s", CurrentModule); + + put_instruction_b (pushD); + if (!desc_needed) + FPrintF (OutFile, "x_%u", sdef->sdef_number); + else if (sdef->sdef_exported) + FPrintF (OutFile, "e_%s_" D_PREFIX "%s", CurrentModule, sdef->sdef_ident->ident_name); + else if (DoDebug){ + if (sdef->sdef_kind==IMPRULE) + FPrintF (OutFile, D_PREFIX "%s.%u", sdef->sdef_ident->ident_name,sdef->sdef_number); + else + FPrintF (OutFile, D_PREFIX "%s", sdef->sdef_ident->ident_name); + } else + FPrintF (OutFile, LOCAL_D_PREFIX "%u", sdef->sdef_number); + + if (DoStackLayout){ + put_directive_b (d); + put_arguments_nn__b (0,2); + FPutS ("ii",OutFile); + } + + GenJmp (&match_error_lab); + + if (!desc_needed && !string_already_generated){ + put_directive_ (Dstring); + FPrintF (OutFile, "x_%u \"",sdef->sdef_number); + PrintSymbolOfIdent (sdef->sdef_ident, sdef->sdef_line,OutFile); + FPutS ("\"", OutFile); + } +} + +static void GenImpLab (char *label_name) +{ + put_directive_b (implab); + FPutS (label_name,OutFile); +} + +static void GenImpLab_node_entry (char *label_name,char *ea_label_name) +{ + put_directive_b (implab); + FPrintF (OutFile,"%s %s",label_name,ea_label_name); +} + +static void GenImpDesc (char *descriptor_name) +{ + put_directive_b (impdesc); + FPutS (descriptor_name,OutFile); +} + +void GenEndInfo (void) +{ + put_directive (Dendinfo); +} + +void GenSystemImports (void) +{ + if (DoStackLayout){ + /* system module labels and descriptors */ + + int selnum; + + if (DoParallel){ + GenImpLab (channel_code); + GenImpLab (hnf_reducer_code); + GenImpDesc (ext_hnf_reducer_code); + GenImpLab (nf_reducer_code); + GenImpDesc (ext_nf_reducer_code); + GenImpLab (reserve_lab.lab_name); + } + GenImpLab (cycle_lab.lab_name); + GenImpLab (type_error_lab.lab_name); + GenImpLab (hnf_lab.lab_name); + + GenImpDesc ("_ind"); + GenImpLab_node_entry (indirection_lab.lab_name,"_eaind"); + GenImpDesc ("e_system_dif"); + GenImpLab_node_entry ("e_system_nif","e_system_eaif"); + 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 (tuple_lab.lab_name); + + for (selnum=1; selnum<=NrOfGlobalSelectors; ++selnum){ + put_directive_b (impdesc); + FPrintF (OutFile,D_PREFIX "%s.%d",glob_sel,selnum); + put_directive_b (implab); + FPrintF (OutFile,N_PREFIX "%s.%d " EA_PREFIX "%s.%d",glob_sel,selnum,glob_sel,selnum); + } +#ifdef THUNK_LIFT_SELECTORS + for (selnum=1; selnum<=NrOfGlobalSelectors; ++selnum){ + put_directive_b (impdesc); + FPrintF (OutFile,D_PREFIX "%s.%d",glob_selr,selnum); + put_directive_b (implab); + FPrintF (OutFile,N_PREFIX "%s.%d " EA_PREFIX "%s.%d",glob_selr,selnum,glob_selr,selnum); + } +#endif + GenImpLab ("_driver"); + } +} + +void GenParameters (Bool input, Parameters params, int asp, int bsp) +{ + int is_first_parameter; + + if (params==NULL) + return; + + if (input) + put_instruction_ (Iin); + else + put_instruction_ (Iout); + + is_first_parameter=1; + for (; params!=NULL; params=params->par_next){ + NodeId node_id; + + node_id=params->par_node_id; + if (!is_first_parameter) + FPutC (' ',OutFile); + if (IsSimpleState (node_id->nid_state) && node_id->nid_state.state_kind==OnB) + FPrintF (OutFile, "b%d:%s",bsp-node_id->nid_b_index,params->par_loc->ident_name); + else + FPrintF (OutFile, "a%d:%s",asp-node_id->nid_a_index,params->par_loc->ident_name); + is_first_parameter=0; + } +} + +void GenInstructions (Instructions ilist) +{ + for (; ilist; ilist = ilist->instr_next){ + char *instruction_name; + + instruction_name=ilist->instr_this; + + FPutC ('\n',OutFile); + if (instruction_name[0]==':') + FPutS (&instruction_name[1],OutFile); + else { + if (instruction_name[0]!='.') + FPutC ('\t',OutFile); + FPutS (instruction_name,OutFile); + } + } + if (!DoDebug) + FPutC ('\n',OutFile); +} + +void GenTestCaf (Label label) +{ + put_instruction_ (Itestcaf); + GenLabel (label); +} + +void GenPushCaf (Label label,int a_stack_size,int b_stack_size) +{ + put_instruction_ (Ipushcaf); + GenLabel (label); + FPrintF (OutFile," %d %d",a_stack_size,b_stack_size); +} + +void GenFillCaf (Label label,int a_stack_size,int b_stack_size) +{ + put_instruction_ (Ifillcaf); + GenLabel (label); + FPrintF (OutFile," %d %d",a_stack_size,b_stack_size); +} + +void GenCaf (Label label,int a_stack_size,int b_stack_size) +{ + put_directive_ (Dcaf); + GenLabel (label); + FPrintF (OutFile," %d %d",a_stack_size,b_stack_size); +} + +void GenPB (char *function_name) +{ + put_directive_ (Dpb); + FPrintF (OutFile,"\"%s\"",function_name); +} + +void GenPD (void) +{ + put_directive (Dpd); +} + +void GenPN (void) +{ + put_directive (Dpn); +} + +void GenPL (void) +{ + put_directive (Dpl); +} + +void GenPLD (void) +{ + put_directive (Dpld); +} + +void GenPT (void) +{ + put_directive (Dpt); +} + +void GenPE (void) +{ + put_directive (Dpe); +} + +void GenKeep (int a_offset1,int a_offset2) +{ + put_directive_ (Dkeep); + FPrintF (OutFile,"%d %d",a_offset1,a_offset2); +} + +#if IMPORT_OBJ_AND_LIB +void GenImpObj (char *obj_name) +{ + put_directive_ ("impobj"); + FPrintF (OutFile,"%s",obj_name); +} + +void GenImpLib (char *lib_name) +{ + put_directive_ ("implib"); + FPrintF (OutFile,"%s",lib_name); +} +#endif + +void InitInstructions (void) +{ + ABCFileName = NULL; + SetUnaryState (& ApplyState, StrictRedirection, UnknownObj); + ApplyLabel = NULL; +} |