/*$Header: /a/rathlin/disk/src/master/edml/EDML4/fam.src/UPTODATE/RCS/structs.h,v 5.1 91/09/05 18:24:53 edml Exp $*/
/*$Log:	structs.h,v $
 * Revision 5.1  91/09/05  18:24:53  edml
 * Version 4.2 of EdML
 * This version does not yet work on machines with large pointers
 * (e.g. DECmips / SGI) - conficts between ASSIGNED/ZERO/MARKBIT macros
 * 
 * Revision 4.2  90/02/05  12:01:09  rjg
 * Exception traceback, reraise bytecode, UPRecN objects for arrays
 * 
 * Revision 4.0  89/09/20  13:33:36  rjg
 * incorporated RCS
 * */
#include "store.h"

/*  Abstract Machine data types */

/* Data types beginning with the prefix AM are real types within the
 * abstract machine.  The user may have different views of the same
 * type.  For example, the abstract machine has a type called AMRec2,
 * i.e. a record with two fields.  The user may wish to view this as a
 * pair (by using Pair) or a list cell (by using Cons).
 *
 * The following table shows the correspondence between AM and user types.
 *
 *    State          AMState
 *    Process        AMProcess
 *    Ref            AMRec1
 *    Rec1           AMRec1
 *    Cons           AMRec2
 *    Pair           AMRec2
 *    Rec2           AMRec2
 *    Array          AMUpRecN
 *    Literal        AMRecN
 *    Closure        AMRecN
 *    RecN           AMRecN
 *    Text           AMText
 *    String         AMString
 *    Int            AMString
 *    Variant        AMVariant
 *    BigVar         AMBigVar
 *    Stack          AMStack
 *    Exception      AMRec1(AMString)
 *    InputStream    AMRecN
 *
 * Obviously care has to be taken to keep the AM and user types consistent.
 * Furthermore, the State and Process types are reflected into the
 * user environment as record structures and so the order of their fields is
 * constrained by the way in which the user processes record fields.
 * RJG changes for BigVar 03-Feb-89
 */

#define AllRef_(new,at)  {AllUpRec1_(new,at);}

typedef struct Ref {
   LWord  at;
} Ref;


#define fst_(x) (((Pair *)x) -> fst)
#define snd_(x) (((Pair *)x) -> snd)

#define AllPair_(new,fst,snd) {AllRec2_(new,fst,snd);}

typedef struct Pair {
   LWord  fst, snd;
} Pair;

#define hd_(x) (((Cons *)x) -> hd)
#define tl_(x) (((Cons *)x) -> tl)

#define AllCons_(new,hd,tl) {AllRec2_(new,hd,tl);}

typedef struct Cons {
   LWord  hd;
   struct Cons *tl;
} Cons;


#define rec_(a)      ((LWord *)(&(((RecN *)(a)) -> firstfield)))
#define array_(a)    ((LWord *)(&(((Array *)(a)) -> firstfield)))
#define literal_(a)  ((LWord *)(&(((Literals *)(a)) -> firstfield)))
#define global_(a)   ((LWord *)(&(((Closure *)(a)) -> firstglobal)))

#define arraylength_(a) PreField_(a)
#define recordlength_(a) PreField_(a)
#define literalslength_(a) PreField_(a)

#define AllRec1_(new,arg) {AllAMRec1_(arg);}
#define AllUpRec1_(new,arg) {AllAMUpRec1_(arg);}
#define AllRec2_(new,arg1, arg2) {AllAMRec2_(arg1, arg2);}
#define AllRecN_(new,size) {AllAMRecN_(size);}
#define AllUpRecN_(new,size) {AllAMUpRecN_(size);}


typedef struct RecN {
    LWord *firstfield;
} RecN;

#define AllArray_(new,size) {AllUpRecN_(new,size);}

typedef struct Array {
    LWord *firstfield;
} Array;

typedef struct Literals {
    LWord *firstfield;
} Literals;

#define bytecode_(a) ((Byte  *)(&(((Text *)(a)) -> firstbyte)))
#define bytecodelength_(a) PreField_(a)

#define AllText_(new,size) {AllAMText_(size);}


typedef struct Text {
    Literals *literals;
#ifdef NOSHORTS
   unsigned ProfileVal: 16, PhiBC: 16;
#else
   SWord      ProfileVal;
   Word      PhiBC;
#endif
    Byte       firstbyte;
    /* other bytes may follow at this point */
} Text;



#define AllClosure_(new,size) {AllRecN_(new,size);} /* (AJGHACK) */
/* #define AllClosure_(new,size) {AllUpRecN_(new,size);} */


typedef struct Closure {
    Text *text;
    LWord  *firstglobal; /* This field is optional */
   /* and other globals may follow at this point   */
} Closure;


