Nano
the
nanny of
pico
source
v1.2
Naam
: Van Belle Werner
e-mail : we47091@is2.vub.ac.be
programmeerproject
1e licentie Computerwetenschappen
projectbegeleider:
Wolfgang De Meuter
Inhoudsopgave............ 2
Compiler............ 3
Headerfiles............... 3
ag.h............... 4
codewrit.h............... 7
collect.h............... 8
dict.h............... 8
env.h............... 8
gencode.h............... 11
list.h............... 11
names.h............... 12
nano.h............... 12
natives.h............... 12
optimize.h............... 13
read.h............... 13
scan.h............... 14
stk.h............... 15
talker.h............... 16
zmalloc.h............... 16
Implementation............... 17
ag.c............... 18
codewrit.c............... 18
collect.c............... 22
dict.c............... 24
env.c............... 25
gencode.c............... 28
list.c............... 35
names.c............... 37
nano.c............... 38
natives.c............... 39
optimize.c............... 42
read.c............... 46
scan.c............... 60
stk.c............... 65
talker.c............... 65
zmalloc.c............... 66
Runtime............ 67
nat_more.java............... 67
nat_less.java............... 67
nat_if.java............... 67
nat_begin.java............... 68
FunctionObject.java............... 68
nat_times.java............... 69
NativeFunction.java............... 69
nat_until.java............... 70
BasicFunction.java............... 70
FormalParam.java............... 70
FunctionVastParam.java............... 70
FunctionVarParam.java............... 71
nat_display.java............... 72
nat_while.java............... 72
nat_add.java............... 72
nat_div.java............... 73
nat_eq.java............... 73
nat_mod.java............... 73
nat_size.java............... 73
DoorVerwijzing.java............... 74
nat_not.java............... 74
nat_sub.java............... 74
/* een expressie is ene pointer naar een TAG, en deze kan dan (moet dan)
* gecast worden in het juiste item)*/
typedef enum
{UndefinedCall,
NormalCall, /* parameters worden allemaal in gepakt meegegeven */
ActionCall, /* enkel de nodige parameters worden ingepakt en meegegeven */
InlineCall /* enkel voor natives zoals begin/if/while ... */
} CallType;
typedef enum _tag_
{
_FRC_TAG_ = 0,
_STR_TAG_ = 1,
_TAB_TAG_ = 2,
_RFN_TAG_ = 3,
_DFN_TAG_ = 4,
_STN_TAG_ = 5,
_RFF_TAG_ = 6,
_DFF_TAG_ = 7,
_STF_TAG_ = 8,
_RFT_TAG_ = 9,
_DFT_TAG_ = 10,
_STT_TAG_ = 11,
_NBR_TAG_ = 12,
_FOR_TAG_ = 13,
} _TAG_;
typedef long Number;
typedef double Fraction;
typedef char* String;
typedef unsigned Size;
struct _env_;
typedef struct _env_*_ENV_;
struct _frm_;
typedef struct _frm_*_FRM_;
typedef _TAG_ Magic;
typedef Magic *_EXP_;
typedef struct FOR {Magic structheader;
String NAM;
int FrameNr;
_EXP_ EXP;} *_FOR_; /* formal parameters */
typedef struct DFN {Magic structheader; /* define's */
String NAM;
_EXP_ EXP;} *_DFN_;
typedef struct NBR {Magic structheader; /* number's */
Number NBR;} *_NBR_;
typedef struct RFN {Magic structheader; /* variable reference */
String Rfn;} *_RFN_;
typedef struct DFT {Magic structheader; /* table definition */
String NAM;
_EXP_ IDX;
_EXP_ EXP;} *_DFT_;
typedef struct RFF {Magic structheader; /* function reference */
String NAM;
CallType HowToCall;
_EXP_ ARG;} *_RFF_;
typedef struct TAB {Magic structheader; /* tables */
Size SIZ;
_EXP_ *EXP;} *_TAB_;
typedef struct STR {Magic structheader; /* strings */
String Str;} *_STR_;
typedef struct FRC {Magic structheader; /* doubles */
Fraction Frc;} *_FRC_;
typedef struct STN {Magic
structheader; /* assignment */
String NAM;
_EXP_ EXP;} *_STN_;
typedef struct RFT {Magic structheader; /* table reference */
String NAM;
_EXP_ IDX;} *_RFT_;
typedef struct STT {Magic structheader; /* table assignment */
String NAM;
_EXP_ IDX;
_EXP_ EXP;} *_STT_;
typedef struct STF {Magic structheader; /* function assignment */
String NAM;
_EXP_ ARG;
_EXP_ EXP;} *_STF_;
typedef struct DFF {Magic structheader; /* function definition */
String NAM;
String WON;
_EXP_ ARG;
_EXP_ EXP;
_ENV_ ENV;} *_DFF_;
#define _make_exp_(tag) ((_##tag##_)_allocate_exp_(_##tag##_TAG_,sizeof(struct tag)))
extern _EXP_ _allocate_exp_(_TAG_ tag, int size);
/* tag opvragen */
#define _ag_EXP_TAG_(AGR) (*(_EXP_)(AGR))
#define aAT(AGR,tag) (assert((AGR) && _ag_EXP_TAG_(AGR)==_##tag##_TAG_),(_##tag##_)(AGR))
/* function definition */
#define _ag_make_DFF_() _make_exp_(DFF)
#define _ag_get_DFF_NAM_(AGR) aAT(AGR,DFF)->NAM
#define _ag_get_DFF_WON_(AGR) aAT(AGR,DFF)->WON
#define _ag_get_DFF_ENV_(AGR) aAT(AGR,DFF)->ENV
#define _ag_get_DFF_ARG_(AGR) aAT(AGR,DFF)->ARG
#define _ag_get_DFF_EXP_(AGR) aAT(AGR,DFF)->EXP
#define _ag_set_DFF_WON_(AGR, nor) aAT(AGR,DFF)->WON=nor
#define _ag_set_DFF_NAM_(AGR, nam) aAT(AGR,DFF)->NAM=nam
#define _ag_set_DFF_ARG_(AGR, arg) aAT(AGR,DFF)->ARG=arg
#define _ag_set_DFF_ENV_(AGR, env) aAT(AGR,DFF)->ENV=env
#define _ag_set_DFF_EXP_(AGR, exp) aAT(AGR,DFF)->EXP=exp
#define _ag_DFF_VarParam_(AGR) (*(aAT(AGR,DFF)->ARG)==_RFN_TAG_)
/* formele parameters */
#define _ag_make_FOR_() _make_exp_(FOR)
#define _ag_get_FOR_framenr_(AGR) aAT(AGR,FOR)->FrameNr
#define _ag_set_FOR_framenr_(AGR,fnr) aAT(AGR,FOR)->FrameNr=fnr
#define _ag_get_FOR_NAM_(AGR) aAT(AGR,FOR)->NAM
#define _ag_get_FOR_EXP_(AGR) aAT(AGR,FOR)->EXP
#define _ag_set_FOR_NAM_(AGR,n) aAT(AGR,FOR)->NAM=(n)
#define _ag_set_FOR_EXP_(AGR,e) aAT(AGR,FOR)->EXP=(e)
/* function assignment */
#define _ag_make_STF_() _make_exp_(STF)
#define _ag_get_STF_NAM_(AGR) aAT(AGR,STF)->NAM
#define _ag_get_STF_ARG_(AGR) aAT(AGR,STF)->ARG
#define _ag_get_STF_EXP_(AGR) aAT(AGR,STF)->EXP
#define _ag_set_STF_NAM_(AGR, nam) aAT(AGR,STF)->NAM=nam
#define _ag_set_STF_ARG_(AGR, arg) aAT(AGR,STF)->ARG=arg
#define _ag_set_STF_EXP_(AGR, exp) aAT(AGR,STF)->EXP=exp
/* table assignment */
#define _ag_make_STT_() _make_exp_(STT)
#define _ag_get_STT_NAM_(AGR) aAT(AGR,STT)->NAM
#define _ag_get_STT_IDX_(AGR) aAT(AGR,STT)->IDX
#define _ag_get_STT_EXP_(AGR) aAT(AGR,STT)->EXP
#define _ag_set_STT_NAM_(AGR, nam) aAT(AGR,STT)->NAM=nam
#define _ag_set_STT_IDX_(AGR, idx) aAT(AGR,STT)->IDX=idx
#define _ag_set_STT_EXP_(AGR, exp) aAT(AGR,STT)->EXP=exp
/*
table reference */
#define _ag_make_RFT_() _make_exp_(RFT)
#define _ag_get_RFT_NAM_(AGR) aAT(AGR,RFT)->NAM
#define _ag_get_RFT_IDX_(AGR) aAT(AGR,RFT)->IDX
#define _ag_set_RFT_NAM_(AGR, nam) aAT(AGR,RFT)->NAM=nam
#define _ag_set_RFT_IDX_(AGR, idx) aAT(AGR,RFT)->IDX=idx
/* assignment */
#define _ag_make_STN_() _make_exp_(STN)
#define _ag_get_STN_NAM_(AGR) aAT(AGR,STN)->NAM
#define _ag_get_STN_EXP_(AGR) aAT(AGR,STN)->EXP
#define _ag_set_STN_NAM_(AGR, namke) aAT(AGR,STN)->NAM=namke
#define _ag_set_STN_EXP_(AGR, expke) aAT(AGR,STN)->EXP=expke
/* strings */
_STR_ _ag_make_STR_(char *Str);
#define _ag_get_STR_(AGR) aAT(AGR,STR)->Str
/* tables */
_TAB_ _ag_make_TAB_(int SIZ);
#define _ag_get_TAB_SIZ_(AGR) aAT(AGR,TAB)->SIZ
#define _ag_get_TAB_EXP_(AGR, IDX) aAT(AGR,TAB)->EXP[IDX-1]
#define _ag_set_TAB_EXP_(AGR, IDX ,exp) (assert(IDX>0 && (IDX-1)<_ag_get_TAB_SIZ_(AGR)),aAT(AGR,TAB)->EXP[(IDX)-1]=exp)
void _TAB_foreach_(_TAB_ tab,_EXP_ (*f)(_EXP_, void*) ,void* common);
/* function references */
_RFF_ _ag_make_RFF_(void);
#define _ag_get_RFF_HowToCall_(AGR) aAT(AGR,RFF)->HowToCall
#define _ag_set_RFF_HowToCall_(AGR,htc) aAT(AGR,RFF)->HowToCall=htc
#define _ag_get_RFF_NAM_(AGR) aAT(AGR,RFF)->NAM
#define _ag_get_RFF_ARG_(AGR) aAT(AGR,RFF)->ARG
#define _ag_set_RFF_NAM_(AGR, namje) aAT(AGR,RFF)->NAM=namje
#define _ag_set_RFF_ARG_(AGR, argje) aAT(AGR,RFF)->ARG=argje
#define _ag_RFF_VarParam_(AGR) (*(aAT(AGR,RFF)->ARG)==_RFN_TAG_)
/* table definition */
#define _ag_make_DFT_() _make_exp_(DFT)
#define _ag_get_DFT_NAM_(AGR) aAT(AGR,DFT)->NAM
#define _ag_get_DFT_IDX_(AGR) aAT(AGR,DFT)->IDX
#define _ag_get_DFT_EXP_(AGR) aAT(AGR,DFT)->EXP
#define _ag_set_DFT_NAM_(AGR, NAMje) aAT(AGR,DFT)->NAM=NAMje
#define _ag_set_DFT_IDX_(AGR, IDXje) aAT(AGR,DFT)->IDX=IDXje
#define _ag_set_DFT_EXP_(AGR, EXPje) aAT(AGR,DFT)->EXP=EXPje
/* variable reference */
#define _ag_make_RFN_() _make_exp_(RFN)
#define _ag_get_RFN_NAM_(AGR) aAT(AGR,RFN)->Rfn
#define _ag_set_RFN_NAM_(AGR, NAMje) aAT(AGR,RFN)->Rfn=NAMje
/* numbers */
_NBR_ _ag_make_NBR_(Number NBR);
#define _ag_get_NBR_(AGR) aAT(AGR,NBR)->NBR
/* definitions */
#define _ag_make_DFN_() _make_exp_(DFN)
#define _ag_get_DFN_NAM_(AGR) aAT(AGR,DFN)->NAM
#define _ag_get_DFN_EXP_(AGR) aAT(AGR,DFN)->EXP
#define _ag_set_DFN_NAM_(AGR, namke) aAT(AGR,DFN)->NAM=namke
#define _ag_set_DFN_EXP_(AGR, expke) aAT(AGR,DFN)->EXP=expke
/* doubles */
_FRC_ _ag_make_FRC_(Fraction frc);
#define _ag_get_FRC_(AGR) aAT(AGR,FRC)->Frc
struct VariableStruct
{
int varnr;
int index;
/* array-index, staat op
-1 indien niet geindexeert */
int
declaredasarray; /* staat op
#t indien gedeclareert als array */
};
typedef struct VariableStruct *_VAR_;
/*------------------------------------*/
/* introduceren van nieuwe variabelen */
/*------------------------------------*/
_VAR_ _wci_label_(void);
/* geeft een nieuwe label weer */
_VAR_ _wci_var_(void);
/* geeft een nieuwe variabele weer */
_VAR_ _wci_array_(void);
/* alloceert een array van de juiste groote : Object newvar[]*/
/* tijdelijk */
void writevar(_VAR_ v);
void _wc_return_(_VAR_ who);
/* geeft het functieresultaat weert */
/*----------------------------------*/
/* fetchen en storen van variabelen */
/*----------------------------------*/
void _wc_lookup_var_(_VAR_ target, int back, int framenr);
/* zoekt een variabele op in de environments */
void _wc_load_parameter_(_VAR_ target, char* won);
/* laad een formele parameter in target */
void _wc_define_var_(_VAR_ source, int framenr);
/* een variabele definieren */
void _wc_set_var_(_VAR_ source, int back, int framenr);
/* set een variabele in de environmments */
/*------------------*/
/* mogelijke acties */
/*------------------*/
void _wc_actioncall_(_VAR_ storein, _VAR_ funself,_VAR_ argsvar);
void _wc_normalcall_(_VAR_ storein, _VAR_ funself,_VAR_ argsvar);
/* void _wc_functioncall_(_VAR_ storein, _VAR_ funself,_VAR_ argsvar);*/
/* storein=funself(argsvar) */
void _wc_index_array_(_VAR_ target, _VAR_ source, _VAR_ idx);
/* target=source[idx] */
void _wc_assign_(_VAR_ target, _VAR_ source);
/* targer=source */
void _wc_assign_index_array_(_VAR_ target,_VAR_ idx,_VAR_ source);
/* targezt[idx.intvalue-1]=source; */
/*--------------------------------*/
/* alloceren van nieuwe data */
/*--------------------------------*/
void _wca_number_(_VAR_ target, long number);
/* Object target=new Integer(number) */
void _wca_function_definition_(_VAR_ target, char* name);
/* Object target=new name(environment) */
void _wca_str_(_VAR_ target, char* str);
/* alloceert een runtime string */
void _wca_array_(_VAR_ target, int siz);
/* alloceert een nieuwe array */
void _wca_table_(_VAR_ target,_VAR_ siz, _VAR_ contexp);
/* alloceert een table, opgevuld met contexp */
void _Collect_Data_(const _EXP_
exp);
/*
interpreteert de code op voorhand om een idee
* te krijgen over
* - de
environments
* -
born
* -
welke functiedefinities
*/
dict.h
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* Lab voor Programmeerkunde VUB */
/* ©1995 */
/*-----------------------------------*/
String _dct_make_NAM_(const char *);
void _dct_allocate_(void *, unsigned);
/***************************************************************************/
/** **/
/** F.R.A.M.E.S **/
/** **/
/***************************************************************************/
/* een frame is een voorstelling van de levensloop van een variabelenaam in
* ene bepaalde envioronment */
struct _frm_
{String name;
/* de naam van een frame. strcmp(namefrm1, namefrm2)==0
* a.s.a namefrm1==namefrm2 */
int framenr;
/* FrameNr beschrijft waar de frame voor zal komen in de
* environment */
_ENV_ env;
/* is een pointer naar de environment waarin deze frame
* voorkomt */
struct flags
{int read : 1;
/* gezet, indien de variabele uitgelezen wordt. Dit wil niet
* noodzakelijk zeggen dat de variabele ook hier gedefinieerd
* is */
int native : 2;
/* zegt of de variabele gedefinieerd is
* als een native function is */
int called : 3;
/* zegt of de bewuste naam gecalled wordt. Hier zou ik
* onderscheid kunnen maken tussen wat voor soort call
* (bv normalcall, applycall, en enventuele anderen) maar dit
* doe ik niet. */
int parameter : 4;
/* Zegt of deze frame een parameter is.*/
int parameterlst : 5;
/* Zegt of deze frame een volledige parameterlijst voorstelt.
* Indien dat het geval is MOET framenr nadien op 0 staan. */
int written : 6;
/* Zegt of de variabele ooit beschreven is, los van het feit
* dat de variabele hier al dan niet gedefinieerd is.
* table assignment wordt ook bij written gevoegd */
int defined : 7;
/* de variabele wordt in
deze environmpent gedefinieerd, al
* de definities aan de
variabele staan opgegeven in de
* DefineList*/
} flags;
Plist DefineList;
/* een lijst van eventueel nuttige expressies die ooit in de
* definitie van de variabele voorkomen */
Plist CallList;
/* een lijst van al de RFF-expressies die deze variabele
* callen */
};
typedef struct _frm_ *_FRM_;
_FRM_ _frm_create_(String name, _ENV_ env);
/* creert een frame met variabelenaam 'name', in de
* gegeven environment */
#define _frm_valid_(frm) (frm && frm->name && frm->env)
/* check om te zien of het wel een geldige frame is */
#define _frm_env_(frm) (frm->env)
/* opvragen van de environment. Deze is altijd gedefinieerd */
#define _frm_name_(frm) (frm->name)
/* popvragen van de framename. Deze is
* altijd gedefinieerd */
#define _frm_set_framenr_(frm,nr) (frm->framenr=nr)
#define _frm_framenr_(frm) (frm->framenr)
/* zetten en lezen van het framenummer op */
#define _frm_mark_read_(frm) (frm->flags.read=1)
#define _frm_read_(frm) (frm->flags.read)
/* zetten en lezen van de read-flag */
#define _frm_mark_written_(frm) (frm->flags.written=1)
#define _frm_written_(frm) (frm->flags.written)
/* zetten en lezen van de 'write' flag */
#define _frm_mark_called_(frm) (frm->flags.called=1)
#define _frm_called_(frm) (frm->flags.called)
#define _frm_foreach_call_(frm,func,common) l_foreach((frm)->CallList,(func),(common))
#define _frm_add_called_(frm, rffexp) l_add((frm)->CallList,(rffexp));
/* zetten en lezen van de 'called' flag */
#define _frm_mark_parameter_(frm) (frm->flags.parameter=1)
#define _frm_parameter_(frm) (frm->flags.parameter)
/* zetten en lezen van de 'parameter' flag */
#define _frm_mark_parameterlst_(frm) (frm->flags.parameterlst=1)
#define _frm_parameterlst_(frm) (frm->flags.parameterlst)
/* zetten en lezen van de 'parameterlst' flag */
#define _frm_mark_native_(frm) (frm->flags.native=1)
#define _frm_native_(frm) (frm->flags.native)
_DFF_ _frm_get_native_definition_(_FRM_ frm);
/* zetten en lezen van de 'native' flag */
#define _frm_mark_defined_(frm) (frm->flags.defined=1)
#define _frm_defined_(frm) (frm->flags.defined)
#define _frm_add_definition_(frm, exp) l_add((frm)->DefineList,(exp))
#define _frm_add_native_definition_(frm, exp) l_add((frm)->DefineList,(exp))
#define _frm_foreach_definition_(frm,func,common) l_foreach((frm)->DefineList,(func),(common))
/* zetten en lezen van de 'defined' flag en toebehoren */
/***************************************************************************/
/**
**/
/**
E.N.V.I.R.O.N.M.E.N.T.S
**/
/**
**/
/***************************************************************************/
/* een environment is 1-1 gerelateerd ten opzichte van een function
* definition dus ik vraag mij af of het
niet betere is environments en
* functiedefinities te laten
samenvallen */
struct _env_
{struct _env_* DefinedIn;
/* DefinedIn beschrijft
in welke environment deze steeds
* gedefinieerd zal
worden, bij de root_env staat DefinedIn
* op NULL */
int size;
/* De grootte van de
environment-array @ runtime, deze is
* pas geldig na een env_close van de root */
Plist FORlist;
/* een lijst van formele parameters die eventueel
* gebruikt zullen worden in de functie. Na een env_close
* is dit een lijst van gebruikte parameters */
Plist frames;
/* hierin worden frames opgeslagen. Zolang de environments
* niet gesloten zijn bevatten deze halfbakken informatie.*/
};
_ENV_ _env_create_(_ENV_ DefinedIn);
#define _env_definedin_(env) (env->DefinedIn)
/* definieert een nieuwe environment, die gedefinieerd is in
* DefinedIn. Zet deze op 0 als dit de root_env moet zijn */
#define _env_size_(env) (env->size)
#define _env_set_size_(env,siz) (env->size=siz)
/* opvragen en zetten van de environment grootte */
#define _env_foreach_formal_(env,func,common) l_foreach((env)->FORlist,func,common)
#define _env_add_formal_(env, formal) l_add(env->FORlist,formal)
/* een formele functieparameter toevoegen */
#define _env_add_frame_(env,frm) l_add(env->frames,frm)
#define _env_firstthat_frm_(env,func,common) l_firstthat(env->frames,func,common)
#define _env_foreach_frm_(env,func,common) l_foreach(env->frames,func,common)
/* frame bewerkingen */
/***************************************************************************/
/** **/
/** globale bewerkingen **/
/** **/
/***************************************************************************/
extern Plist function_list;
/* een lijst van alle functies die gedefinieerd worden */
extern _ENV_ root_env;
/* de rootenvironment */
void foreach_env(void (*f)(_ENV_));
struct LookupResult {
_FRM_ frm; /* de frame die gevonden werd */
int back; /* hoeveel er teruggelopen moet worden */
};
_FRM_ lookup_frm_in_env(_ENV_ env,String name);
/* zoekt de frame op met naam 'name' in de 'env'
* Hier wordt niet verder gezocht in DefinedIn en hoger.
* Geeft NULL weer indien er geen dergelijke frame voorkomt */
_FRM_ find_frm_in_env(_ENV_ env,String name);
/* zoekt de frame op met naam 'name' in de 'env'
* Hier wordt niet verder gezocht in DefinedIn en hoger.
* Als name niet voorkomt wordt ter stond een frame gecreeert*/
struct LookupResult next_frm(_FRM_ frm);
/* deze zoekt de volgende frame op */
struct LookupResult
lookup_frm(_ENV_ env,
String name);
/* zoekt de frame op met
naam 'name' in de 'env'
* Hier wordt verder
gezocht in DefinedIn en hoger.
* Geeft NULL weer in frm
indien er geen dergelijke frame
* voorkomt */
_FRM_ introduce_name(_ENV_ env, String name);
/* creeert altijd een nieuwe frame met name 'name'
* en environment 'env'.
* voegt de define-expressie toe aan de lijst
* Stopt deze in env en geeft het resultaat weer */
_FRM_ define_name(_ENV_ env, String name);
/* creeert een frame met name 'name' (indien nodig)
* en environment 'env'.
* voegt de define-expressie toe aan de lijst
* Stopt deze in env en geeft het resultaat weer */
void write_name(_ENV_ env, String name);
/* markeert de frame met naam 'name' as beeing written.
* Indien er zo geen frame is zal er prompto 1 worden
* aangemaakt en natuurlijk ook gemarkeerd als written. */
void read_name(_ENV_ env, String name);
/* markeert de frame met naam 'name' as beeing read.
* Indien er zo geen frame is zal er prompto 1 worden
* aangemaakt en natuurlijk ook gemarkeerd als read. */
_FRM_ call_name(_ENV_ env, String name);
/* markeert de frame met naam 'name' as beeing called.
* Indien er zo geen frame is zal er prompto 1 worden
* aangemaakt en natuurlijk ook gemarkeerd als called. */
void ShowFrame(_FRM_ frm);
/* toont de gegeven frame */
void ShowEnvironment(_ENV_ env);
/* toont de gegeven environment, met bijhorende frames */
void ShowEnvironments(_ENV_ env);
/* toont de gegeven environment en al de hoger liggende */
void ShowAllEnvironments(void);
/* toont al de gekende environments */
void _Generate_Code_(const _EXP_ exp, const char* uitvoerclasse);
/* genereert code voor de expressie exp */
struct cell {
struct cell *next;
void *contents;
};
typedef struct cell *Pcell;
typedef Pcell Plist;
Plist make_list(void);
/*maakt domweg een lege lijst, geeft null weer indien er iets fout
is gelopen*/
Plist l_add(Plist l,void* w);
/*voegt void* toe aan de lijst, geeft 0 weer indien niets is toegevoegd.
Anders wordt de lijst weergegeven.*/
void* l_firstthat(Plist l, void* (*func)(void*item,void*com),void*com);
/*gaat de lijst af van voor naar achter en stopt zodra func 1 weergeeft.
het resultaat van l_firstthat is 1 indien gestopt is en 0 anders.*/
Plist l_foreach(Plist l, void*
(*func)(void*item,void*com),void*com);
/*
* gaat elk element van de lijst af,
geeft als resultaat de lijst weer.
* de functie krijgt als parameter
gewoon 1 lijst binnen. Als resultaat
* zou de nieuwe contents moeten
weergegeven worden. Indien null wordt
* weergegeven betekend dit dat het
element verwijdert is worden.
*/
void delete_list(Plist l);
/* deze verwijdert al de gegevens die horen bij de list.
Maw de contentsen worden niet verwijdert.*/
void* l_first(Plist l);
void* l_last(Plist l);
/* vraagt het eerst element, respectievelijk het laatste van de lijst op*/
void l_delete_first(Plist l);
/* verwijdert het eerste element van de lijst*/
int l_elcount(Plist l);
/* geeft weer hoeveel elementen er in de lijst steken */
char*MakeCompilerName();
/* maakt een
naam die niet gekend mag zijn door het userprogramma, zelfs
* niet bereikbaar */
char*MakeUniqueName(char*
n);
/* maakt een naam die uniek is en toch nog trek op n zelf */
nano.h
#include <stdarg.h>
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include "TALKER.H" /* user interface */
#include "LIST.H" /* een ADTtje */
#include "AG.H" /* parse tree */
#include "ENV.H" /* environments */
#include "CODEWRIT.H" /* intermediate code writer */
#include "COLLECT.H" /* maakt tijdloze environments uit de a.g */
#include "DICT.H" /* de string-dictionary */
#include "GENCODE.H" /* de intermediate code generator */
#include "NAMES.H" /* name-space */
#include "NATIVES.H" /* natives introduceren */
#include "READ.H" /* reader */
#include "SCAN.H" /* scanner */
#include "STK.H" /* stack voor reader & scanner */
#include "OPTIMIZE.H" /* environment optimizer */
#include "ZMALLOC.H" /* nieuwe malloc */
extern char *native_begin;
extern char *native_if;
extern char *native_until;
extern char *native_while;
void _install_natives_(void);
void CloseEnvironments(void);
/* 1. verspreid al de kennis van lager niveaus hogerop */
void RemoveRedundantFORs(void);
/* 2. zoekt al de functies op die slechts 1 definitie hebben
* en die alleen maar gecalled worden
* 3. past de caller's van deze functie aan zodat ze iets
* performanter zijn
*/
void NumberFrames(void);
/* 4. Al de frames in een environment worden genummerd.
* De overbodige worden weggelaten
* - frames die in deze environment niet nodig blijken
* (zuivere actie-frames)
* - frames die een native bevatten die nooit gebruikt
* wordt
* Eventuele parameters starten gegarandeert op positie 0
* Nadien komen de lokale variabelen
* Uiteindelijk de zelf gecreeerde namen (formele parameters)
*/
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* Lab voor Programmeerkunde VUB */
/* ©1995 */
/*-----------------------------------*/
/*----------------------------------------------------------------------------*/
/*SPECIFICATION */
/* <spc> ::= <exp> */
/* <spc> ::= <idf> ':' <spc> => (DFN #nam# <spc>) */
/* <spc> ::= <tab> ':' <spc> => (DFT #nam# <idx> <spc>) */
/* <spc> ::= <apl> ':' <spc> => (DFF #ref# <arg> <spc>) */
/* <spc> ::= <idf> ':=' <spc> => (STN #nam# <spc>) */
/* <spc> ::= <tab> ':=' <spc> => (STT #nam# <idx> <spc>) */
/* <spc> ::= <apl> ':=' <spc> => (STF #ref# <arg> <spc>) */
/*EXPRESSION */
/* <exp> ::= <cmp> */
/* <exp> ::= <cmp> #rop# <exp> => (RFF #rop# (TAB <cmp> <exp>)) */
/*COMPARAND */
/* <cmp> ::= <trm> */
/* <cmp> ::= <trm> #aop# <cmp> => (RFF #aop# (TAB <trm> <cmp>)) */
/*TERM */
/* <trm> ::= <fct> */
/* <trm> ::= <fct> #mop# <trm> => (RFF #mop# (TAB <fct> <trm>)) */
/*FACTOR */
/* <fct> ::= <ref> */
/* <fct> ::= '(' <spc> ')' */
/*REFERENCE */
/* <ref> ::= <opr> <ref> => (RFF <opr> (TAB <ref>)) */
/* <ref> ::= <apl> */
/* <ref> ::= <tab> */
/* <ref> ::= <idf> */
/* <ref> ::= <nbr> */
/* <ref> ::= <sym> */
/*OPERATOR */
/* <opr> ::= #rop# */
/* <opr> ::= #aop# */
/* <opr> ::= #mop# */
/*IDENTIFIER */
/* <idf> ::= #nam# => (RFN #nam#) */
/* <idf> ::= #opr# => (RFN #opr#) */
/*APPLICATION */
/* <apl> ::= <idf> '('
')'
=> (RFF #ref#) */
/* <apl> ::= <idf> '('
<arg> ')'
=> (RFF #ref# <arg>) */
/* <apl> ::= <idf> '@'
<nam>
=> (RFF #ref# <nam>) */
/*TABULATION */
/* <tab> ::= <idf> '[' <idx> ']' => (RFT #ref# <idx>) */
/*ARGUMENTS */
/* <arg> ::= <spc> => <spc> */
/* <arg> ::= <spc> ',' <arg> => (TAB <spc>*) */
/*INDEX */
/* <idx> ::= <spc> => <spc> */
/* */
/*----------------------------------------------------------------------------*/
_EXP_ _read_text_(const char *, const char *);
_EXP_ _read_file_(const FILE *);
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* Lab voor Programmeerkunde VUB */
/* ©1995 */
/*-----------------------------------*/
/*-----------------------------------*/
/* integer => <integer> */
/* float => <float> */
/* symbol => <string> */
/* name => <string> */
/* relop => <string> */
/* mulop => <string> */
/* addop => <string> */
/* left-parenthesis => <null> */
/* right-parenthesis => <null> */
/* left-bracket => <null> */
/* right-bracket => <null> */
/* colon => <null> */
/* assign => <null> */
/* comma => <null> */
/* commercial-at => <null> */
/* end-of-entry => <null> */
/* error => <string> */
/*-----------------------------------*/
/* types */
typedef enum _token_ { _NBR_TOKEN_ = 0,
_FRC_TOKEN_ = 1,
_STR_TOKEN_ = 2,
_NAM_TOKEN_ = 3,
_ROP_TOKEN_ = 4,
_AOP_TOKEN_ = 5,
_MOP_TOKEN_ = 6,
_XOP_TOKEN_ = 7,
_LPR_TOKEN_ = 8,
_RPR_TOKEN_ = 9,
_LBR_TOKEN_ = 10,
_RBR_TOKEN_ = 11,
_COL_TOKEN_ = 12,
_ASS_TOKEN_ = 13,
_COM_TOKEN_ = 14,
_CAT_TOKEN_ = 15,
_END_TOKEN_ = 16 } _TOKEN_;
void _scan_from_text_(const
char *, const
char *);
void _scan_from_file_(const FILE *);
_TOKEN_ _scan_();
#define _scan_error_(TEKST) _fatal_(#TEKST)
long _scan_integer_();
double _scan_float_();
char *_scan_string_();
void _scan_stop_();
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* Lab voor Programmeerkunde VUB */
/* ©1995 */
/*-----------------------------------*/
/* macro's */
#ifdef _DEBUG_
#define CHECK_CNT(CNT) (CNT < 0)\
? (_error_proc_(_STK_ERROR_, 0), 0) : CNT
#define CHECK_EXP(EXP) (EXP >= stack_size)\
? (_error_proc_(_STK_ERROR_, 0), 0) : EXP
#else
#define CHECK_CNT(CNT) CNT
#define CHECK_EXP(EXP) EXP
#endif
#define _stk_empty_CNT_() (CNT_tos < 0)
#define _stk_empty_EXP_() (EXP_tos == stack_size)
#define _stk_push_CNT_(CNT) if (CNT_tos+1 >= EXP_tos)\
_fatal_("_STK_ERROR_");\
CNT_stack[++CNT_tos] = CNT
#define _stk_push_EXP_(EXP) if (EXP_tos-1 <= CNT_tos)\
_fatal_("_STK_ERROR_");\
EXP_stack[--EXP_tos] = (_EXP_)EXP
#define _stk_pop_CNT_() CNT_stack[CHECK_CNT(CNT_tos)--]
#define _stk_pop_EXP_() EXP_stack[CHECK_EXP(EXP_tos)++]
#define _stk_zap_CNT_() CHECK_CNT(CNT_tos)--
#define _stk_zap_EXP_() CHECK_EXP(EXP_tos)++
#define _stk_poke_CNT_(CNT) CNT_stack[CHECK_CNT(CNT_tos)] = CNT
#define _stk_poke_EXP_(EXP) EXP_stack[CHECK_EXP(EXP_tos)] =(_EXP_)EXP
#define _stk_peek_CNT_() CNT_stack[CHECK_CNT(CNT_tos)]
#define _stk_peek_EXP_() EXP_stack[CHECK_EXP(EXP_tos)]
/* types */
typedef void (*_CNT_)();
/* variables */
extern _CNT_ *CNT_stack;
extern _EXP_ *EXP_stack;
extern long CNT_tos;
extern long EXP_tos;
extern long stack_size;
/* prototypes */
void _stk_clear_();
void _stk_allocate_(void *, unsigned);
void _warning_(char *s,...);
void _say_(char *s,...);
void _error_(char *s,...);
void _fatal_(char *s,...);
void _write_code_(char *s,...);
extern FILE *output_file;
void* zmalloc(long size);
Compiler
#include "nano.h"
_EXP_ _allocate_exp_(_TAG_ tag, int size)
{_EXP_ a=(_EXP_)zmalloc(size);
*a=tag;
return a;}
_STR_ _ag_make_STR_(char *Str)
{_STR_ a=(_STR_)_make_exp_(STR);
a->Str=Str;
return a;}
_RFF_ _ag_make_RFF_(void)
{_RFF_ a=_make_exp_(RFF);
a->HowToCall=UndefinedCall;
return a;}
_TAB_ _ag_make_TAB_(int SIZ)
{_TAB_ a=_make_exp_(TAB);
a->SIZ=SIZ;
if (!SIZ) a->EXP=NULL;
else a->EXP=(_EXP_*)zmalloc(sizeof(_EXP_)*SIZ);
return a;}
_NBR_ _ag_make_NBR_(Number NBR)
{_NBR_ a=_make_exp_(NBR);
a->NBR=NBR;
return a;}
_FRC_ _ag_make_FRC_(Fraction frc)
{_FRC_ a=_make_exp_(FRC);
a->Frc=frc;
return a;}
void _TAB_foreach_(_TAB_ tab,_EXP_ (*f)(_EXP_, void*) ,void* common)
{int siz;
int idx;
siz=_ag_get_TAB_SIZ_(tab);
for(idx=1;idx<=siz;idx++)
_ag_set_TAB_EXP_(tab,idx,f(_ag_get_TAB_EXP_(tab,idx),common));}
#include "nano.h"
static int counter=0;
void writevar(_VAR_ v)
{
if (!v) return;
if (v->index!=-1) _write_code_("((Object[])var%d)[%d]",v->varnr,v->index);
else _write_code_("var%d",v->varnr);
}
static void writearrayvar(_VAR_ v)
{
if (!v) return;
assert(v->index==-1);
if (v->declaredasarray) _write_code_("var%d",v->varnr);
else _write_code_("((Object[])var%d)",v->varnr);
}
static _VAR_ allocatevar(void)
{
_VAR_
v=(_VAR_)zmalloc(sizeof(struct VariableStruct));
v->varnr=++counter;
v->index=-1;
/* niet geindexeert
*/
v->declaredasarray=0;
return v;
}
_VAR_ _wci_var_(void)
{_VAR_ result;
result=allocatevar();
_write_code_("Object ");
writevar(result);
_write_code_(";\n");
return result;}
_VAR_ _wci_label_(void)
{_VAR_ result;
result=allocatevar();
writevar(result);
_write_code_(":\n");
return result;}
_VAR_ _wci_array_(void)
{_VAR_ result;
result=allocatevar();
result->declaredasarray=1;
_write_code_("Object ");
writevar(result);
_write_code_("[];");
return result;}
void _wc_lookup_var_(_VAR_ target, int back, int framenr)
{
assert(target);
writevar(target);
_write_code_("=LookUp(%d,%d);\n",back,framenr);
}
void _wc_load_parameter_(_VAR_ target, char* won)
{
assert(target);
writevar(target);
_write_code_("=%s;\n",won);
}
void _wc_set_var_(_VAR_ source, int back, int framenr)
{
assert(source);
_write_code_("Set(%d,%d,",back,framenr);
writevar(source);
_write_code_(");\n");
}
void _wc_define_var_(_VAR_ source, int framenr)
{
assert(source);
_write_code_("Contents[%d]=",framenr);
writevar(source);
_write_code_(";\n");
}
void _wc_index_array_(_VAR_
target, _VAR_
source,_VAR_ idx)
{
assert(target);
assert(source);
writevar(target);
_write_code_("=((Object[])");
writevar(source);
_write_code_(")[((Integer)");
writevar(idx);
_write_code_(").intValue()-1];\n",idx); /*herindexeren niet vergeten*/
}
void _wc_normalcall_(_VAR_ storein, _VAR_ funself,_VAR_ argsvar)
{
if (storein)
{writevar(storein);
_write_code_("=");}
assert(funself);
assert(argsvar);
_write_code_("((BasicFunction)");
writevar(funself);
_write_code_(").NormalCall(");
writevar(argsvar);
_write_code_(");\n");
}
void _wc_actioncall_(_VAR_ storein, _VAR_ funself,_VAR_ argsvar)
{
if (storein)
{writevar(storein);
_write_code_("=");}
assert(funself);
assert(argsvar);
_write_code_("((BasicFunction)");
writevar(funself);
_write_code_(").ActionCall(");
writearrayvar(argsvar);
_write_code_(");\n");
}
/*
void _wc_functioncall_(_VAR_ storein, _VAR_ funself,_VAR_ argsvar)
{
if (storein)
{writevar(storein);
_write_code_("=");}
assert(funself);
assert(argsvar);
_write_code_("((FunctionObject)");
writevar(funself);
_write_code_(").Call(");
writevar(argsvar);
_write_code_(");\n");
}
*/
void _wc_assign_(_VAR_ target, _VAR_ source)
{
assert(target && source);
writevar(target);
_write_code_("=");
writevar(source);
_write_code_(";\n");
}
void _wca_number_(_VAR_ target, long number)
{
assert(target);
writevar(target);
_write_code_("=new Integer(%d);\n",number);
}
void _wca_function_definition_(_VAR_ target, char* name)
{
assert(target);
writevar(target);
_write_code_("=new %s(this);\n",name);
}
void _wca_str_(_VAR_ target, char* str)
{
assert(target);
writevar(target);
assert(str);
_write_code_("=new String(\"%s\");\n",str);
}
void _wca_array_(_VAR_ target, int siz)
{
assert(target);
writevar(target);
_write_code_("=new Object[%d];\n",siz);
}
void _wca_table_(_VAR_ target,_VAR_ siz, _VAR_ contexp)
{
/*target=newtable(siz,contexp)*/
assert(target);
writevar(target);
_write_code_("=newtable(((Integer)");
writevar(siz);
_write_code_(").intValue(),");
writevar(contexp);
_write_code_(");\n");
}
void _wc_assign_index_array_(_VAR_ target,_VAR_ idx,_VAR_ source)
{
assert(target && idx && source);
_write_code_("((Object[])");
writevar(target);
_write_code_(")[((Integer)");
writevar(idx);
_write_code_(").intValue()-1]=");
writevar(source);
_write_code_(";\n");
}
void _wc_return_(_VAR_ who)
{
assert(who);
_write_code_("return ");
writevar(who);
_write_code_(";\n");
}
#include "nano.h"
Plist function_list=NULL;
extern _ENV_ current_env;
static void collect_FRC(const _EXP_);
static void collect_STR(const _EXP_);
static void collect_TAB(const _EXP_);
static void collect_FUN(const _EXP_);
static void collect_RFN(const _EXP_);
static void collect_DFN(const _EXP_);
static void collect_STN(const _EXP_);
static void collect_RFF(const _EXP_);
static void collect_DFF(const _EXP_);
static void collect_STF(const _EXP_);
static void collect_RFT(const _EXP_);
static void collect_DFT(const _EXP_);
static void collect_STT(const _EXP_);
static void collect_NBR(const _EXP_);
typedef void (*collect_proc)(const _EXP_);
static void CollectData(const _EXP_ exp);
/* evalueer expressie _EXP_ en steek het resultaat in result_name */
const static collect_proc collect_proc_tab[] =
{ collect_FRC, collect_STR, collect_TAB, collect_RFN,
collect_DFN, collect_STN, collect_RFF, collect_DFF,
collect_STF, collect_RFT, collect_DFT, collect_STT,
collect_NBR };
#define junk_it(name) static void collect_##name(const _EXP_ exp)\
{_fatal_("internal compiler error \"collect_"#name"\" undefined\n");}
/* een number evalueren */
static void collect_NBR(const _EXP_ exp)
{return;}
void* fire_CollectData(_EXP_ e,void *ignore)
{assert(e && !ignore);
CollectData(e);
return e;}
/* function call/function reference */
static void collect_RFF(const _EXP_ exp)
{_FRM_ frm;
_EXP_ arg;
frm=call_name(current_env,_ag_get_RFF_NAM_(exp));
_frm_add_called_(frm,exp);
assert(exp);
arg=_ag_get_RFF_ARG_(exp);
if (_ag_EXP_TAG_(arg)==_TAB_TAG_)
_TAB_foreach_(aAT(arg,TAB),fire_CollectData,NULL);
else
read_name(current_env,_ag_get_RFN_NAM_(aAT(arg,RFN)));
}
/* definition */
static void collect_DFN(const _EXP_ exp)
{_FRM_ frm;
CollectData(_ag_get_DFN_EXP_(exp));
frm=define_name(current_env,_ag_get_DFN_NAM_(exp));
_frm_add_definition_(frm,exp);}
/* variabele reference */
static void collect_RFN(const _EXP_ exp)
{read_name(current_env,_ag_get_RFN_NAM_(exp));}
static _EXP_
_add_argument_(_EXP_ arg,
void* prepos)
{
_FRM_ frm;
int
*pos=prepos;
_TAG_
t=_ag_EXP_TAG_(arg);
assert(pos);
switch (t)
{
case _RFN_TAG_:
/* het is een argumentnaam die voorkomt in 'parameters' */
frm=introduce_name(current_env,_ag_get_RFN_NAM_(arg));
_frm_mark_parameter_(frm);
_frm_set_framenr_(frm,((*pos)++));
break;
case _RFF_TAG_:
/* het is een formele functieparameter */
frm=introduce_name(current_env,_ag_get_RFF_NAM_(arg));
_frm_mark_parameter_(frm);
_frm_set_framenr_(frm,((*pos)++));
break;
default: _fatal_("invalid argument list (tag=%d)\n",t);
}
return arg;
}
static void _add_arguments_(_EXP_ arg)
{
_TAG_ t=_ag_EXP_TAG_(arg);
_FRM_ frm;
int pos=0;
switch (t)
{
case _TAB_TAG_:
/* het is een blok van parameters, elk met een eigen naam */
_TAB_foreach_(aAT(arg,TAB),_add_argument_,&pos);
break;
/* het is een parameterlijst aangeduid door 1 naam */
/* dit wil zeggen, stokeer de parameterlijst direct in de
* environment */
case _RFN_TAG_:
frm=introduce_name(current_env,_ag_get_RFN_NAM_(arg));
_frm_mark_parameterlst_(frm);
break;
default: _fatal_("invalid argument list2 (tag=%d)\n",t);
}
}
/* table reference */
static void collect_RFT(const _EXP_ exp)
{read_name(current_env,_ag_get_RFT_NAM_(exp));
CollectData(_ag_get_RFT_IDX_(exp));}
/* strings */
static void collect_STR(const _EXP_ exp)
{/* Een string colelcteren betekent NIETS */
assert(exp);
assert(_ag_get_STR_(exp));}
/* assignment */
static void collect_STN(const _EXP_ exp)
{CollectData(_ag_get_STN_EXP_(exp));
write_name(current_env,_ag_get_STN_NAM_(exp));}
/* table assignment */
static void collect_STT(const _EXP_ exp)
{/* de volgorde van onderstaanden klopt */
/* zie test30.pico */
CollectData(_ag_get_STT_EXP_(exp));
CollectData(_ag_get_STT_IDX_(exp));
write_name(current_env,_ag_get_STT_NAM_(exp));}
/* table definition */
static void collect_DFT(const _EXP_ exp)
{_FRM_ frm;
/* ook hier klopt de volgorde */
CollectData(_ag_get_DFT_IDX_(exp));
CollectData(_ag_get_DFT_EXP_(exp));
frm=define_name(current_env,_ag_get_DFT_NAM_(exp));
_frm_add_definition_(frm,exp);}
/* function definition */
static void collect_DFF(const _EXP_ exp)
{
_ENV_ old_env;
_FRM_ frm;
old_env=current_env;
current_env=_env_create_(current_env);
_ag_set_DFF_WON_(exp,MakeUniqueName(_ag_get_DFF_NAM_(exp)));
_add_arguments_(_ag_get_DFF_ARG_(exp));
frm=define_name(old_env,_ag_get_DFF_NAM_(exp));
_frm_add_definition_(frm,exp);
function_list=l_add(function_list,exp);
CollectData(_ag_get_DFF_EXP_(exp));
_ag_set_DFF_ENV_(exp,current_env);
current_env=old_env;
}
junk_it(FRC);
junk_it(TAB);
junk_it(STF);
static void CollectData(const _EXP_ exp)
{
_TAG_ tag = _ag_EXP_TAG_(exp);
collect_proc_tab[tag](exp);
}
void _Collect_Data_(const _EXP_ exp)
{
assert(function_list);
current_env=root_env;
CollectData(exp);
assert(root_env==current_env);
}
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* Lab voor Programmeerkunde VUB */
/*-----------------------------------*/
#include "nano.h"
static String *DCT_store;
static long dict_top = 0;
static long dict_size = 0;
String _dct_make_NAM_(const char *str)
{
long index;
String name;
for (index=0; index < dict_top; index++)
{name = DCT_store[index];
if (strcmp(str, name)==0) return name;}
if (dict_top == dict_size) _fatal_("dictionary full %s",str);
name = strdup(str);
DCT_store[dict_top++] = name;
return
name;
}
void _dct_allocate_(void *storage, unsigned size)
{
DCT_store = (String*)storage;
dict_top = 0;
dict_size = size / sizeof(_STR_);
}
#include "nano.h"
/***************************************************************************/
/** **/
/** F.R.A.M.E.S **/
/** **/
/***************************************************************************/
_FRM_ _frm_create_(String name, _ENV_ env)
{_FRM_ frm=(_FRM_)zmalloc(sizeof(struct _frm_));
assert(frm);
assert(name);
assert(env);
frm->name=name;
frm->flags.read=0;
frm->flags.written=0;
frm->flags.called=0;
frm->flags.defined=0;
frm->flags.parameter=0;
frm->flags.parameterlst=0;
frm->flags.native=0;
frm->framenr=0;
frm->env=env;
frm->DefineList=make_list();
frm->CallList=make_list();
return frm;}
_DFF_ _frm_get_native_definition_(_FRM_ frm)
{
void* v;
_DFF_ n;
assert(frm);
v=l_last(frm->DefineList); /* aangezien deze eerst gedefinieerd wordt */
n=aAT(v,DFF);
assert(!_ag_get_DFF_ENV_(n) && !_ag_get_DFF_EXP_(n));
return(n);
}
/***************************************************************************/
/** **/
/** E.N.V.I.R.O.N.M.E.N.T.S **/
/** **/
/***************************************************************************/
_ENV_ _env_create_(_ENV_ DefinedIn)
{_ENV_ e=(_ENV_)zmalloc(sizeof(struct _env_));
assert(e);
if (!(e->DefinedIn=DefinedIn)) root_env=e;
e->size=0;
e->FORlist=make_list();
e->frames=make_list();
return e;}
/***************************************************************************/
/**
**/
/**
globale bewerkingen
**/
/**
**/
/***************************************************************************/
_ENV_ root_env=NULL;
_FRM_ introduce_name(_ENV_ env, String name)
{_FRM_ frm;
assert(env);
assert(name);
frm=_frm_create_(name,env);
assert(frm);
_env_add_frame_(env,frm);
return frm;}
static void* lookup_frm_aux(void* frm, void* common)
{assert(frm);
assert(common);
if (((_FRM_)frm)->name==(String)common) return frm; else return NULL;}
_FRM_ lookup_frm_in_env(_ENV_ env,String name)
{assert(env);
assert(name);
return _env_firstthat_frm_(env,lookup_frm_aux,name);}
_FRM_ find_frm_in_env(_ENV_ env,String name)
{_FRM_ frm=lookup_frm_in_env(env,name);
if (!frm) return introduce_name(env,name); else return frm;}
struct LookupResult lookup_frm(_ENV_ env, String name)
{struct LookupResult lr;
assert(env);
lr.back=0;
while(env)
{if(lr.frm=lookup_frm_in_env(env,name)) return lr;
lr.back++;
env=env->DefinedIn;}
return lr;}
struct LookupResult next_frm(_FRM_ frm)
{_ENV_ parent;
struct LookupResult lr;
assert(frm);
parent=_env_definedin_(_frm_env_(frm));
if (!parent)
{lr.frm=NULL;
return lr;}
lr=lookup_frm(parent,_frm_name_(frm));
lr.back++;
return lr;}
_FRM_ call_name(_ENV_ env, String name)
{_FRM_ frm=find_frm_in_env(env,name);
assert(frm);
_frm_mark_called_(frm);
return frm;}
void read_name(_ENV_ env, String name)
{_FRM_ frm=find_frm_in_env(env,name);
assert(frm);
_frm_mark_read_(frm);}
void write_name(_ENV_ env, String name)
{_FRM_ frm=find_frm_in_env(env,name);
assert(frm);
_frm_mark_written_(frm);}
_FRM_ define_name(_ENV_ env,
String name)
{_FRM_ frm=find_frm_in_env(env,name);
assert(frm);
_frm_mark_defined_(frm);
return frm;}
void ShowFrame(_FRM_ frm)
{assert(frm);
#ifdef SHOWPOINTERS
_say_("%X ",frm);
#endif
_say_((frm->flags.read ? "read³" : " ³"));
_say_((frm->flags.parameter ? "para³": " ³"));
_say_((frm->flags.parameterlst ? "parl³": " ³"));
_say_((frm->flags.native ? "nati³": " ³"));
_say_((frm->flags.written ? "writ³": " ³"));
if (frm->flags.called) _say_("call(%3d)³",l_elcount(frm->CallList));
else _say_(" ³");
if (frm->flags.called) _say_("defd(%3d)³",l_elcount(frm->DefineList));
else _say_(" ³");
_say_("nr(%3d)³\t",frm->framenr);
#ifdef SHOWPOINTERS
_say_("'%s(%x)'",frm->name,frm->name);
#else
_say_("'%s'",frm->name);
#endif
_say_("\n");}
static void* ShowFrame_aux(void*frm, void*ignore)
{assert(frm);
ShowFrame((_FRM_)frm);
return frm;}
static void*ShowFormal(_EXP_ FOR,void*ignore)
{_say_("%s(%d) ",_ag_get_FOR_NAM_(FOR),_ag_get_FOR_framenr_(FOR));
return FOR;}
void ShowEnvironment(_ENV_ env)
{
assert(env);
if (l_elcount(env->FORlist))
{_say_(" [ ");
_env_foreach_formal_(env,ShowFormal,NULL);
_say_("]");}
_say_("\n");
_say_("ÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\n");
_env_foreach_frm_(env,ShowFrame_aux,NULL);
_say_("ÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\n");
printf("\n");
}
void ShowEnvironments(_ENV_ env)
{while(env)
{ShowEnvironment(env);
_say_("###########################################\n");
env=env->DefinedIn;}}
static void* FireShow(void* def, void* ignore)
{assert(def && !ignore);
_say_("environment %s",_ag_get_DFF_NAM_(((_EXP_)def)));
ShowEnvironment(_ag_get_DFF_ENV_(((_EXP_)def)));
return def;}
void ShowAllEnvironments(void)
{
_say_("ÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÂÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\n");
_say_("READ³PARA³PARL³NATI³WRIT³CALL(CNT)³DEFD(CNT)³NR(CNT)³\tNAME\n");
_say_("ÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÁÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\n\n");
l_foreach(function_list,FireShow,NULL);
_say_("root environment");
ShowEnvironment(root_env);}
static void* fire_env_func(void* def, void* f)
{_EXP_ d;
_ENV_ env;
assert(def && f);
d=(_EXP_)def;
env=_ag_get_DFF_ENV_(d);
((void (*)(_ENV_))f)(env);
return def;}
void foreach_env(void (*f)(_ENV_))
{l_foreach(function_list,fire_env_func,f);
f(root_env);}
#include "nano.h"
_ENV_ current_env=NULL;
#define ARGUMENTS const _EXP_ exp, _VAR_ storein
static void gencode_FRC(ARGUMENTS);
static void gencode_STR(ARGUMENTS);
static void gencode_TAB(ARGUMENTS);
static void gencode_RFN(ARGUMENTS);
static void gencode_DFN(ARGUMENTS);
static void gencode_STN(ARGUMENTS);
static void gencode_RFF(ARGUMENTS);
static void gencode_DFF(ARGUMENTS);
static void gencode_STF(ARGUMENTS);
static void gencode_RFT(ARGUMENTS);
static void gencode_DFT(ARGUMENTS);
static void gencode_STT(ARGUMENTS);
static void gencode_NBR(ARGUMENTS);
typedef void (*gencode_proc)(ARGUMENTS);
static void GenerateCode(ARGUMENTS);
/* evalueer expressie _EXP_ en steek het resultaat in result_var */
const static gencode_proc gencode_proc_tab[] =
{ gencode_FRC, gencode_STR, gencode_TAB, gencode_RFN,
gencode_DFN, gencode_STN, gencode_RFF, gencode_DFF,
gencode_STF, gencode_RFT, gencode_DFT, gencode_STT,
gencode_NBR };
#define junk_it(name) static void gencode_##name(ARGUMENTS)\
{_fatal_("internal compiler error : \"gencode_"#name"\" undefined\n");}
void _genaux_GET_(String name,_VAR_ storein)
/* haalt een variabele op uit de environments
* en stopt het resultaat in storein */
{struct LookupResult lr;
lr=lookup_frm(current_env,name);
if (!lr.frm)
_fatal_("Undefined variabele '%s'\n",name);
assert(lr.frm);
_wc_lookup_var_(storein,lr.back,lr.frm->framenr);}
void _genaux_DEF_(String name,_VAR_ value)
{_FRM_ frm;
frm=lookup_frm_in_env(current_env,name);
assert(frm);
_wc_define_var_(value,frm->framenr);}
void _genaux_SET_(String name,_VAR_ value)
{struct LookupResult lr=lookup_frm(current_env,name);
assert(lr.frm);
_wc_set_var_(value,lr.back,lr.frm->framenr);}
/* variabele reference */
static void gencode_RFN(ARGUMENTS)
{
if
(!storein)
{_warning_("Dereferencing variable who's value is never used"
":
%s)\n",_ag_get_RFN_NAM_(exp));
return;}
_genaux_GET_(_ag_get_RFN_NAM_(exp),storein);
}
/* define */
static void gencode_DFN(ARGUMENTS)
{
/* evalueer de expressie die toegekend wordt aan de variabele
* en stop het resultaat dan in de environment*/
_VAR_ var=(storein ? storein :_wci_var_());
GenerateCode(_ag_get_DFN_EXP_(exp),var);
_genaux_DEF_(_ag_get_DFN_NAM_(exp),var);
}
/* number */
static void gencode_NBR(ARGUMENTS)
{
/* geef code weer die het opgegeven nummertje alloceert */
if (!storein) _warning_("Er wordt mij gevraagd een nutteloos nummer te alloceren\n");
_wca_number_(storein,_ag_get_NBR_(exp));
}
/* function definition */
static void gencode_DFF(ARGUMENTS)
{
/* een functie definitie generereren bestaat enkel uit op de juiste
* plaats een nieuw functie-object wegschrijven */
_VAR_ var=(storein ? storein :_wci_var_());
_wca_function_definition_(var,_ag_get_DFF_WON_(exp));
_genaux_DEF_(_ag_get_DFF_NAM_(exp),var);
}
/* table reference */
static void gencode_RFT(ARGUMENTS)
{
/* evalueer de index-expressie */
_VAR_ var1,var2;
if (!storein) _warning_("nutteloze table_referentie\n");
var1=_wci_var_();
var2=_wci_var_();
GenerateCode(_ag_get_RFT_IDX_(exp),var1);
_genaux_GET_(_ag_get_RFT_NAM_(exp),var2);
_wc_index_array_(storein,var2,var1);
}
static void gencode_RFF_Normal(ARGUMENTS)
{
_VAR_ argsvar,funself;
_EXP_ args=_ag_get_RFF_ARG_(exp);
int siz=_ag_get_TAB_SIZ_(args);
int idx=1;
argsvar=_wci_array_();
_wca_array_(argsvar,siz);
for(idx=1;idx<=siz;idx++)
{
_FOR_ formal=aAT(_ag_get_TAB_EXP_(args,idx),FOR);
_wc_lookup_var_((argsvar->index=idx-1,argsvar),0,_ag_get_FOR_framenr_(formal));
}
/* zoek de variabele op en call hem */
funself=_wci_var_();
_genaux_GET_(_ag_get_RFF_NAM_(exp),funself);
argsvar->index=-1;
_wc_normalcall_(storein,funself,argsvar);
}
static void inlinecode_while(ARGUMENTS)
{
_EXP_ args=_ag_get_RFF_ARG_(exp);
if (_ag_RFF_VarParam_(exp)) assert(0);
else
{
_VAR_ pred;
_EXP_ arg;
assert(_ag_get_TAB_SIZ_(args)==2);
pred=_wci_var_();
arg=_ag_get_TAB_EXP_(args,1); /* predicaat */
GenerateCode(arg,pred);
_write_code_("while (((Boolean)");
writevar(pred);
_write_code_(")==Boolean.TRUE) {\n");
arg=_ag_get_TAB_EXP_(args,2); /* actie */
GenerateCode(arg,NULL);
arg=_ag_get_TAB_EXP_(args,1); /* predicaat */
GenerateCode(arg,pred);
_write_code_("};\n");
if (storein)
{writevar(storein);
_write_code_("=null;");}
}
}
static void inlinecode_until(ARGUMENTS)
{
_EXP_ args=_ag_get_RFF_ARG_(exp);
if (_ag_RFF_VarParam_(exp)) assert(0);
else
{
_VAR_ pred;
_EXP_ arg;
assert(_ag_get_TAB_SIZ_(args)==2);
pred=_wci_var_();
_write_code_("do {\n");
arg=_ag_get_TAB_EXP_(args,2); /* actie */
GenerateCode(arg,NULL);
arg=_ag_get_TAB_EXP_(args,1); /* predicaat */
GenerateCode(arg,pred);
_write_code_("} while (((Boolean)");
writevar(pred);
_write_code_(")==Boolean.FALSE);\n");
if (storein)
{writevar(storein);
_write_code_("=null;");}
}
}
static void
inlinecode_if(ARGUMENTS)
{
_EXP_ args=_ag_get_RFF_ARG_(exp);
if (_ag_RFF_VarParam_(exp)) assert(0);
else
{
_VAR_ pred;
_EXP_ arg;
assert(_ag_get_TAB_SIZ_(args)==3);
pred=_wci_var_();
arg=_ag_get_TAB_EXP_(args,1); /* code voor het predicaat */
GenerateCode(arg,pred);
_write_code_("if
(((Boolean)");
writevar(pred);
_write_code_(")==Boolean.TRUE)\n{");
arg=_ag_get_TAB_EXP_(args,2); /* code voor het true-geval */
GenerateCode(arg,storein);
_write_code_("} else
{\n");
arg=_ag_get_TAB_EXP_(args,3); /* code voor het false-geval */
GenerateCode(arg,storein);
_write_code_("};");
}
}
static void inlinecode_begin(ARGUMENTS)
{
_EXP_ args=_ag_get_RFF_ARG_(exp);
if (_ag_RFF_VarParam_(exp)) assert(0);
else
{_EXP_ arg;
int siz,idx;
siz=_ag_get_TAB_SIZ_(args);
idx=1;
for(idx=1;idx<siz;idx++)
{arg=_ag_get_TAB_EXP_(args,idx);
GenerateCode(arg,NULL);}
arg=_ag_get_TAB_EXP_(args,siz);
GenerateCode(arg,storein);}
}
static void gencode_RFF_Inline(ARGUMENTS)
{
String name=_ag_get_RFF_NAM_(exp);
if (name==native_if)
{inlinecode_if(exp,storein);
return;}
if (name==native_until)
{inlinecode_until(exp,storein);
return;}
if (name==native_begin)
{inlinecode_begin(exp,storein);
return;}
if (name==native_while)
{inlinecode_while(exp,storein);
return;}
assert(0);
}
static void
gencode_RFF_Action(ARGUMENTS)
{
_VAR_
argsvar,funself;
_EXP_
args=_ag_get_RFF_ARG_(exp);
int
siz,idx;
if
(_ag_RFF_VarParam_(exp))
{
_RFN_ arg=aAT(_ag_get_RFF_ARG_(exp),RFN);
argsvar=_wci_var_();
_genaux_GET_(_ag_get_RFN_NAM_(arg),argsvar);
}
else
{
siz=_ag_get_TAB_SIZ_(args);
idx=1;
argsvar=_wci_array_();
_wca_array_(argsvar,siz);
for(idx=1;idx<=siz;idx++)
{
_EXP_ arg;
arg=_ag_get_TAB_EXP_(args,idx);
if (_ag_EXP_TAG_(arg)==_FOR_TAG_)
_wc_lookup_var_((argsvar->index=idx-1,argsvar),0,_ag_get_FOR_framenr_(arg));
else GenerateCode(arg,(argsvar->index=idx-1,argsvar));
}
}
/* zoek de variabele op en call hem */
funself=_wci_var_();
_genaux_GET_(_ag_get_RFF_NAM_(exp),funself);
argsvar->index=-1;
_wc_actioncall_(storein,funself,argsvar);
}
/* function reference/function call */
static void gencode_RFF(ARGUMENTS)
{CallType HowToCall=_ag_get_RFF_HowToCall_(exp);
switch(HowToCall)
{case NormalCall: gencode_RFF_Normal(exp,storein); break;
case ActionCall: gencode_RFF_Action(exp,storein); break;
case InlineCall: gencode_RFF_Inline(exp,storein); break;
default :
if (_ag_RFF_VarParam_(exp)) _say_("VARVARVARVAR\n");
assert(0);
}
}
/* een string */
static void gencode_STR(ARGUMENTS)
{if (!storein) _warning_("Er wordt mij gevraagd een doelloze string te genereren\n");
_wca_str_(storein,_ag_get_STR_(exp));}
/* assignment */
static void gencode_STN(ARGUMENTS)
{_VAR_ var;
var=_wci_var_();
GenerateCode(_ag_get_STN_EXP_(exp),var);
_genaux_SET_(_ag_get_STN_NAM_(exp),var);
if (storein) _wc_assign_(storein,var);
}
/* table assignment */
static void gencode_STT(ARGUMENTS)
{
_VAR_ source;
_VAR_ target;
_VAR_ idx;
source=_wci_var_();
GenerateCode(_ag_get_STT_EXP_(exp),source);
idx=_wci_var_();
GenerateCode(_ag_get_STT_IDX_(exp),idx);
target=_wci_var_();
_genaux_GET_(_ag_get_STT_NAM_(exp),target);
_wc_assign_index_array_(target,idx,source);
if (storein)
_wc_assign_(storein,target);
}
/* table definition */
static void gencode_DFT(ARGUMENTS)
{_VAR_ idxvar;
_VAR_ expvar;
_VAR_ tblvar;
idxvar=_wci_var_();
GenerateCode(_ag_get_DFT_IDX_(exp),idxvar);
expvar=_wci_var_();
GenerateCode(_ag_get_DFT_EXP_(exp),expvar);
tblvar=_wci_var_();
_wca_table_(tblvar,idxvar,expvar);
_genaux_DEF_(_ag_get_DFT_NAM_(exp),tblvar);
if (storein) _wc_assign_(storein,tblvar);
}
junk_it(FRC);
junk_it(TAB);
junk_it(STF);
void *generate_FORclassdeclr(void* item, void* ignore)
{
_EXP_ FOR=(_EXP_)item;
_VAR_ resvar;
aAT(FOR,FOR);
_write_code_("final
class %s extends FormalParam\n{"
,_ag_get_FOR_NAM_(FOR));
_write_code_("public %s() {}\n",_ag_get_FOR_NAM_(FOR));
_write_code_("public %s(FunctionObject parent)\n",_ag_get_FOR_NAM_(FOR));
_write_code_("{super(parent);}\n");
_write_code_("public Object Action()\n");
_write_code_("{");
resvar=_wci_var_();
GenerateCode(_ag_get_FOR_EXP_(FOR),resvar);
_wc_return_(resvar);
_write_code_("}}\n\n");
return item;
}
void *generate_FORinit(void* item, void* ignore)
{
_VAR_ v;
_EXP_ FOR=(_EXP_)item;
aAT(FOR,FOR);
v=_wci_var_();
_wca_function_definition_(v,_ag_get_FOR_NAM_(FOR));
_wc_define_var_(v,_ag_get_FOR_framenr_(FOR));
return item;
}
static void GenerateCode(ARGUMENTS)
{_TAG_ tag = _ag_EXP_TAG_(exp);
gencode_proc_tab[tag](exp,storein);}
static void*
InitializeEnvironmentEntry(_FRM_ frm,void* ignore)
{struct LookupResult lr;
assert(frm);
if (_frm_native_(frm))
{_DFF_
nd=_frm_get_native_definition_(frm);
assert(nd->WON);
_write_code_("Contents[%d]=%s;\n",frm->framenr,nd->WON);
return frm;}
/* OK, het is geen native function, dus moet ik een doorverwijzing naar
* de volgende genereren */
lr=next_frm(frm);
if (!lr.frm) _write_code_("Contents[%d]=NotDefined;\n",frm->framenr);
else _write_code_("Contents[%d]=new DoorVerwijzing(%d,%d);\n",
frm->framenr,lr.back,lr.frm->framenr);
return frm;}
static void InitializeEnvironment(void)
{_env_foreach_frm_(current_env,InitializeEnvironmentEntry,NULL);}
static void InitializeParameterTemplate(_EXP_ tab)
{int siz;
int idx;
_EXP_ arg;
siz=_ag_get_TAB_SIZ_(tab);
if (siz==0) return;
_write_code_("boolean pt[]={");
for(idx=1;idx<siz;idx++)
{arg=_ag_get_TAB_EXP_(tab,idx);
if (_ag_EXP_TAG_(arg)==_RFN_TAG_) _write_code_("true,");
else _write_code_("false,");}
arg=_ag_get_TAB_EXP_(tab,siz);
if (_ag_EXP_TAG_(arg)==_RFN_TAG_) _write_code_("true};\n");
else _write_code_("false};\n");
_write_code_("ParameterTemplate=pt;\n");}
void* generate_fo(void* wie,void*com)
{
_EXP_ exp=(_EXP_)wie;
_VAR_ var;
assert(wie);
aAT(exp,DFF);
_say_(" writing code for %s\n",_ag_get_DFF_NAM_(exp));
current_env=_ag_get_DFF_ENV_(exp);
l_foreach(current_env->FORlist,generate_FORclassdeclr,NULL);
_write_code_("final class %s extends ",_ag_get_DFF_WON_(exp));
if (_ag_DFF_VarParam_(exp)) _write_code_("FunctionVarParam {\n");
else _write_code_("FunctionVastParam {\n");
_write_code_("public %s(FunctionObject parentenvironment)\n"
"{super(%d,parentenvironment);\n",
_ag_get_DFF_WON_(exp),
current_env->size);
if (!_ag_DFF_VarParam_(exp))
InitializeParameterTemplate(_ag_get_DFF_ARG_(exp));
InitializeEnvironment();
_write_code_("}\npublic void SetupFormals()\n{");
l_foreach(current_env->FORlist,generate_FORinit,NULL);
_write_code_("}\npublic final Object Action()\n{");
var=_wci_var_();
GenerateCode(_ag_get_DFF_EXP_(exp),var);
_wc_return_(var);
_write_code_("}}\n\n");
return wie; /* 'wie' mag gerust blijven */
}
void _Generate_Code_(const
_EXP_ exp, const
char* uitvoerclasse)
{
/* een
headerken toevoegen */
_write_code_("import
java.*;\n");
_write_code_("import
PicoRuntime.*;\n");
assert(function_list);
l_foreach(function_list,generate_fo,NULL);
_say_(" writing Main block (in
%s)\n",uitvoerclasse);
current_env=root_env;
l_foreach(root_env->FORlist,generate_FORclassdeclr,NULL);
_write_code_("final class MainAction extends FunctionVarParam\n");
_write_code_("{public MainAction()\n");
_write_code_("{super(%d,null);\n",current_env->size);
InitializeEnvironment();
_write_code_("}\npublic void SetupFormals()\n{");
l_foreach(root_env->FORlist,generate_FORinit,NULL);
_write_code_("}\npublic Object Action()\n{");
GenerateCode(exp,NULL);
_write_code_("return null;}}\n");
_write_code_("\n\nfinal class %s\n{",uitvoerclasse);
_write_code_("public final static void main(String argv[])\n");
_write_code_("{MainAction m=new MainAction();\n");
_write_code_("m.SetupFormals();\n");
_write_code_("m.Action();\nSystem.out.println("");}}\n");
}
#include "nano.h"
Pcell make_cell(void* contents, Pcell next)
{
Pcell result=(Pcell)zmalloc(sizeof(struct cell));
result->contents=contents;
result->next=next;
return result;
}
Plist make_list(void)
{
Plist list=(Plist)make_cell((void*)0,NULL);
return list;
}
Plist l_add(Plist l,void* w)
{
Pcell old=l->next;
assert(l);
assert(w);
if (l->next=make_cell(w,old))
{((char*)l->contents)++;
return l;}
l->next=old;
return 0;
}
void* l_firstthat(Plist l,
void*
(*func)(void*item,void*com),void*com)
/*gaat de lijst af van voor naar achter en stopt zodra func 1 weergeeft.
het resultaat van l_firstthat is 1 indien gestopt is en 0 anders.*/
{
void*
rotor;
assert(l);
l=l->next;
while(l)
{
rotor=func(l->contents,com);
if (rotor) return rotor;
l=l->next;
}
return
NULL;
}
Plist l_foreach(Plist l, void* (*func)(void*item,void*com),void*com)
{Pcell prev=l, cur;
assert(l);
cur=prev->next;
while (cur)
{if (!(cur->contents=func(cur->contents,com)))
{prev->next=cur->next;
free(cur);}
else prev=cur;
cur=prev->next;}
return l;}
void delete_list(Plist l)
{
Pcell cur;
assert(l);
while(cur=l)
/*deze regel klopt !*/
{
l=cur->next;
free(cur);
}
}
void* l_first(Plist l)
{
Pcell first;
assert(l);
first=l->next;
assert(first);
assert(first->contents);
return first->contents;
}
void* l_last(Plist l)
{
Pcell first;
assert(l);
first=l->next;
assert(first);
while(first->next) first=first->next;
return first->contents;
}
void l_delete_first(Plist l)
{
Pcell second;
Pcell first;
assert(l);
first=l->next;
assert(first);
second=first->next;
free(first);
l->next=second;
}
int l_elcount(Plist l)
{assert(l);
return((int)(l->contents));}
#include "nano.h"
/* deze definieert de compile-time */
extern long Timer;
#define GetTime() (Timer)
#define IncTime() (Timer++)
long Timer=0L;
char charmaptable[128]=
{
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0 - 15 */
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 16 - 31 */
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 32 - 47 */
0,'0','1','2','3','4','5','6','7','8','9',0,0,0,0,0, /* 48 - 63 */
0,'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z',0,0,0,0,'u', /* 64 - 95 */
0,'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z',0,0,0,0,0
};
char*MakeCompilerName()
{
char r[80],*w;
sprintf(r,"name%d",GetTime());
IncTime();
w=strdup(r);
assert(w);
return w;
}
char*MakeUniqueName(char* n)
{
int i=0,j=0;
unsigned char c,v;
char newstr[256];
char nrstr[20];
newstr[0]='_';
j=1;
while (1)
{
c=n[i];
if (c>127) _fatal_("unkown character #%d\n",c);
if (c==0)
{
newstr[j]=0;
sprintf(nrstr,"%d",GetTime());
IncTime();
return _dct_make_NAM_(strdup(strcat(newstr,nrstr)));
}
if ((v=charmaptable[c])!=c)
{
if (!v) _fatal_("Unkown char %d=%c\n",c,c);
assert(v);
newstr[j]='_';
newstr[j+1]=v;
j++;
}
else newstr[j]=c;
i++;
j++;
}
}
#include "nano.h"
FILE *output_file=NULL;
void _nano_init_(void)
{
#define STACK_size 10240
#define DICT_size 65536
char *dict,*stack=zmalloc(STACK_size);
_stk_allocate_(stack, STACK_size);
dict = zmalloc(DICT_size);
_dct_allocate_(dict, DICT_size);
}
void _nano_do_file_(const char *name, const char *uitvoerclasse)
{
/* files openen */
FILE *file = fopen(name, "r");
_EXP_ exp;
if (!file) _fatal_("can't open file '%s'",name);
{char uitvoerfilename[80];
sprintf(uitvoerfilename,"%70s.java",uitvoerclasse);
output_file=fopen(uitvoerfilename,"wb");
if (!output_file) _fatal_("Can't open output-file %s\n",uitvoerfilename);}
/* parse'm */
_say_("Parsing file\n");
exp = _read_file_(file);
fclose(file);
/* installeer natives */
root_env=_env_create_(NULL);
function_list=make_list();
_say_("Installing natives\n");
_install_natives_();
/* verzamel allerhande interresante data */
_say_("Collecting data\n");
function_list=make_list();
_Collect_Data_(exp);
/* optimizeer */
CloseEnvironments();
_say_("Removing redundant functional actual parameters\n");
RemoveRedundantFORs();
NumberFrames();
/* genereer code */
_say_("Generating code\n");
_Generate_Code_(exp,uitvoerclasse);
/* en rot op */
fclose(output_file);
printf("done.\n");
}
static void SyntaxError(void)
{
_say_("\nNANO invoerfile [uitvoerclasse]\n\n"
" invoerfile : naam van de invoerfile, met extentie.\n"
" uitvoerclasse : naam van de uitgevoerde javaclasse, ZONDER extentie\n\n"
" bv: nano picosource.pic GoAndCrash\n\n");
}
void main(int argc, char*
argv[])
{
printf("NANO (pico->java) v1.2 made by Werner Van Belle 1995\n");
_nano_init_();
switch (argc)
{
case 2 : _nano_do_file_(argv[1],"RunMe");
ShowAllEnvironments();
break;
case 3 : _nano_do_file_(argv[1],argv[2]);
ShowAllEnvironments();
break;
default: SyntaxError();
}
}
#include "nano.h"
char *native_begin=NULL;
char *native_if=NULL;
char *native_until=NULL;
char *native_while=NULL;
static void NewKeyNative(String agname, String woname)
{
_FRM_ frm;
_DFF_ nd=_ag_make_DFF_();
_ag_set_DFF_WON_(nd,woname);
_ag_set_DFF_NAM_(nd,agname);
_ag_set_DFF_ENV_(nd,NULL);
_ag_set_DFF_EXP_(nd,NULL);
_ag_set_DFF_ARG_(nd,NULL);
frm=introduce_name(root_env,agname);
_frm_mark_native_(frm);
_frm_add_native_definition_(frm,nd);
}
static void NewNative(String agname, String woname, int argcount, ...)
/* in de meegegeven lijst staan 1tjes of 0-ekes.
* Een 1tje duidt aan dat de functie een formele parameter verwacht */
{
va_list args;
_FRM_ frm;
_DFF_ nd=_ag_make_DFF_();
agname=_dct_make_NAM_(agname);
_ag_set_DFF_WON_(nd,woname);
_ag_set_DFF_NAM_(nd,agname);
_ag_set_DFF_ENV_(nd,NULL);
_ag_set_DFF_EXP_(nd,NULL);
frm=introduce_name(root_env,agname);
assert(frm);
_frm_mark_native_(frm);
va_start(args,argcount);
if (argcount==-1)
{
_RFN_ rfn=_ag_make_RFN_();
_ag_set_RFN_NAM_(rfn,NULL);
_ag_set_DFF_ARG_(nd,(_EXP_)rfn);
}
else
{
_TAB_
tab=_ag_make_TAB_(argcount);
int
i,v;
for(i=1;i<=argcount;i++)
{
v=va_arg(args,int);
if (v)
{
_RFF_ rff=_ag_make_RFF_();
_ag_set_TAB_EXP_(tab,i,(_EXP_)rff);
}
else
{
_RFN_ rfn=_ag_make_RFN_();
_ag_set_RFN_NAM_(rfn,NULL);
_ag_set_TAB_EXP_(tab,i,(_EXP_)rfn);
}
}
_ag_set_DFF_ARG_(nd,(_EXP_)tab);
}
_frm_add_native_definition_(frm,nd);
va_end(args);
}
static void PutNative(String agname, String woname, signed char argcount, char parameters[80])
{
_FRM_ frm;
_DFF_ nd=_ag_make_DFF_();
agname=_dct_make_NAM_(agname);
_ag_set_DFF_WON_(nd,woname);
_ag_set_DFF_NAM_(nd,agname);
_ag_set_DFF_ENV_(nd,NULL);
_ag_set_DFF_EXP_(nd,NULL);
frm=introduce_name(root_env,agname);
assert(frm);
_frm_mark_native_(frm);
if (argcount==-1)
{_RFN_ rfn=_ag_make_RFN_();
_ag_set_RFN_NAM_(rfn,NULL);
_ag_set_DFF_ARG_(nd,(_EXP_)rfn);}
else
{_TAB_ tab=_ag_make_TAB_(argcount);
int i,v;
for(i=1;i<=argcount;i++)
{v=parameters[i-1];
if (v)
{_RFF_ rff=_ag_make_RFF_();
_ag_set_TAB_EXP_(tab,i,(_EXP_)rff);}
else
{_RFN_ rfn=_ag_make_RFN_();
_ag_set_RFN_NAM_(rfn,NULL);
_ag_set_TAB_EXP_(tab,i,(_EXP_)rfn);}}
_ag_set_DFF_ARG_(nd,(_EXP_)tab);}
_frm_add_native_definition_(frm,nd);
}
static int RemoveSpace(FILE *f)
{
int c;
assert(f);
while ((c=fgetc(f))!=EOF && (c==' ' || c=='\t' || c==10 || c==13));
return c;
}
static int ReadNumber(FILE* f,
char* nr)
{
int result=0;
int c;
assert(nr);
/* verwijder spaties */
c=RemoveSpace(f);
if (c==EOF) return 0;
if (c=='-')
{
int result;
result=ReadNumber(f,nr);
*nr=-*nr;
return result;
}
while (c>='0' && c<='9')
{
result=result*10+c-'0';
c=fgetc(f);
}
if (result>79) _fatal_("Parametercount in natives.dat moet <80");
*nr=result;
return 1;
}
static int ReadName(FILE* f, char* name)
{
int c;
assert(f && name);
c=RemoveSpace(f);
if (c!='`') return 0;
if (c==EOF) return 0;
while ((c=fgetc(f))!=EOF && c!=39)
{*name=c;
name++;}
*name=0;
if (c==EOF) return 0;
return 1;
}
static void ReadNatives(char* nativesfile)
{
FILE* f;
char n[80],w[80],parameters[80];
f=fopen(nativesfile,"rb");
if (!f)
{_warning_("Couldn't open 'natives.dat' file");
return;}
while(1)
{if (ReadName(f,n))
{if (ReadName(f,w))
{signed char cnt;
if (ReadNumber(f,&cnt))
{assert(cnt<=80 && cnt>=-1);
if (cnt==-1) PutNative(n,strdup(w),-1,parameters);
else
{int i;
for(i=0;i<cnt;i++)
{if (!ReadNumber(f,¶meters[i]))
_fatal_("Corrupted natives.dat file");
_say_("%d",parameters[i]);}
PutNative(n,strdup(w),cnt,parameters);}}
else _fatal_("parameter count missing in natives.dat\n");}
else _fatal_("write out name missing in natives.dat (pico-name = %s)",n);}
else break;}
fclose(f);
}
void _install_natives_(void)
{
NewKeyNative(native_begin=_dct_make_NAM_("begin"),"new
nat_begin()");
NewKeyNative(native_if=_dct_make_NAM_("if"),"new
nat_if()");
NewKeyNative(native_until=_dct_make_NAM_("until"),"new
nat_until()");
NewKeyNative(native_while=_dct_make_NAM_("while"),"new nat_while()");
ReadNatives("natives.dat");
/*
NewNative("//","new nat_div()",-1);
NewNative("\\\\","new nat_mod()",-1);
NewNative("display","new nat_display()",-1);
NewNative("+","new nat_add()",-1);
NewNative("*","new nat_times()",-1);
NewNative("-","new nat_sub()",-1);
NewNative(">","new nat_more()",-1);
NewNative("<","new nat_less()",-1);
NewNative("not","new nat_not()",-1);
NewNative("size","new nat_size()",-1);
NewNative("=","new nat_eq()",-1);
NewNative("false","Boolean.FALSE",-1);
NewNative("true","Boolean.TRUE",-1);
*/
}
#include "nano.h"
/*******************************/
/* CloseEnvironments */
/*******************************/
#define NextFrm(frm) (next_frm(frm).frm)
static void* lower_env_aux_bis(void* preexp, void*prefunc)
{_EXP_ exp;
void (*f)(_ENV_)=prefunc;
assert(preexp && prefunc);
exp=(_EXP_)preexp;
if (_ag_EXP_TAG_(exp)==_DFF_TAG_)
{
_ENV_ env;
env=_ag_get_DFF_ENV_(exp);
if (env) f(env); /* anders is het een native function */
}
return preexp;}
static void* for_lower_env_aux(void *prefrm, void* prefunc)
{assert(prefrm && prefunc);
_frm_foreach_definition_((_FRM_)prefrm,lower_env_aux_bis,prefunc);
return prefrm;}
static void _env_for_lower_envs_(_ENV_ env, void (*f)(_ENV_ env))
{assert(env);
_env_foreach_frm_(env,for_lower_env_aux,f);}
static void* BubbleFrmUp(void* frmpre, void* common)
{_FRM_ higher;
_FRM_ frm=(_FRM_)frmpre;
higher=NextFrm(frm);
if (!higher) return frmpre;
if (_frm_read_(frm)) _frm_mark_read_(higher);
if (_frm_written_(frm)) _frm_mark_written_(higher);
if (_frm_called_(frm)) _frm_mark_called_(higher);
return frmpre;}
static CloseEnvironment(_ENV_
env)
/* hier kan ik niet de function_list gebruiken omdat de volgorde waarin
ik het
* boeltje omhoog bubbel van cruciaal
belang is */
{
assert(env);
_env_for_lower_envs_(env,CloseEnvironment);
_env_foreach_frm_(env,BubbleFrmUp,NULL);
/* ShowEnvironment(env);
_say_("######################################\n");
*/
}
void CloseEnvironments()
{assert(root_env);
CloseEnvironment(root_env);}
/*******************************/
/* RemoveRedundantFORs */
/*******************************/
extern _ENV_ current_env;
/*
static _FRM_ lookup_functiondefinition(_ENV_ env, String name)
{struct LookupResult lr;
assert(name);
if (!env) return NULL;
lr=lookup_frm(env,name);
if (!lr.frm) return NULL;
if (l_elcount(lr.frm->DefineList)!=0) return (lr.frm);
assert(lr.frm->env);
return lookup_functiondefinition(lr.frm->env->DefinedIn,name);}
static _EXP_ FindOnlyOneFunctionDefinition(_ENV_ env, String name)
{_FRM_ frm;
assert(name && env);
frm=lookup_functiondefinition(env,name);
if (!frm) return NULL;
if (l_elcount(frm->DefineList)!=1) return NULL;
if (lookup_functiondefinition(frm->env->DefinedIn,name)) return NULL;
return l_first(frm->DefineList);}
*/
static _EXP_ FindOnlyOneFunctionDef_aux(_ENV_ env, String name, _EXP_ current_result)
{
struct LookupResult lr;
_FRM_ frm;
_EXP_ new_current;
if (!env) return current_result;
assert(name);
lr=lookup_frm(env,name);
frm=lr.frm;
if (!frm) return current_result;
if (l_elcount(frm->DefineList)>1) return NULL;
if (l_elcount(frm->DefineList)==0) return FindOnlyOneFunctionDef_aux(frm->env->DefinedIn,name,current_result);
new_current=l_first(frm->DefineList);
assert(new_current);
if (_ag_EXP_TAG_(new_current)!=_DFF_TAG_) return NULL;
if (current_result) return NULL;
return FindOnlyOneFunctionDef_aux(frm->env->DefinedIn,name,new_current);
}
static _EXP_ FindOnlyOneFunctionDefinition(_ENV_ env, String name)
{
assert(name && env);
return FindOnlyOneFunctionDef_aux(env,name,NULL);
}
static _EXP_
GenerateFormalArgument(_EXP_
e)
{
_FOR_
formal;
String name;
formal=(_FOR_)_ag_make_FOR_();
assert(formal
&& e);
name=MakeCompilerName();
_ag_set_FOR_NAM_(formal,name);
_ag_set_FOR_EXP_(formal,e);
_env_add_formal_(current_env,formal);
return (_EXP_)formal;
}
static void *CallFOROptimize(void* precall, void* prefuncdef)
{
String callname;
_RFF_ call;
_EXP_ callargs;
_DFF_ funcdef;
_EXP_ funcdefargs;
int siz, idx;
assert(precall && prefuncdef);
funcdef=aAT(prefuncdef,DFF);
call=aAT(precall,RFF);
callname=_ag_get_RFF_NAM_(call);
callargs=_ag_get_RFF_ARG_(call);
funcdefargs=_ag_get_DFF_ARG_(funcdef);
/* als het een keywordlike native function is wordt de functie inline
* gegenereerd */
if (callname==native_begin || callname==native_if || callname==native_until
|| callname==native_while)
{_ag_set_RFF_HowToCall_(call,InlineCall);
return precall;}
/* calls met een variabel aantal parameters zullen nooit formele
* parameters kunnen doorgeven. Functies die een variabel aantal moeten
* ontvangen zullen nooit formele parameters kunnen ontvangen...
*/
_ag_set_RFF_HowToCall_(call,ActionCall);
if (_ag_RFF_VarParam_(call)) return precall;
if (_ag_DFF_VarParam_(funcdef)) return precall;
/* ok, de call kan waarschijnlijk wel geoptimizeerd worden */
siz=_ag_get_TAB_SIZ_(callargs);
if (_ag_get_TAB_SIZ_(_ag_get_DFF_ARG_(funcdef))!=siz)
{_error_("Wrong parametercount\n");
return precall;}
for(idx=1;idx<=siz;idx++)
{
_EXP_ arg,param;
arg=_ag_get_TAB_EXP_(callargs,idx);
param=_ag_get_TAB_EXP_(funcdefargs,idx);
if (_ag_EXP_TAG_(param)==_RFF_TAG_)
{arg=GenerateFormalArgument(arg);
_ag_set_TAB_EXP_(callargs,idx,arg);}
}
return precall;
}
static void *FormalizeArgs(void* precall, void* ignore)
{_EXP_ call;
_EXP_ callargs;
int siz, idx;
assert(precall);
call=(_EXP_)precall;
callargs=_ag_get_RFF_ARG_(call);
_ag_set_RFF_HowToCall_(call,NormalCall);
if (_ag_RFF_VarParam_(call)) return precall;
siz=_ag_get_TAB_SIZ_(callargs);
for(idx=1;idx<=siz;idx++)
{_EXP_ arg;
arg=_ag_get_TAB_EXP_(callargs,idx);
_ag_set_TAB_EXP_(callargs,idx,GenerateFormalArgument(arg));}
return precall;}
static void FullyFormalize(_FRM_ frm)
{
assert(frm);
_frm_foreach_call_(frm,FormalizeArgs,NULL);
}
static void *FrmTryFOROptimize(void* prefrm, void* ignore)
{
_EXP_ funcdef;
_FRM_ frm=(_FRM_)prefrm;
assert(frm && !ignore && current_env);
/* 1. als de frame niet gecalled wordt mag ik zeker stoppen */
if (!_frm_called_(frm)) return prefrm;
/* 2. dan mag hij zeker al niet 'gebruikt' worden en moet ik de waarde
* kunnen achterhalen (kan niet bij parameters) */
if (_frm_read_(frm) || _frm_written_(frm) ||
_frm_parameter_(frm) || _frm_parameterlst_(frm))
{FullyFormalize(frm);
return prefrm;}
/* 3. nu moet ik 1 (en exact 1) functiedefinitie vinden (deze mag
* native zijn) anders moet ik nog steeds fullyformalizen */
funcdef=FindOnlyOneFunctionDefinition(current_env,frm->name);
if (!funcdef)
{FullyFormalize(frm);
return prefrm;}
/* 4. OK, ik denk dat ik nu een ActionCall mag aanroepen */
_frm_foreach_call_(frm,CallFOROptimize,funcdef);
return prefrm;
}
static void*RemoveRedundantFORsinFunctionDef(void* def, void* ignore)
{assert(def && !ignore);
current_env=_ag_get_DFF_ENV_(((_EXP_)def));
_env_foreach_frm_(current_env,FrmTryFOROptimize,NULL);
return def;}
void RemoveRedundantFORs()
{assert(function_list);
l_foreach(function_list,RemoveRedundantFORsinFunctionDef,NULL);
current_env=root_env;
_env_foreach_frm_(root_env,FrmTryFOROptimize,NULL);
}
/*******************************/
/* RemoveRedundantFORs */
/*******************************/
static void* RemoveActionFrame(void* prefrm,void* common)
{_FRM_ frm;
int *max=(int*)common;
assert(prefrm && common);
frm=(_FRM_)prefrm;
/* onderstaand checked of ik een native functie ben die nooit gebruikt
* wordt */
if (_frm_native_(frm) &&
!_frm_read_(frm) &&
!_frm_written_(frm) &&
!_frm_parameter_(frm) &&
!_frm_parameterlst_(frm) &&
!_frm_called_(frm)) return NULL;
if (_frm_parameter_(frm)
|| _frm_parameterlst_(frm)
|| _frm_native_(frm)
|| _frm_defined_(frm))
{if (_frm_framenr_(frm)>*max) *max=_frm_framenr_(frm);
return prefrm;}
return NULL;}
static void* NumberLocals(void*
prefrm,void* common)
{_FRM_ frm;
int *max=(int*)common;
assert(prefrm && common);
frm=(_FRM_)prefrm;
if (_frm_defined_(frm) || _frm_native_(frm)) _frm_set_framenr_(frm,++(*max));
return prefrm;}
static void* NumberFormals(void* preFormal, void * premax)
{int *max;
_EXP_ formal;
assert(preFormal && premax);
max=(int*)premax;
formal=(_EXP_)preFormal;
_ag_set_FOR_framenr_(formal,(++(*max)));
return preFormal;}
static void NumberFrames_in_env(_ENV_ env)
{int MaxPos=0;
assert(env);
_env_foreach_frm_(env,RemoveActionFrame,&MaxPos);
_env_foreach_frm_(env,NumberLocals,&MaxPos);
_env_foreach_formal_(env,NumberFormals,&MaxPos);
_env_set_size_(env,MaxPos+1);}
void NumberFrames(void)
{foreach_env(NumberFrames_in_env);}
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* Lab voor Programmeerkunde VUB */
/* ©1995 */
/*-----------------------------------*/
/*----------------------------------------------------------------------------*/
/* SPECIFICATION */
/* <spc> ::= <exp> */
/* <spc> ::= <exp> ':' <spc> */
/* <spc> ::= <exp> ':=' <spc> */
/* */
/* EXPRESSION */
/* <exp> ::= <cmp> */
/* <exp> ::= <exp> #rop# <cmp> */
/* */
/* COMPARAND */
/* <cmp> ::= <trm> */
/* <cmp> ::= <cmp> #aop# <trm> */
/* */
/* TERM */
/* <trm> ::= <fct> */
/* <trm> ::= <trm> #mop# <fct> */
/* */
/* FACTOR */
/* <fct> ::= <ref> */
/* <fct> ::= <fct> #xop# <ref> */
/* */
/* REFERENCE */
/* <ref> ::= '(' <spc> ')' */
/* <ref> ::= <opr> <ref> */
/* <ref> ::= <apl> */
/* <ref> ::= <tab> */
/* <ref> ::= <idf> */
/* <ref> ::= <nbr> */
/* <ref> ::= <sym> */
/* */
/* APPLICATION */
/* <apl> ::= <idf> '(' ')' */
/* <apl> ::= <idf> '(' <arg> ')' */
/* <apl> ::= <idf> '@' <nam> */
/* */
/* TABULATION */
/* <tab> ::= <idf> '[' <idx> ']' */
/* */
/* ARGUMENTS */
/* <arg> ::= <spc> */
/* <arg> ::= <spc> ',' <arg> */
/* */
/* INDEX */
/* <idx> ::= <spc> */
/* */
/* OPERATOR */
/* <opr> ::= #rop# */
/* <opr> ::= #aop# */
/* <opr> ::= #mop# */
/* <opr> ::= #xop# */
/* */
/* IDENTIFIER */
/* <idf> ::= #nam# */
/* <idf> ::= <opr> */
/* */
/*----------------------------------------------------------------------------*/
#include "nano.h"
#define READ_TOKEN current_token = _scan_()
static void read_DEF();
static void read_TAB();
static void read_OPR();
static void read_DFF();
static void read_STF();
static void read_SUB();
static void read_EXP();
static void read_DFN();
static void read_STN();
static void read_NRY();
static void read_NAM();
static void read_IDX();
static void read_RFN();
static void read_UNR();
static void read_RXF();
static void read_RFF();
static void read_RFT();
static void read_FCC();
static void read_FXC();
static void read_BIN();
static void read_TRC();
static void read_TXC();
static void read_CMC();
static void read_CXC();
static void read_EXC();
static void read_NXY();
static void read_DFT();
static void read_STT();
static _TOKEN_ current_token;
static _STR_ read_nam()
{
char *str = _scan_string_();
_STR_ exp = _ag_make_STR_(_dct_make_NAM_(str));
READ_TOKEN;
return exp;
}
/*----------------------------------------------------------------------------*/
/* read_REF
*/
/* expr-stack:
[... ... ... ...
... ...] -> [... ... ... ... ... ...] */
/* cont-stack:
[... ... ... ...
CNT REF] -> [... ... ... CNT SUB EXP] */
/*
*/
/* expr-stack:
[... ... ... ...
... ...] -> [... ... ... ... ... NAM] */
/* cont-stack:
[... ... ... ...
CNT REF] -> [... ... ... CNT DEF NRY] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... NAM] */
/* cont-stack: [... ... ... ... CNT REF] -> [... ... CNT TAB IDX EXP] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... NAM] */
/* cont-stack: [... ... ... ... CNT REF] -> [... ... CNT DEF UNR RXF] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... NAM] */
/* cont-stack: [... ... ... ... CNT REF] -> [... ... ... ... CNT RFN] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... NBR] */
/* cont-stack: [... ... ... ... CNT REF] -> [... ... ... ... ... CNT] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... FRC] */
/* cont-stack: [... ... ... ... CNT REF] -> [... ... ... ... ... CNT] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... STR] */
/* cont-stack: [... ... ... ... CNT REF] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_REF()
{ _STR_ nam;
switch (current_token)
{ case _LPR_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_SUB);
_stk_push_CNT_(read_EXP);
return;
case _NAM_TOKEN_:
nam = read_nam();
_stk_push_EXP_(nam);
switch (current_token)
{
case _COL_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_DFN);
_stk_push_CNT_(read_EXP);
return;
case _ASS_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_STN);
_stk_push_CNT_(read_EXP);
return;
case _LPR_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_DEF);
_stk_push_CNT_(read_NRY);
return;
case _CAT_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_DEF);
_stk_push_CNT_(read_NAM);
return;
case _LBR_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_TAB);
_stk_push_CNT_(read_IDX);
_stk_push_CNT_(read_EXP);
return;
}
_stk_poke_CNT_(read_RFN);
return;
case _ROP_TOKEN_:
case _AOP_TOKEN_:
case _MOP_TOKEN_:
case _XOP_TOKEN_:
nam =
read_nam();
_stk_push_EXP_(nam);
switch (current_token)
{
case _COL_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_DFN);
_stk_push_CNT_(read_EXP);
return;
case _ASS_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_STN);
_stk_push_CNT_(read_EXP);
return;
case _LPR_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_DEF);
_stk_push_CNT_(read_NRY);
return;
case _CAT_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_DEF);
_stk_push_CNT_(read_NAM);
return;
case _NBR_TOKEN_:
case _FRC_TOKEN_:
case _STR_TOKEN_:
case _NAM_TOKEN_:
_stk_poke_CNT_(read_DEF);
_stk_push_CNT_(read_UNR);
_stk_push_CNT_(read_RXF);
return;
}
_stk_poke_CNT_(read_RFN);
return;
case _NBR_TOKEN_:
{
long nbr = _scan_integer_();
_NBR_ exp = _ag_make_NBR_(nbr);
READ_TOKEN;
_stk_push_EXP_(exp);
_stk_zap_CNT_();
return;
}
case _FRC_TOKEN_:
{
double frc = _scan_float_();
_FRC_ exp = _ag_make_FRC_(frc);
READ_TOKEN;
_stk_push_EXP_(exp);
_stk_zap_CNT_();
return;
}
case _STR_TOKEN_:
{
char *str = _scan_string_();
_STR_ exp = _ag_make_STR_(strdup(str));
READ_TOKEN;
_stk_push_EXP_(exp);
_stk_zap_CNT_();
return;
}}
_scan_error_(_REF_ERROR_);
}
/*----------------------------------------------------------------------------*/
/* read_RXF
*/
/* expr-stack:
[... ... ... ...
... ...] -> [... ... ... ... ... ...] */
/* cont-stack:
[... ... ... ...
CNT RXF] -> [... ... ... CNT SUB EXP] */
/*
*/
/* expr-stack:
[... ... ... ...
... ...] -> [... ... ... ... ... NAM] */
/* cont-stack:
[... ... ... ...
CNT RXF] -> [... ... ... CNT RFF NRY] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... NAM] */
/* cont-stack: [... ... ... ... CNT RXF] -> [... ... CNT RFT IDX EXP] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... NAM] */
/* cont-stack: [... ... ... ... CNT RXF] -> [... ... CNT RFF UNR RXF] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... NAM] */
/* cont-stack: [... ... ... ... CNT RXF] -> [... ... ... ... CNT RFN] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... NBR] */
/* cont-stack: [... ... ... ... CNT RXF] -> [... ... ... ... ... CNT] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... FRC] */
/* cont-stack: [... ... ... ... CNT RXF] -> [... ... ... ... ... CNT] */
/* */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... STR] */
/* cont-stack: [... ... ... ... CNT RXF] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_RXF()
{ _STR_ nam;
switch (current_token)
{ case _LPR_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_SUB);
_stk_push_CNT_(read_EXP);
return;
case _NAM_TOKEN_:
nam = read_nam();
_stk_push_EXP_(nam);
switch (current_token)
{ case _LPR_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_RFF);
_stk_push_CNT_(read_NRY);
return;
case _CAT_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_RFF);
_stk_push_CNT_(read_NAM);
return;
case _LBR_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_RFT);
_stk_push_CNT_(read_IDX);
_stk_push_CNT_(read_EXP);
return; }
_stk_poke_CNT_(read_RFN);
return;
case _ROP_TOKEN_:
case _AOP_TOKEN_:
case _MOP_TOKEN_:
case _XOP_TOKEN_:
nam
= read_nam();
_stk_push_EXP_(nam);
switch
(current_token)
{ case _LPR_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_RFF);
_stk_push_CNT_(read_NRY);
return;
case
_CAT_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_RFF);
_stk_push_CNT_(read_NAM);
return;
case _NBR_TOKEN_:
case _FRC_TOKEN_:
case _STR_TOKEN_:
case _NAM_TOKEN_:
_stk_poke_CNT_(read_DEF);
_stk_push_CNT_(read_UNR);
_stk_push_CNT_(read_RXF);
return; }
_stk_poke_CNT_(read_RFN);
return;
case _NBR_TOKEN_:
{ long nbr = _scan_integer_();
_NBR_ exp = _ag_make_NBR_(nbr);
READ_TOKEN;
_stk_push_EXP_(exp);
_stk_zap_CNT_();
return; }
case _FRC_TOKEN_:
{
double frc = _scan_float_();
_FRC_ exp = _ag_make_FRC_(frc);
READ_TOKEN;
_stk_push_EXP_(exp);
_stk_zap_CNT_();
return; }
case _STR_TOKEN_:
{ char *str = _scan_string_();
_STR_ exp = _ag_make_STR_(strdup(str));
READ_TOKEN;
_stk_push_EXP_(exp);
_stk_zap_CNT_();
return; }}
_scan_error_(_REF_ERROR_); }
/*----------------------------------------------------------------------------*/
/* read_SUB */
/* expr-stack: [... ... ... ... ... EXP] -> [... ... ... ... ... EXP] */
/* cont-stack: [... ... ... ... CNT SUB] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_SUB()
{ if (current_token != _RPR_TOKEN_)
_scan_error_(_RPR_ERROR_);
READ_TOKEN;
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_IDX */
/* expr-stack: [... ... ... ... NAM IDX] -> [... ... ... ... NAM IDX] */
/* cont-stack: [... ... ... ... CNT IDX] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_IDX()
{ if (current_token == _RBR_TOKEN_)
{ READ_TOKEN;
_stk_zap_CNT_();
return; }
_scan_error_(_RBR_ERROR_); }
/*----------------------------------------------------------------------------*/
/* read_FCT
*/
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... ...] */
/* cont-stack: [... ... ... ... CNT FCT] -> [... ... ... CNT FCC REF] */
/*----------------------------------------------------------------------------*/
static void read_FCT()
{ _stk_poke_CNT_(read_FCC);
_stk_push_CNT_(read_REF); }
/*----------------------------------------------------------------------------*/
/* read_FXT */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... ...] */
/* cont-stack: [... ... ... ... CNT FXT] -> [... ... ... CNT FXC RXF] */
/*----------------------------------------------------------------------------*/
static void read_FXT()
{ _stk_poke_CNT_(read_FXC);
_stk_push_CNT_(read_RXF); }
/*----------------------------------------------------------------------------*/
/* read_FCC */
/* expr-stack: [... ... ... ... ... REF] -> [... ... ... ... NAM REF] */
/* cont-stack: [... ... ... ... CNT FCC] -> [... CNT FCC OPR BIN RXF] */
/* */
/* expr-stack: [... ... ... ... ... REF] -> [... ... ... ... ... REF] */
/* cont-stack: [... ... ... ... CNT FCC] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_FCC()
{ if (current_token == _XOP_TOKEN_)
{ _STR_ nam = read_nam();
_EXP_ ref = _stk_peek_EXP_();
_stk_poke_EXP_(nam);
_stk_push_EXP_(ref);
_stk_push_CNT_(read_OPR);
_stk_push_CNT_(read_BIN);
_stk_push_CNT_(read_RXF);
return; }
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_FXC */
/* expr-stack: [... ... ... ... ... REF] -> [... ... ... ... NAM REF] */
/* cont-stack: [... ... ... ... CNT FXC] -> [... CNT FXC RFF BIN FXT] */
/* */
/* expr-stack: [... ... ... ... ... REF] -> [... ... ... ... ... REF] */
/* cont-stack: [... ... ... ... CNT FXC] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_FXC()
{ if (current_token == _XOP_TOKEN_)
{ _STR_ nam = read_nam();
_EXP_ ref = _stk_peek_EXP_();
_stk_poke_EXP_(nam);
_stk_push_EXP_(ref);
_stk_push_CNT_(read_RFF);
_stk_push_CNT_(read_BIN);
_stk_push_CNT_(read_FXT);
return; }
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_TRM */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... ...] */
/* cont-stack: [... ... ... ... CNT TRM] -> [... ... ... CNT TRC FCT] */
/*----------------------------------------------------------------------------*/
static void read_TRM()
{ _stk_poke_CNT_(read_TRC);
_stk_push_CNT_(read_FCT); }
/*----------------------------------------------------------------------------*/
/* read_TXM
*/
/* expr-stack:
[... ... ... ...
... ...] -> [... ... ... ... ... ...] */
/* cont-stack:
[... ... ... ...
CNT TXM] -> [... ... ... CNT TXC FXT] */
/*----------------------------------------------------------------------------*/
static void read_TXM()
{ _stk_poke_CNT_(read_TXC);
_stk_push_CNT_(read_FXT); }
/*----------------------------------------------------------------------------*/
/* read_TRC */
/* expr-stack: [... ... ... ... ... FCT] -> [... ... ... ... NAM FCT] */
/* cont-stack: [... ... ... ... CNT TRC] -> [... CNT TRC OPR BIN FXT] */
/* */
/* expr-stack: [... ... ... ... ... FCT] -> [... ... ... ... ... FCT] */
/* cont-stack: [... ... ... ... CNT TRC] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_TRC()
{ if (current_token == _MOP_TOKEN_)
{ _STR_ nam = read_nam();
_EXP_ fct = _stk_peek_EXP_();
_stk_poke_EXP_(nam);
_stk_push_EXP_(fct);
_stk_push_CNT_(read_OPR);
_stk_push_CNT_(read_BIN);
_stk_push_CNT_(read_FXT);
return; }
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_TXC */
/* expr-stack: [... ... ... ... ... FCT] -> [... ... ... ... NAM FCT] */
/* cont-stack: [... ... ... ... CNT TXC] -> [... CNT TXC RFF BIN FXT] */
/* */
/* expr-stack: [... ... ... ... ... FCT] -> [... ... ... ... ... FCT] */
/* cont-stack: [... ... ... ... CNT TXC] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_TXC()
{ if (current_token == _MOP_TOKEN_)
{ _STR_ nam = read_nam();
_EXP_ fct = _stk_peek_EXP_();
_stk_poke_EXP_(nam);
_stk_push_EXP_(fct);
_stk_push_CNT_(read_RFF);
_stk_push_CNT_(read_BIN);
_stk_push_CNT_(read_FXT);
return; }
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_CMP */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... ...] */
/* cont-stack: [... ... ... ... CNT CMP] -> [... ... ... CNT CMC TRM] */
/*----------------------------------------------------------------------------*/
static void read_CMP()
{ _stk_poke_CNT_(read_CMC);
_stk_push_CNT_(read_TRM); }
/*----------------------------------------------------------------------------*/
/* read_CXP */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... ...] */
/* cont-stack: [... ... ... ... CNT CMP] -> [... ... ... CNT CXC TXM] */
/*----------------------------------------------------------------------------*/
static void read_CXP()
{ _stk_poke_CNT_(read_CXC);
_stk_push_CNT_(read_TXM); }
/*----------------------------------------------------------------------------*/
/* read_CMC
*/
/* expr-stack:
[... ... ... ...
... TRM] -> [... ... ... ... NAM TRM] */
/* cont-stack:
[... ... ... ...
CNT CMC] -> [... CNT CMC OPR BIN TXM] */
/*
*/
/* expr-stack:
[... ... ... ...
... TRM] -> [... ... ... ... ... TRM] */
/* cont-stack: [... ... ... ... CNT CMC] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_CMC()
{ if (current_token == _AOP_TOKEN_)
{ _STR_ nam = read_nam();
_EXP_ trm = _stk_peek_EXP_();
_stk_poke_EXP_(nam);
_stk_push_EXP_(trm);
_stk_push_CNT_(read_OPR);
_stk_push_CNT_(read_BIN);
_stk_push_CNT_(read_TXM);
return; }
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_CXC */
/* expr-stack: [... ... ... ... ... TRM] -> [... ... ... ... NAM TRM] */
/* cont-stack: [... ... ... ... CNT CXC] -> [... CNT CXC RFF BIN TXM] */
/* */
/* expr-stack: [... ... ... ... ... TRM] -> [... ... ... ... ... TRM] */
/* cont-stack: [... ... ... ... CNT CXC] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_CXC()
{ if (current_token == _AOP_TOKEN_)
{ _STR_ nam = read_nam();
_EXP_ trm = _stk_peek_EXP_();
_stk_poke_EXP_(nam);
_stk_push_EXP_(trm);
_stk_push_CNT_(read_RFF);
_stk_push_CNT_(read_BIN);
_stk_push_CNT_(read_TXM);
return; }
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_EXP */
/* expr-stack: [... ... ... ... ... ...] -> [... ... ... ... ... ...] */
/* cont-stack: [... ... ... ... CNT EXP] -> [... ... ... CNT EXC CMP] */
/*----------------------------------------------------------------------------*/
static void read_EXP()
{ _stk_poke_CNT_(read_EXC);
_stk_push_CNT_(read_CMP); }
/*----------------------------------------------------------------------------*/
/* read_EXC */
/* expr-stack: [... ... ... ... ... CMP] -> [... ... ... ... NAM CMP] */
/* cont-stack: [... ... ... ... CNT EXC] -> [... CNT EXC OPR BIN CXP] */
/* */
/* expr-stack: [... ... ... ... ... CMP] -> [... ... ... ... ... CMP] */
/* cont-stack: [... ... ... ... CNT EXC] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_EXC()
{ if (current_token == _ROP_TOKEN_)
{ _STR_ nam = read_nam();
_EXP_ cmp = _stk_peek_EXP_();
_stk_poke_EXP_(nam);
_stk_push_EXP_(cmp);
_stk_push_CNT_(read_OPR);
_stk_push_CNT_(read_BIN);
_stk_push_CNT_(read_CXP);
return; }
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_NRY
*/
/* expr-stack:
[... ... ... ...
... NAM] -> [... ... ... ... NAM NBR] */
/* cont-stack:
[... ... ... ...
CNT NRY] -> [... ... ... CNT NXY EXP] */
/* */
/* expr-stack: [... ... ... ... ... NAM] -> [... ... ... ... NAM EMP] */
/* cont-stack: [... ... ... ... CNT NRY] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_NRY()
{ _NBR_ nbr;
if (current_token == _RPR_TOKEN_)
{ READ_TOKEN;
_stk_push_EXP_(_ag_make_TAB_(0));
_stk_zap_CNT_();
return; }
nbr = _ag_make_NBR_(1);
_stk_push_EXP_(nbr);
_stk_poke_CNT_(read_NXY);
_stk_push_CNT_(read_EXP); }
/*----------------------------------------------------------------------------*/
/* read_NXY */
/* expr-stack: [NAM EXP ... EXP NBR EXP] -> [NAM EXP ... EXP EXP NBR] */
/* cont-stack: [... ... ... ... CNT NXY] -> [... ... ... CNT NXY EXP] */
/* */
/* expr-stack: [NAM EXP ... EXP NBR EXP] -> [... ... ... ... NAM TAB] */
/* cont-stack: [... ... ... ... CNT NXY] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_NXY()
{ _EXP_ exp = _stk_pop_EXP_();
_NBR_ nbr = (_NBR_)_stk_peek_EXP_();
_TAB_ tab;
long idx = _ag_get_NBR_(nbr);
switch (current_token)
{ case _COM_TOKEN_:
READ_TOKEN;
nbr = _ag_make_NBR_(idx+1);
_stk_poke_EXP_(exp);
_stk_push_EXP_(nbr);
_stk_push_CNT_(read_EXP);
return;
case _RPR_TOKEN_:
READ_TOKEN;
tab = _ag_make_TAB_(idx);
do
{ _stk_zap_EXP_();
_ag_set_TAB_EXP_(tab, idx, exp);
exp = _stk_peek_EXP_(); }
while (--idx);
_stk_push_EXP_(tab);
_stk_zap_CNT_();
return; }
_scan_error_(_RPR_ERROR_); }
/*----------------------------------------------------------------------------*/
/* read_BIN */
/* expr-stack: [... ... ... NAM EXP EXP] -> [... ... ... ... NAM ARG] */
/* cont-stack: [... ... ... ... CNT BIN] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_BIN()
{
_TAB_ arg = _ag_make_TAB_(2);
_EXP_ exp_2 = _stk_pop_EXP_();
_EXP_ exp_1 = _stk_peek_EXP_();
_ag_set_TAB_EXP_(arg, 1, exp_1);
_ag_set_TAB_EXP_(arg, 2, exp_2);
_stk_poke_EXP_(arg);
_stk_zap_CNT_();
}
/*----------------------------------------------------------------------------*/
/* read_UNR
*/
/* expr-stack:
[... ... ... ...
NAM EXP] -> [... ... ... ... NAM ARG] */
/* cont-stack: [... ... ... ... CNT UNR] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_UNR()
{
_TAB_ arg = _ag_make_TAB_(1);
_EXP_ exp = _stk_peek_EXP_();
_ag_set_TAB_EXP_(arg, 1, exp);
_stk_poke_EXP_(arg);
_stk_zap_CNT_();
}
/*----------------------------------------------------------------------------*/
/* read_DEF */
/* expr-stack: [... ... ... ... NAM ARG] -> [... ... ... ... NAM ARG] */
/* cont-stack: [... ... ... ... CNT DEF] -> [... ... ... CNT DFF EXP] */
/* */
/* expr-stack: [... ... ... ... NAM ARG] -> [... ... ... ... NAM ARG] */
/* cont-stack: [... ... ... ... CNT DEF] -> [... ... ... CNT STF EXP] */
/* */
/* expr-stack: [... ... ... ... NAM ARG] -> [... ... ... ... NAM ARG] */
/* cont-stack: [... ... ... ... CNT DEF] -> [... ... ... ... CNT RFF] */
/*----------------------------------------------------------------------------*/
static void read_DEF()
{
switch (current_token)
{
case _COL_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_DFF);
_stk_push_CNT_(read_EXP);
return;
case _ASS_TOKEN_:
READ_TOKEN;
_stk_poke_CNT_(read_STF);
_stk_push_CNT_(read_EXP);
return; }
_stk_poke_CNT_(read_RFF);
}
/*----------------------------------------------------------------------------*/
/* read_OPR */
/* expr-stack: [... ... ... ... NAM ARG] -> [... ... ... ... NAM ARG] */
/* cont-stack: [... ... ... CNT OPC OPR] -> [... ... ... CNT DFF EXP] */
/* */
/* expr-stack: [... ... ... ... NAM ARG] -> [... ... ... ... NAM ARG] */
/* cont-stack: [... ... ... CNT OPC OPR] -> [... ... ... CNT STF EXP] */
/* */
/* expr-stack: [... ... ... ... NAM ARG] -> [... ... ... ... NAM ARG] */
/* cont-stack: [... ... ... CNT OPC OPR] -> [... ... ... CNT OPC RFF] */
/*----------------------------------------------------------------------------*/
static void read_OPR()
{ switch (current_token)
{ case _COL_TOKEN_:
READ_TOKEN;
_stk_zap_CNT_();
_stk_poke_CNT_(read_DFF);
_stk_push_CNT_(read_EXP);
return;
case _ASS_TOKEN_:
READ_TOKEN;
_stk_zap_CNT_();
_stk_poke_CNT_(read_STF);
_stk_push_CNT_(read_EXP);
return; }
_stk_poke_CNT_(read_RFF); }
/*----------------------------------------------------------------------------*/
/* read_TAB
*/
/* expr-stack:
[... ... ... ...
NAM IDX] -> [... ... ... ... NAM IDX] */
/* cont-stack:
[... ... ... ...
CNT TAB] -> [... ... ... CNT DFT EXP] */
/* */
/* expr-stack: [... ... ... ... NAM IDX] -> [... ... ... ... NAM IDX] */
/* cont-stack: [... ... ... ... CNT TAB] -> [... ... ... CNT STT EXP] */
/* */
/* expr-stack: [... ... ... ... NAM IDX] -> [... ... ... ... ... RFT] */
/* cont-stack: [... ... ... ... CNT TAB] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_TAB()
{ switch (current_token)
{ case _COL_TOKEN_:
READ_TOKEN;
_stk_zap_CNT_();
_stk_poke_CNT_(read_DFT);
_stk_push_CNT_(read_EXP);
return;
case _ASS_TOKEN_:
READ_TOKEN;
_stk_zap_CNT_();
_stk_poke_CNT_(read_STT);
_stk_push_CNT_(read_EXP);
return; }
_stk_poke_CNT_(read_RFT); }
/*----------------------------------------------------------------------------*/
/* read_DFF */
/* expr-stack: [... ... ... NAM ARG EXP] -> [... ... ... ... ... DFF] */
/* cont-stack: [... ... ... ... CNT DFF] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_DFF()
{ _DFF_ dff=_ag_make_DFF_();
_EXP_ exp=_stk_pop_EXP_();
_EXP_ arg=_stk_pop_EXP_();
_EXP_ nam=_stk_peek_EXP_();
_ag_set_DFF_NAM_(dff, _ag_get_STR_(nam));
_ag_set_DFF_ARG_(dff, arg);
_ag_set_DFF_EXP_(dff, exp);
_stk_poke_EXP_(dff);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_STF */
/* expr-stack: [... ... ... NAM ARG EXP] -> [... ... ... ... ... STF] */
/* cont-stack: [... ... ... ... CNT STF] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_STF()
{ _STF_ stf = _ag_make_STF_();
_EXP_ exp = _stk_pop_EXP_();
_EXP_ arg = _stk_pop_EXP_();
_EXP_ nam = _stk_peek_EXP_();
_ag_set_STF_NAM_(stf, _ag_get_STR_(nam));
_ag_set_STF_ARG_(stf, arg);
_ag_set_STF_EXP_(stf, exp);
_stk_poke_EXP_(stf);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_RFF */
/* expr-stack: [... ... ... ... NAM ARG] -> [... ... ... ... ... RFF] */
/* cont-stack: [... ... ... ... CNT RFF] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_RFF()
{ _RFF_ rff = _ag_make_RFF_();
_EXP_ arg = _stk_pop_EXP_();
_EXP_ nam = _stk_peek_EXP_();
_ag_set_RFF_NAM_(rff, _ag_get_STR_(nam));
_ag_set_RFF_ARG_(rff, arg);
_stk_poke_EXP_(rff);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_DFT */
/* expr-stack: [... ... ... NAM IDX EXP] -> [... ... ... ... ... DFT] */
/* cont-stack: [... ... ... ... CNT DFT] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_DFT()
{ _DFT_ dft = _ag_make_DFT_();
_EXP_ exp = _stk_pop_EXP_();
_EXP_ idx = _stk_pop_EXP_();
_EXP_ nam = _stk_peek_EXP_();
_ag_set_DFT_NAM_(dft, _ag_get_STR_(nam));
_ag_set_DFT_IDX_(dft, idx);
_ag_set_DFT_EXP_(dft, exp);
_stk_poke_EXP_(dft);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_STT */
/* expr-stack: [... ... ... NAM IDX EXP] -> [... ... ... ... ... STT] */
/* cont-stack: [... ... ... ... CNT STT] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_STT()
{ _STT_ stt = _ag_make_STT_();
_EXP_ exp = _stk_pop_EXP_();
_EXP_ idx = _stk_pop_EXP_();
_EXP_ nam = _stk_peek_EXP_();
_ag_set_STT_NAM_(stt, _ag_get_STR_(nam));
_ag_set_STT_IDX_(stt, idx);
_ag_set_STT_EXP_(stt, exp);
_stk_poke_EXP_(stt);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_RFT */
/* expr-stack: [... ... ... ... NAM IDX] -> [... ... ... ... ... RFT] */
/* cont-stack: [... ... ... ... CNT RFT] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_RFT()
{ _RFT_ rft = _ag_make_RFT_();
_EXP_ idx = _stk_pop_EXP_();
_EXP_ nam = _stk_peek_EXP_();
_ag_set_RFT_NAM_(rft, _ag_get_STR_(nam));
_ag_set_RFT_IDX_(rft, idx);
_stk_poke_EXP_(rft);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_DFN */
/* expr-stack: [... ... ... ... NAM EXP] -> [... ... ... ... ... DFN] */
/* cont-stack: [... ... ... ... CNT DFN] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_DFN()
{ _DFN_ dfn = _ag_make_DFN_();
_EXP_ exp = _stk_pop_EXP_();
_EXP_ nam = _stk_peek_EXP_();
_ag_set_DFN_NAM_(dfn, _ag_get_STR_(nam));
_ag_set_DFN_EXP_(dfn, exp);
_stk_poke_EXP_(dfn);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_STN
*/
/* expr-stack:
[... ... ... ...
NAM EXP] -> [... ... ... ... ... STN] */
/* cont-stack:
[... ... ... ...
CNT STN] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_STN()
{ _STN_ stn = _ag_make_STN_();
_EXP_ exp = _stk_pop_EXP_();
_EXP_ nam = _stk_peek_EXP_();
_ag_set_STN_NAM_(stn,
_ag_get_STR_(nam));
_ag_set_STN_EXP_(stn, exp);
_stk_poke_EXP_(stn);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
/* read_NAM */
/* expr-stack: [... ... ... ... ... NAM] -> [... ... ... ... NAM RFN] */
/* cont-stack: [... ... ... ... CNT NAM] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_NAM()
{
if (current_token == _NAM_TOKEN_)
{
_RFN_ rfn = _ag_make_RFN_();
_STR_ nam = read_nam();
_ag_set_RFN_NAM_(rfn, _ag_get_STR_(nam));
_stk_push_EXP_(rfn);
_stk_zap_CNT_();
return;
}
_scan_error_(_NAM_ERROR_);
}
/*----------------------------------------------------------------------------*/
/* read_RFN */
/* expr-stack: [... ... ... ... ... NAM] -> [... ... ... ... ... RFN] */
/* cont-stack: [... ... ... ... CNT RFN] -> [... ... ... ... ... CNT] */
/*----------------------------------------------------------------------------*/
static void read_RFN()
{ _RFN_ rfn = _ag_make_RFN_();
_EXP_ nam = _stk_peek_EXP_();
_ag_set_RFN_NAM_(rfn, _ag_get_STR_(nam));
_stk_poke_EXP_(rfn);
_stk_zap_CNT_(); }
/*----------------------------------------------------------------------------*/
static _EXP_ read()
{ _EXP_ exp;
current_token = _scan_();
_stk_clear_();
_stk_push_CNT_(read_EXP);
do
_stk_peek_CNT_()();
while (!_stk_empty_CNT_());
exp = _stk_pop_EXP_();
if (current_token != _END_TOKEN_)
_scan_error_(_EXT_ERROR_);
_scan_stop_();
return exp; }
/* exported functions */
_EXP_ _read_text_(const char *start, const char *stop)
{ _scan_from_text_(start, stop);
return read(); }
_EXP_ _read_file_(const FILE *file)
{ _scan_from_file_(file);
return read(); }
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* Lab voor Programmeerkunde VUB */
/* ©1995 */
/*-----------------------------------*/
#include "nano.h"
#define SCAN_TEXT_SIZE 255
#define SCAN_CHECK(allowed) ((allowed >> scan_char_tab[scan_ch]) & 1)
typedef enum scan_fun_index { Wsp = 0,
Ill = 1,
Eol = 2,
Ltr = 3,
Dgt = 4,
Exp = 5,
Aop = 6,
Rop = 7,
Mop = 8,
Xop = 9,
Pls = 10,
Mns = 11,
Apo = 12,
Com = 13,
Per = 14,
Col = 15,
Eql = 16,
Cat = 17,
Lpr = 18,
Rpr = 19,
Lbr = 20,
Rbr = 21 } scan_fun_index;
typedef _TOKEN_ scan_fun();
typedef unsigned scan_fun_index_set;
static _TOKEN_ scan_Wsp();
static _TOKEN_ scan_Ill();
static _TOKEN_ scan_Ltr();
static _TOKEN_ scan_Dgt();
static _TOKEN_ scan_Aop();
static _TOKEN_ scan_Rop();
static _TOKEN_ scan_Mop();
static _TOKEN_ scan_Xop();
static _TOKEN_ scan_Apo();
static _TOKEN_ scan_Com();
static _TOKEN_ scan_Col();
static _TOKEN_ scan_Cat();
static _TOKEN_ scan_Lpr();
static _TOKEN_ scan_Rpr();
static _TOKEN_ scan_Lbr();
static _TOKEN_ scan_Rbr();
/* variables */
static char scan_text [SCAN_TEXT_SIZE] = "";
static int scan_text_index = 0;
/* important note:
* if you use an unsigned char, the comparison with EOF will always be 0
* due to limited range of unsigned char.
*/
static int scan_ch = '\0';
static FILE *in_file = 0;
static char *in_start = 0;
static char *in_stop = 0;
static char *in_hold = 0;
const static scan_fun_index
scan_char_tab[]
=
{Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Eol,Wsp,Wsp,Wsp,Wsp,Wsp, /*000*/
/* */
Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp,Wsp, /*016*/
/* ! " # $ % & ' ( ) * + , - . / */
Wsp,Xop,Ill,Rop,Aop,Aop,Mop,Apo,Lpr,Rpr,Mop,Pls,Com,Mns,Per,Mop, /*032*/
/* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? */
Dgt,Dgt,Dgt,Dgt,Dgt,Dgt,Dgt,Dgt,Dgt,Dgt,Col,Rop,Rop,Eql,Rop,Xop, /*048*/
/* @ A B C D E F G H I J K L M N O */
Cat,Ltr,Ltr,Ltr,Ltr,Exp,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr, /*064*/
/* P Q R S T U V W X Y Z [ \ ] ^ _ */
Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Lbr,Mop,Rbr,Xop,Ltr, /*080*/
/* ` a b c d e f g h i j k l m n o */
Ill,Ltr,Ltr,Ltr,Ltr,Exp,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr, /*096*/
/* p q r s t u v w x y z { | } ~ */
Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ltr,Ill,Aop,Ill,Aop,Ill, /*112*/
/* */
Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill, /*128*/
/* */
Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill, /*144*/
/* */
Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill, /*160*/
/* */
Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill, /*176*/
/* */
Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill, /*192*/
/* */
Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill, /*208*/
/* */
Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill, /*224*/
/* */
Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill,Ill}; /*240*/
/* */
static scan_fun *scan_fun_tab[] = {scan_Wsp,
scan_Ill,
scan_Wsp,
scan_Ltr,
scan_Dgt,
scan_Ltr,
scan_Aop,
scan_Rop,
scan_Mop,
scan_Xop,
scan_Aop,
scan_Aop,
scan_Apo,
scan_Com,
scan_Ill,
scan_Col,
scan_Rop,
scan_Cat,
scan_Lpr,
scan_Rpr,
scan_Lbr,
scan_Rbr};
const static scan_fun_index_set operator_allowed
= (1<<Rop)+(1<<Eql)+(1<<Xop)+(1<<Mop)+(1<<Aop)+(1<<Pls)+(1<<Mns);
const static scan_fun_index_set name_allowed
= (1<<Ltr)+(1<<Exp)+(1<<Dgt);
const static scan_fun_index_set symbol_allowed
= (1<<Wsp)+(1<<Ill)+(1<<Ltr)+(1<<Dgt)+(1<<Exp)+(1<<Aop)+(1<<Rop)+
(1<<Mop)+(1<<Xop)+(1<<Pls)+(1<<Mns)+(1<<Com)+(1<<Per)+(1<<Col)+
(1<<Eql)+(1<<Cat)+(1<<Lpr)+(1<<Rpr)+(1<<Lbr)+(1<<Rbr);
const static scan_fun_index_set digit_allowed
= (1<<Dgt);
const static scan_fun_index_set
sign_allowed
= (1<<Pls)+(1<<Mns);
const static scan_fun_index_set period_allowed
= (1<<Per);
const static scan_fun_index_set exponent_allowed
= (1<<Exp);
const static scan_fun_index_set equal_allowed
= (1<<Eql);
const static scan_fun_index_set wsp_allowed
= (1<<Wsp);
/* private functions */
static void scan_next_ch()
{ if (in_start)
{ if (in_start <= in_stop) scan_ch = *(in_start++);
else scan_ch = EOF;
return; }
if (in_file)
{ scan_ch = fgetc(in_file);
return; }
scan_ch = EOF; }
static void scan_store_next_ch()
{ scan_text[scan_text_index++] = scan_ch;
if (scan_text_index == SCAN_TEXT_SIZE)
_scan_error_(_TXT_ERROR_);
scan_next_ch(); }
static void scan_terminate_text()
{ scan_text[scan_text_index] = '\0';
scan_text_index = 0; }
static void scan_operator()
{ do
scan_store_next_ch();
while (SCAN_CHECK(operator_allowed));
scan_terminate_text(); }
static void scan_name()
{ do
scan_store_next_ch();
while (SCAN_CHECK(name_allowed));
scan_terminate_text(); }
static void scan_symbol()
{ scan_next_ch();
while (SCAN_CHECK(symbol_allowed))
scan_store_next_ch();
scan_next_ch();
scan_terminate_text(); }
static _TOKEN_ scan_exponent()
{ scan_store_next_ch();
if (SCAN_CHECK(sign_allowed))
scan_store_next_ch();
if (SCAN_CHECK(digit_allowed))
do
scan_store_next_ch();
while (SCAN_CHECK(digit_allowed));
else
_scan_error_(_DIG_ERROR_);
scan_terminate_text();
return _FRC_TOKEN_; }
static _TOKEN_ scan_fraction()
{ scan_store_next_ch();
if (SCAN_CHECK(digit_allowed))
do
scan_store_next_ch();
while (SCAN_CHECK(digit_allowed));
else
_scan_error_(_DIG_ERROR_);
if (SCAN_CHECK(exponent_allowed))
return scan_exponent();
else
{ scan_terminate_text();
return _FRC_TOKEN_; }}
static _TOKEN_ scan_number()
{ do
scan_store_next_ch();
while (SCAN_CHECK(digit_allowed));
if (SCAN_CHECK(period_allowed))
return scan_fraction();
else
if (SCAN_CHECK(exponent_allowed))
return scan_exponent();
else
{ scan_terminate_text();
return _NBR_TOKEN_; }}
static _TOKEN_ scan_Ill()
{ _scan_error_(_ILL_ERROR_);
return _END_TOKEN_; }
static _TOKEN_ scan_Wsp()
{ do
scan_next_ch();
while (SCAN_CHECK(wsp_allowed));
if (scan_ch == EOF)
return _END_TOKEN_;
else
return _scan_(); }
static _TOKEN_ scan_Xop()
{ scan_operator();
return _XOP_TOKEN_; }
static _TOKEN_ scan_Mop()
{ scan_operator();
return _MOP_TOKEN_; }
static _TOKEN_ scan_Aop()
{ scan_operator();
return _AOP_TOKEN_; }
static _TOKEN_ scan_Rop()
{ scan_operator();
return _ROP_TOKEN_; }
static _TOKEN_ scan_Apo()
{ scan_symbol();
return _STR_TOKEN_; }
static _TOKEN_ scan_Lpr()
{ scan_next_ch();
return _LPR_TOKEN_; }
static _TOKEN_ scan_Rpr()
{ scan_next_ch();
return _RPR_TOKEN_; }
static _TOKEN_ scan_Lbr()
{ scan_next_ch();
return _LBR_TOKEN_; }
static _TOKEN_ scan_Rbr()
{ scan_next_ch();
return _RBR_TOKEN_; }
static _TOKEN_ scan_Dgt()
{ return scan_number(); }
static _TOKEN_ scan_Col()
{ scan_next_ch();
if (SCAN_CHECK(equal_allowed))
{ scan_next_ch();
return _ASS_TOKEN_; }
else
return _COL_TOKEN_; }
static _TOKEN_ scan_Com()
{ scan_next_ch();
return _COM_TOKEN_; }
static _TOKEN_ scan_Cat()
{ scan_next_ch();
return _CAT_TOKEN_; }
static _TOKEN_ scan_Ltr()
{ scan_name();
return _NAM_TOKEN_; }
/* exported functions */
void _scan_from_text_(const char *start, const char *stop)
{ in_file = 0;
scan_text_index = 0;
in_start = (char *)start;
in_stop = (char *)stop;
in_hold = in_start;
scan_next_ch(); }
void _scan_from_file_(const FILE *file)
{ in_file = (FILE *)file;
scan_text_index = 0;
in_start = 0;
in_stop = 0;
scan_next_ch(); }
_TOKEN_ _scan_()
{ if (scan_ch == EOF)
return _END_TOKEN_;
else
{ scan_fun_index index = scan_char_tab[scan_ch];
if (in_start)
in_hold = in_start;
return (*scan_fun_tab[index])(); }}
long _scan_integer_()
{ return atoi(scan_text); }
double _scan_float_()
{ return atof(scan_text); }
char *_scan_string_()
{ return scan_text; }
void _scan_stop_()
{ in_file = 0;
in_start = 0;
in_stop = 0; }
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* Lab voor Programmeerkunde VUB */
/* ©1995 */
/*-----------------------------------*/
#include "nano.h"
_CNT_ *CNT_stack;
_EXP_ *EXP_stack;
long CNT_tos = -1;
long EXP_tos = 0;
long stack_size = 0;
void _stk_clear_()
{ CNT_tos = -1;
EXP_tos = stack_size; }
void _stk_allocate_(void *storage, unsigned size)
{ CNT_stack = (_CNT_ *)storage;
EXP_stack = (_EXP_ *)storage;
CNT_tos = -1;
stack_size = size / sizeof(_CNT_);
EXP_tos = stack_size; }
#include "nano.h"
#ifdef __WATCOMC__
/* i still didn't find a way to put color on the screen */
void _error_(char *s,...)
{va_list args;
va_start(args,s);
fprintf(stdout,"Error: ");
vfprintf(stdout,s,args);
va_end(args);}
void _warning_(char *s,...)
{va_list args;
va_start(args,s);
fprintf(stdout,"Warning: ");
vfprintf(stdout,s,args);
va_end(args);}
void _write_code_(char *s,...)
{va_list args;
va_start(args,s);
vfprintf(output_file,s,args);
va_end(args);}
void _fatal_(char *s,...)
{va_list args;
va_start(args,s);
vfprintf(stdout,s,args);
va_end(args);
exit(1);}
void _say_(char *s,...)
{va_list args;
va_start(args,s);
vfprintf(stdout,s,args);
va_end(args);}
#else
void _error_(char *s,...)
{
va_list
args;
va_start(args,s);
fprintf(stdout,"\x1b[01;33mError: ");
vfprintf(stdout,s,args);
fprintf(stdout,"\x1B[0m");
va_end(args);
}
void _warning_(char *s,...)
{
va_list args;
va_start(args,s);
fprintf(stdout,"\x1b[01;32mWarning: ");
vfprintf(stdout,s,args);
fprintf(stdout,"\x1B[0m");
va_end(args);
}
void _write_code_(char *s,...)
{
va_list args;
va_start(args,s);
vfprintf(stdout,s,args);
va_end(args);
}
void _fatal_(char *s,...)
{
va_list args;
va_start(args,s);
fprintf(stdout,"\x1b[01;31m","Fatal");
vfprintf(stdout,s,args);
fprintf(stdout,"\x1B[0m");
va_end(args);
exit(1);
}
void _say_(char *s,...)
{
va_list args;
va_start(args,s);
fprintf(stdout,"\x1b[01;21m");
vfprintf(stdout,s,args);
fprintf(stdout,"\x1B[0m");
va_end(args);
}
#endif
#include "nano.h"
void* zmalloc(long size)
{
void *answer;
assert(size);
answer=malloc(size);
if (!answer) _fatal_("Out of memory\n");
return answer;
}
package PicoRuntime;
import java.*;
final public class nat_more extends NativeFunction{
public Object Action()
{
// System.out.print(parameters[0]);
// System.out.print(" > ");
// System.out.println(parameters[1]);
if (((Integer)parameters[0]).intValue()>
((Integer)parameters[1]).intValue()) return Boolean.TRUE;
return Boolean.FALSE;
}};
package PicoRuntime;
import java.*;
final public class nat_less extends NativeFunction{
public Object Action()
{
// System.out.print(parameters[0]);
// System.out.print(" < ");
// System.out.println(parameters[1]);
if (((Integer)parameters[0]).intValue()<
((Integer)parameters[1]).intValue()) return Boolean.TRUE;
return Boolean.FALSE;
}};
package PicoRuntime;
import java.*;
final public class nat_if extends NativeFunction{
public Object NormalCall(Object p[])
{parameters=p;
p[0]=((FunctionObject)(p[0])).Action();
return Action();}
public Object Action()
{if (((Boolean)parameters[0])==Boolean.TRUE)
return ((FunctionObject)(parameters[1])).Action();
else return ((FunctionObject)(parameters[2])).Action();}};
package PicoRuntime;
import java.*;
final public class nat_begin extends NativeFunction{
public Object Action()
{
// System.out.print("Begin(");
// System.out.print(parameters.length);
// System.out.println(")");
return parameters[parameters.length-1];
}
};
package PicoRuntime;
import java.*;
import PicoRuntime.DoorVerwijzing;
// een functie is een classe
// een environment is een instance van deze classe
public abstract class FunctionObject extends BasicFunction {
protected Object Contents[];
protected FunctionObject DefinedIn;
static final protected DoorVerwijzing NotDefined=new DoorVerwijzing(1024,0);
static final private Class DoorVerwijzingClass=NotDefined.getClass();
//deze zal een fout genereren whenever een environment-entry
//nog niet gedefinieert is
public FunctionObject(int size, FunctionObject parentenvironment)
{Contents=new Object[size];
DefinedIn=parentenvironment;}
public FunctionObject() {};
public abstract Object ActionCall(Object parameters[]);
public abstract Object NormalCall(Object parameters[]);
protected abstract Object Action();
abstract protected void SetupFormals();
//deze functie zet de formele parameters goed
protected final Object LookUp(int back, int framenr)
{
// System.out.print("Back = ");
// System.out.print(back);
// System.out.print(", nr = ");
// System.out.print(framenr);
if (back==0)
{Object answer=Contents[framenr];
// System.out.println(".");
if (answer.getClass()==DoorVerwijzingClass)
return DefinedIn.LookUp(((DoorVerwijzing)answer).back,
((DoorVerwijzing)answer).framenr);
return answer;}
// System.out.println("->");
return DefinedIn.LookUp(back-1,framenr);}
public final void Set(int back, int framenr, Object value)
{
// System.out.print("Back
=
");
// System.out.print(back);
// System.out.print(",
nr =
");
// System.out.print(framenr);
if
(back==0)
{Object
answer=Contents[framenr];
//
System.out.print(".\n");
if (answer==null)
System.out.print("uninitialized environment entry.\n");
if
(answer.getClass()==DoorVerwijzingClass)
DefinedIn.Set(((DoorVerwijzing)answer).back,
((DoorVerwijzing)answer).framenr,value);
else Contents[framenr]=value;}
else
{
// System.out.println("->");
DefinedIn.Set(back-1,framenr,value);}}
static final public Object[] newtable(int size, Object exp)
{Object [] result;
result=new Object[size];
int i;
for(i=0;i<size;i++) result[i]=exp;
return result;}
};
package PicoRuntime;
import java.*;
final public class nat_times extends NativeFunction{
public Object Action()
{
return new Integer(
((Integer)parameters[0]).intValue()*
((Integer)parameters[1]).intValue());}};
package PicoRuntime;
import java.*;
public abstract class NativeFunction extends BasicFunction{
protected Object parameters[];
public NativeFunction() {};
public Object NormalCall(Object p[])
{for(int i=0;i<p.length;i++)
p[i]=((FunctionObject)(p[i])).Action();
parameters=p;
return Action();}
public Object ActionCall(Object p[])
{parameters=p;
return Action();}
abstract public Object Action();
};
package PicoRuntime;
import java.*;
final public class nat_until extends NativeFunction{
public Object NormalCall(Object p[])
{parameters=p;
return Action();}
public Object Action()
{
do ((FunctionObject)(parameters[1])).Action();
while (((FunctionObject)(parameters[0])).Action()==Boolean.FALSE);
return null;
}
};
package PicoRuntime;
import java.*;
import PicoRuntime.DoorVerwijzing;
public abstract class BasicFunction extends Object
{public BasicFunction() {};
public abstract Object ActionCall(Object parameters[]);
public abstract Object NormalCall(Object parameters[]);};
package PicoRuntime;
import PicoRuntime.FunctionObject;
// een formele parameter functie heeft een environment die dezelfde is
// als diegene die mij oproept.
public abstract class FormalParam extends FunctionObject {
public FormalParam(FunctionObject parentenvironment)
{Contents=parentenvironment.Contents;
DefinedIn=parentenvironment.DefinedIn;}
public FormalParam() {};
public Object NormalCall(Object parameters[])
{return Action();}
public Object ActionCall(Object parameters[])
{return Action();}
// een formele parameter zet geen andere formele parameters
// meer op...
public void SetupFormals() {};
};
package PicoRuntime;
import java.*;
public abstract class FunctionVastParam extends FunctionObject {
static boolean NoParameters[]=new boolean[0];
protected boolean ParameterTemplate[]=NoParameters;
//indien true moet de functie gedenormalizeerd worden
public FunctionVastParam() {}
public FunctionVastParam(int size, FunctionObject parentenvironment)
{super(size,parentenvironment);}
public Object ActionCall(Object parameters[])
{
//1. een nieuwe instance van
de
klasse genereren
FunctionObject funcinst=(FunctionObject)this.clone();
funcinst.Contents=(Object[])Contents.clone();
//2. de parameters in de nieuwe environment stouwen
for(int i=0;i<ParameterTemplate.length;i++)
funcinst.Contents[i]=parameters[i];
//3. al de lokale variabelen laten doorverwijzen (in 1 gebeurt)
//4. de formele functieparameters alloceren.
funcinst.SetupFormals();
//5. het nieuwe object zijn Action() aanroepen.
return funcinst.Action();
};
public Object NormalCall(Object parameters[])
{
//1. een nieuwe instance van de klasse genereren
FunctionObject funcinst=(FunctionObject)this.clone();
funcinst.Contents=(Object[])Contents.clone();
//2. de parameters juist in deze klasse kopieren
for(int i=0;i<ParameterTemplate.length;i++)
if (ParameterTemplate[i])
funcinst.Contents[i]=((FunctionObject)(parameters[i])).Action();
else funcinst.Contents[i]=parameters[i];
//3. al de lokale variabelen laten doorvberwijzen
//4. al de formele parameters alloceren
funcinst.SetupFormals();
//5. het nieuwe object zijn Action() aanroepen.
return funcinst.Action();
};
};
package PicoRuntime;
import PicoRuntime.FunctionObject;
public abstract class FunctionVarParam extends FunctionObject {
public FunctionVarParam(int size, FunctionObject parentenvironment)
{super(size,parentenvironment);}
public Object ActionCall(Object parameters[])
{
//1. een nieuwe instance van de klasse genereren
FunctionObject funcinst=(FunctionObject)this.clone();
funcinst.Contents=(Object[])Contents.clone();
//2. de parameters in de nieuwe environment stouwen
funcinst.Contents[0]=parameters;
//3. al de lokale variabelen laten doorverwijzen (in 1 gebeurt)
//4. de formele functieparameters alloceren.
funcinst.SetupFormals();
//5. het nieuwe object zijn Action() aanroepen.
return funcinst.Action();}
public Object NormalCall(Object parameters[])
{
//1. een nieuwe instance van de klasse genereren
FunctionObject funcinst=(FunctionObject)this.clone();
funcinst.Contents=(Object[])Contents.clone();
//2. de parameters juist in deze klasse kopieren
for(int i=0;i<parameters.length;i++)
parameters[i]=((FunctionObject)(parameters[i])).Action();
funcinst.Contents[0]=parameters;
//3. al de lokale variabelen laten doorvberwijzen
//4. al de formele parameters alloceren
funcinst.SetupFormals();
//5. het nieuwe object zijn Action() aanroepen.
return funcinst.Action();}
};
package PicoRuntime;
import java.*;
final public class nat_display extends NativeFunction{
private void PrintDeze(Object wie)
{
if (wie==null) return;
if (wie.getClass()==parameters.getClass())
//een array dus
{int i;
System.out.print("[");
for(i=0;i<((Object[])wie).length-1;i++)
{
PrintDeze(((Object[])wie)[i]);
System.out.print(", ");}
PrintDeze(((Object[])wie)[((Object[])wie).length-1]);
System.out.print("]");
return;}
System.out.print(wie);
};
public Object Action()
{
int i;
for(i=0;i<parameters.length;i++)
PrintDeze(parameters[i]);
return null;
}};
package PicoRuntime;
import java.*;
final public class nat_while extends NativeFunction{
public Object NormalCall(Object p[])
{parameters=p;
return Action();}
public Object Action()
{
while (((FunctionObject)(parameters[0])).Action()==Boolean.TRUE)
((FunctionObject)(parameters[1])).Action();
return null;
}
};
package PicoRuntime;
import java.*;
final public class nat_add extends NativeFunction{
public Object Action()
{
// System.out.print(parameters[0]);
// System.out.print(" + ");
// System.out.println(parameters[1]);
return new Integer(
((Integer)parameters[0]).intValue()+
((Integer)parameters[1]).intValue());}};
package PicoRuntime;
import java.*;
final public class nat_div extends NativeFunction{
public Object Action()
{
// System.out.print(parameters[0]);
// System.out.print(" / ");
// System.out.println(parameters[1]);
return new Integer(
((Integer)parameters[0]).intValue()/
((Integer)parameters[1]).intValue());}};
package PicoRuntime;
import java.*;
final public class nat_eq extends NativeFunction{
public Object Action()
{
//System.out.print(parameters[0]);
//System.out.print(" = ");
//System.out.println(parameters[1]);
if (parameters[0].equals(parameters[1])) return Boolean.TRUE;
//System.out.println("FALZEE");
return Boolean.FALSE;}};
package PicoRuntime;
import java.*;
final public class nat_mod extends NativeFunction{
public Object Action()
{
// System.out.print(parameters[0]);
// System.out.print(" % ");
// System.out.println(parameters[1]);
return new Integer(
((Integer)parameters[0]).intValue()%
((Integer)parameters[1]).intValue());}};
package PicoRuntime;
import java.*;
final public class nat_size extends NativeFunction{
public Object Action()
{
// System.out.print("size");
return new Integer(((Object[])(parameters[0])).length);
}};
package PicoRuntime;
import java.*;
public final class DoorVerwijzing extends Object {
public int back;
public int framenr;
public DoorVerwijzing(int b, int f)
{back=b;
framenr=f;}};
package PicoRuntime;
import java.*;
final public class nat_not extends NativeFunction{
public Object Action()
{
// System.out.print("not ");
// System.out.println(parameters[0]);
if (parameters[0]==Boolean.FALSE) return Boolean.TRUE;
return Boolean.FALSE;
}
};
package PicoRuntime;
import java.*;
final public class nat_sub extends NativeFunction{
public Object Action()
{
// System.out.print(parameters[0]);
// System.out.print(" - ");
// System.out.println(parameters[1]);
return new Integer(
((Integer)parameters[0]).intValue()-
((Integer)parameters[1]).intValue());}};