#define stringlength_(a) PreField_(a)
#define stringchar_(a)   ((char *)(&(((String *)(a)) -> firstchar)))
#define numseg_(a)    ((LWord *)(&(((Int *)(a)) -> firstnumseg)))
#define real_(a)      (((Real *)(a)) -> realval)
#define AllString_(new,size) {AllAMString_(size);}

typedef struct String {
   char  firstchar;
   /* other characters may follow at this point   */
} String;

#define AllInputStream_(new) {AllAMRecN_(5);}

typedef struct InputStream {
    LWord      fid;
    LWord      *next;
    LWord      len;
    LWord      pos;
    String     *buffer;
} InputStream;

typedef struct Int {
   LWord  firstnumseg;
   /* other segments may follow at this point   */
} Int;

#define AllReal_(new,val) {AllAMReal_(val);}

typedef struct Real {
   double realval;
} Real;


#define varianttype_(a) PreField_(a)
#define AllVar_(new,arg,typ) {AllAMVar_(arg,typ);}

typedef struct Variant {
   LWord  field;
} Variant;

/* RJG 03-Feb-89
 * added BigVar - note that prefield is not used
 */
#define bigvartype_(a) ((AMBigVar *) a)->typ
#define AllBigVar_(new,arg,typ,str) {AllAMBigVar_(arg,typ,str);}

typedef struct BigVar {
   LWord  xconname;
   LWord  typ;
   LWord  field;
} BigVar;


typedef struct Exception {
   String *excstring;
   LWord typ;
} Exception;

#define AllStack_(new,size) {AllAMStack_(size);}

typedef struct Stack {
   LWord   StkPos;      /* Offset of stack bottom from beginning in bytes */
   LWord   TrapPos;     /* for saving TrapTop offset in bytes during GC */
   /*   Rest of stack follows here */
} Stack;

typedef Exception *ExcPtr;
typedef ExcPtr ExcVec[999];

#define AllProcess_(new) {AllAMProcess_;}

typedef struct Process {
   struct  Process *Next;       /* Next to be scheduled (or 0)      */
   Stack   *ArgStk;             /* Arg Stack                        */
   Stack   *CtlStk;             /* Control Stack                    */
   LWord   CtrlCEnabled;
   Pair    *EnvDead;            /* Environment (No longer used)     */
   struct  Process *Father;     /* Father process (for returning to)*/
   Closure *Frame;              /* Current Frame                    */
   struct  Process *WaitingFor; /* Set to process I am waiting for  */

   LWord   Flags;               /* Process flags                    */
   LWord   NumSons;             /* Number of spawned sons           */
   LWord   PC;                  /* PC Offset                        */
} Process;

#define Process_Terminated     0x1
#define Process_Active         0x2
#define Process_Suspended      0x4
#define Process_WaitingForSon  0x8
#define Process_WaitingForSons 0x10

#define AllState_(new) {AllAMState_;}

typedef struct State {
   Cons    *ActiveStreams;      /* List of currently open streams   */
   ExcVec  *BuiltInExceptions;  /* Tuple of machine-raised excepts  */
   Ref     *CompactGC;          /* GC algorithm selection flag      */
   Ref     *ProfRef;            /* [AJG] Profiling (list of) texts  */
   String  *EmptyString;        /* Constant zero length string      */
   Text    *FunCompText;        /* Function composition text        */
   Closure *FunIdClosure;       /* Function identity closure        */
   Ref     *GCMsgs;             /* GC printing flag                 */
   Closure *StartupClosure;     /* Initial startup closure (obs?)   */
   InputStream  *StdErr,        /* Standard error                   */
                *StdIn,         /* Standard input                   */
                *StdOut;        /* Standard output                  */
   struct  Process *SuspendedProcesses; /* Suspended queue          */
   struct  Process *WaitingProcesses;   /* Scheduling queue         */
   struct  Process *WaitingLastProc;    /* Last in scheduling queue */
   Text    *XConText;        /* Function composition text        */
} State;


#define new_cons ((Cons *)tmpreg)
#define new_pair ((Pair *)tmpreg)
#define new_ref  ((Ref *)tmpreg)
#define new_proc ((Process *)tmpreg)
#define new_state ((State *)tmpreg)
#define new_recN ((RecN *)tmpreg)
#define new_array ((Array *)tmpreg)
#define new_string ((String *)tmpreg)
#define new_instr ((InputStream *)tmpreg)
#define new_text ((Text *)tmpreg)
#define new_stack ((Stack *)tmpreg)
#define new_real ((Real *)tmpreg)
#define new_clos ((Closure *)tmpreg)
#define new_var ((Variant *)tmpreg)
#define new_bigvar ((BigVar *)tmpreg)
