--- /dev/null
+
+/*---------------------------------------------------------------*/
+/*--- ---*/
+/*--- This file (ir_defs.c) is ---*/
+/*--- Copyright (c) 2004 OpenWorks LLP. All rights reserved. ---*/
+/*--- ---*/
+/*---------------------------------------------------------------*/
+
+#include <assert.h>
+
+#include "ir_defs.h"
+
+
+/*---------------------------------------------------------------*/
+/*--- Registering the storage tags ---*/
+/*---------------------------------------------------------------*/
+
+void register_IR_tags ( void )
+{
+ storage_register_tag(IR_TMP, 1, "tmp");
+
+ storage_register_tag(TY_Bit, 0, "Bit");
+ storage_register_tag(TY_I8, 0, "I8");
+ storage_register_tag(TY_I16, 0, "I16");
+ storage_register_tag(TY_I32, 0, "I32");
+ storage_register_tag(TY_I64, 0, "I64");
+
+ storage_register_tag(OP_Add32, 2, "Add32");
+ storage_register_tag(OP_Sub32, 2, "Sub32");
+ storage_register_tag(OP_Mul32, 2, "Mul32");
+ storage_register_tag(OP_Or32, 2, "Or32" );
+ storage_register_tag(OP_And32, 2, "And32");
+ storage_register_tag(OP_Xor32, 2, "Xor32");
+ storage_register_tag(OP_Shl32, 2, "Shl32");
+ storage_register_tag(OP_Shr32, 2, "Shr32");
+ storage_register_tag(OP_Sar32, 2, "Sar32");
+
+ storage_register_tag(OP_Not32, 1, "Not32");
+ storage_register_tag(OP_Neg32, 1, "Neg32");
+
+ storage_register_tag(ST_Put, 3, "ST_Put");
+ storage_register_tag(ST_Tmp, 2, "ST_Tmp");
+ storage_register_tag(ST_STle, 2, "ST_STle");
+
+ storage_register_tag(NX_UJump, 1, "NX_UJump");
+ storage_register_tag(NX_CJump01, 3, "NX_CJump01");
+ storage_register_tag(NX_IJump, 1, "NX_IJump");
+
+ storage_register_tag(EX_Get, 2, "EX_Get");
+ storage_register_tag(EX_Tmp, 1, "EX_Tmp");
+ storage_register_tag(EX_Binop, 3, "EX_Binop");
+ storage_register_tag(EX_Unop, 2, "EX_Unop");
+ storage_register_tag(EX_LDle, 2, "EX_LDle");
+ storage_register_tag(EX_AtomI, 1, "EX_AtomI");
+
+ storage_register_tag(IR_BB, 3, "IR_BB");
+}
+
+
+/*---------------------------------------------------------------*/
+/*--- Printing the IR ---*/
+/*---------------------------------------------------------------*/
+
+void ppGuestAddr ( FILE* f, GuestAddr ga )
+{
+ switch (getTag(ga)) {
+ case TagWord32: fprintf(f, "0x%x", getWord32(ga)); break;
+ case TagWord64: fprintf(f, "0x%llx", getWord64(ga)); break;
+ default: panic("ppGuestAddr");
+ }
+}
+
+void ppIROp ( FILE* f, IROp op )
+{
+ switch (getTag(op)) {
+ case OP_Add32: fprintf(f, "Add32"); break;
+ case OP_Sub32: fprintf(f, "Sub32"); break;
+ case OP_Mul32: fprintf(f, "Mul32"); break;
+ case OP_Or32: fprintf(f, "Or32"); break;
+ case OP_And32: fprintf(f, "And32"); break;
+ case OP_Xor32: fprintf(f, "Xor32"); break;
+ case OP_Shl32: fprintf(f, "Shl32"); break;
+ case OP_Shr32: fprintf(f, "Shr32"); break;
+ case OP_Sar32: fprintf(f, "Sar32"); break;
+ case OP_Not32: fprintf(f, "Not32"); break;
+ case OP_Neg32: fprintf(f, "Neg32"); break;
+ default: panic("ppIROp");
+ }
+}
+
+void ppIRAtomI ( FILE* f, IRAtomI at )
+{
+ switch (getTag(at)) {
+ case TagWord8: fprintf(f, "0x%x", getWord8(at)); break;
+ case TagWord16: fprintf(f, "0x%x", getWord16(at)); break;
+ case TagWord32: fprintf(f, "0x%x", getWord32(at)); break;
+ case TagWord64: fprintf(f, "0x%llx", getWord64(at)); break;
+ default: panic("ppIRAtom");
+ }
+}
+
+void ppIRType ( FILE* f, IRType ty )
+{
+ switch (getTag(ty)) {
+ case TY_Bit: fprintf(f, "Bit"); break;
+ case TY_I8: fprintf(f, "I8"); break;
+ case TY_I16: fprintf(f, "I16"); break;
+ case TY_I32: fprintf(f, "I32"); break;
+ case TY_I64: fprintf(f, "I64"); break;
+ default: panic("ppIRType");
+ }
+}
+
+void ppIRExpr ( FILE* f, IRExpr expr )
+{
+ switch (getTag(expr)) {
+ case EX_Get:
+ fprintf(f, "GET(%d,%d)", sel21(expr), sel22(expr));
+ break;
+ case EX_Tmp:
+ ppIRTemp(f,sel11(expr));
+ break;
+ case EX_Binop:
+ ppIROp(f,sel31(expr));
+ fprintf(f, "(");
+ ppIRExpr(f,sel32(expr));
+ fprintf(f, ",");
+ ppIRExpr(f,sel33(expr));
+ fprintf(f, ")");
+ break;
+ case EX_Unop:
+ ppIROp(f,sel21(expr));
+ fprintf(f, "(");
+ ppIRExpr(f,sel22(expr));
+ fprintf(f, ")");
+ break;
+ case EX_LDle:
+ fprintf(f, "LDle<");
+ ppIRType(f, sel21(expr));
+ fprintf(f,">(");
+ ppIRExpr(f, sel22(expr));
+ fprintf(f,")");
+ break;
+ case EX_AtomI:
+ ppIRAtomI(f, sel11(expr));
+ break;
+ default:
+ panic("ppIExpr");
+ }
+}
+
+void ppIRTemp ( FILE* f, IRTemp tmp )
+{
+ switch (getTag(tmp)) {
+ case IR_TMP: fprintf(f, "t%d", sel11(tmp)); break;
+ default: panic("ppIRTemp");
+ }
+}
+
+void ppIRStmt ( FILE* f, IRStmt stmt )
+{
+ switch (getTag(stmt)) {
+ case ST_Put:
+ fprintf(f, "Put(%d,%d) = ", sel31(stmt), sel32(stmt));
+ ppIRExpr(f, sel33(stmt));
+ break;
+ case ST_Tmp:
+ ppIRTemp(f, sel21(stmt));
+ fprintf(f," = ");
+ ppIRExpr(f, sel22(stmt));
+ break;
+ case ST_STle:
+ fprintf(f, "STle(");
+ ppIRExpr(f, sel21(stmt));
+ fprintf(f, ") = ");
+ ppIRExpr(f, sel22(stmt));
+ break;
+ default:
+ panic("ppIRStmt");
+ }
+}
+
+void ppIRNext ( FILE* f, IRNext next )
+{
+ switch (getTag(next)) {
+ case NX_UJump:
+ fprintf(f, "UJump ");
+ ppGuestAddr(f,sel11(next));
+ break;
+ case NX_CJump01:
+ fprintf(f,"CJump01 (");
+ ppIRExpr(f,sel31(next));
+ fprintf(f, ") ");
+ ppGuestAddr(f,sel32(next));
+ fprintf(f, " ");
+ ppGuestAddr(f,sel33(next));
+ case NX_IJump:
+ fprintf(f, "IJump ");
+ ppIRExpr(f,sel11(next));
+ break;
+ default:
+ panic("ppIRNext");
+ }
+}
+
+void ppIRBB ( FILE* f, IRBB bb )
+{
+ Cell sts;
+ assert(getTag(bb) == IR_BB);
+ for (sts = sel32(bb); nonNil(sts); sts=tail(sts)) {
+ fprintf(f, " ");
+ ppIRStmt(f,head(sts));
+ fprintf(f, "\n");
+ }
+ fprintf(f, " ");
+ ppIRNext(f,sel33(bb));
+ fprintf(f, "\n");
+}
+
+
+/*---------------------------------------------------------------*/
+/*--- Constructors ---*/
+/*---------------------------------------------------------------*/
+
+/* Constructors -- IRBB */
+IRBB mkBB ( AList tys, List stmts, IRNext next ) {
+ return tuple3(IR_BB, tys, stmts, next);
+}
+
+/* Constructors -- IRNext */
+IRNext mkUJump ( GuestAddr dst ) {
+ return tuple1 ( NX_UJump, dst );
+}
+
+/* Constructors -- IRStmt */
+IRStmt mkSTPut ( Int off, Int sz, IRExpr value ) {
+ return tuple3 ( ST_Put, off, sz, value);
+}
+IRStmt mkSTTmp ( IRTemp tmp, IRExpr expr ) {
+ return tuple2 ( ST_Tmp, tmp, expr );
+}
+IRStmt mkSTSTle ( IRExpr addr, IRExpr value ) {
+ return tuple2 ( ST_STle, addr, value );
+}
+
+/* Constructors -- IRExpr */
+IRExpr mkEXGet ( Int off, Int sz ) {
+ return tuple2 ( EX_Get, off, sz );
+}
+IRExpr mkEXTmp ( IRTemp tmp ) {
+ return tuple1 ( EX_Tmp, tmp );
+}
+IRExpr mkEXBinop ( IROp op, IRExpr arg1, IRExpr arg2 ) {
+ return tuple3 ( EX_Binop, op, arg1, arg2 );
+}
+IRExpr mkEXUnop ( IROp op, IRExpr arg ) {
+ return tuple2 ( EX_Unop, op, arg );
+}
+IRExpr mkEXLDle ( IRType ty, IRExpr addr ) {
+ return tuple2 ( EX_LDle, ty, addr );
+}
+IRExpr mkEXAtomI ( IRAtomI atom ) {
+ return tuple1 ( EX_AtomI, atom );
+}
+
+/* Constructors -- IRTemp */
+IRTemp mkIRTemp ( Int n ) {
+ return tuple1 ( IR_TMP, n );
+}
+
+
--- /dev/null
+
+/*---------------------------------------------------------------*/
+/*--- ---*/
+/*--- This file (ir_defs.h) is ---*/
+/*--- Copyright (c) 2004 OpenWorks LLP. All rights reserved. ---*/
+/*--- ---*/
+/*---------------------------------------------------------------*/
+
+#ifndef __IR_DEFS_H
+#define __IR_DEFS_H
+
+#include "storage.h"
+#include <stdio.h>
+
+
+/*---------------------------------------------------------------*/
+/*--- Storage tags for the IR ---*/
+/*---------------------------------------------------------------*/
+
+// Temporaries
+
+#define IR_TMP 80 /* :: Int32# */
+
+
+// Tags for types
+
+#define TY_Bit 100
+#define TY_I8 101
+#define TY_I16 102
+#define TY_I32 103
+#define TY_I64 104
+
+
+// Tags for binary ops
+
+#define OP_Add32 120
+#define OP_Sub32 121
+#define OP_Mul32 122
+#define OP_Or32 123
+#define OP_And32 124
+#define OP_Xor32 125
+#define OP_Shl32 126
+#define OP_Shr32 127
+#define OP_Sar32 128
+
+
+// Tags for unary ops
+
+#define OP_Not32 150
+#define OP_Neg32 151
+
+
+/* Statements:
+
+data Stmt
+ = PUT Int Int Expr -- offset, size, value
+ | TMP Temp Expr -- store value in Temp
+ | STle Expr Expr -- address (32 or 64 bit), value
+*/
+#define ST_Put 160
+#define ST_Tmp 161
+#define ST_STle 162
+
+
+/* Basic block enders.
+ HAddr is intended to represent a guest address, which is either a
+ 32 or 64 bit integer, depending on the architecture we're simulating.
+
+data Next
+ = UJump HAddr -- unconditional jump
+ | CJump01 Expr HAddr HAddr -- conditional jump, Expr::TY_Bit
+ | IJump Expr -- jump to unknown address
+*/
+#define NX_UJump 170
+#define NX_CJump01 171
+#define NX_IJump 172
+
+
+/* Expressions
+
+data Expr
+ = GET Int Int -- offset, size
+ | TMP Temp -- value of temporary
+ | BINOP Op Expr Expr -- binary op
+ | UNOP Op Expr -- unary op
+ | LDle Type Expr -- load of the given type, Expr:: 32 or 64
+ | ATOMI Atom -- 8/16/32/64-bit int constant
+*/
+#define EX_Get 180
+#define EX_Tmp 181
+#define EX_Binop 182
+#define EX_Unop 183
+#define EX_LDle 184
+#define EX_AtomI 185
+
+
+/* Basic blocks contain 3 fields:
+ - An association list, giving a type for each temp
+ - A list of statements
+ - A Next
+*/
+#define IR_BB 190 /* arity = 3 */
+
+
+/*---------------------------------------------------------------*/
+/*--- Types for the IR ---*/
+/*---------------------------------------------------------------*/
+
+typedef Cell IRBB;
+typedef Cell IRStmt;
+typedef Cell IRExpr;
+typedef Cell IRNext;
+typedef Cell IRTemp;
+typedef Cell IRType;
+typedef Cell IROp;
+typedef Cell IRAtomI;
+typedef Cell GuestAddr; /* Word32 or Word64 */
+
+
+/*---------------------------------------------------------------*/
+/*--- Basic functions for the IR ---*/
+/*---------------------------------------------------------------*/
+
+/* Call this before using any of the IR tags or constructors. */
+extern void register_IR_tags ( void );
+
+/* Printers ... */
+extern void ppIRBB ( FILE* f, IRBB );
+extern void ppIRNext ( FILE* f, IRNext );
+extern void ppIRStmt ( FILE* f, IRStmt );
+extern void ppIRExpr ( FILE* f, IRExpr );
+extern void ppIRTemp ( FILE* f, IRTemp );
+extern void ppIRType ( FILE* f, IRType );
+extern void ppIRAtomI ( FILE* f, IRAtomI );
+extern void ppIROp ( FILE* f, IROp );
+extern void ppGuestAddr ( FILE* f, GuestAddr );
+
+/* Constructors -- IRBB */
+extern IRBB mkBB ( AList tys, List stmts, IRNext next );
+
+/* Constructors -- IRNext */
+extern IRNext mkUJump ( GuestAddr dst );
+
+/* Constructors -- IRStmt */
+extern IRStmt mkSTPut ( Int off, Int sz, IRExpr value );
+extern IRStmt mkSTTmp ( IRTemp tmp, IRExpr expr );
+extern IRStmt mkSTSTle ( IRExpr addr, IRExpr value );
+
+/* Constructors -- IRExpr */
+extern IRExpr mkEXGet ( Int off, Int sz );
+extern IRExpr mkEXTmp ( IRTemp tmp );
+extern IRExpr mkEXBinop ( IROp op, IRExpr arg1, IRExpr arg2 );
+extern IRExpr mkEXUnop ( IROp op, IRExpr arg );
+extern IRExpr mkEXLDle ( IRType ty, IRExpr addr );
+extern IRExpr mkEXAtomI ( IRAtomI atom );
+
+/* Constructors -- IRTemp */
+extern IRTemp mkIRTemp ( Int n );
+
+/* Constructors -- IRType */
+/* Constructors -- IRAtomI */
+/* Constructors -- IROp */
+
+
+#endif /* ndef __IR_DEFS_H */
--- /dev/null
+
+/*---------------------------------------------------------------*/
+/*--- ---*/
+/*--- This file (main.c) is ---*/
+/*--- Copyright (c) 2004 OpenWorks LLP. All rights reserved. ---*/
+/*--- ---*/
+/*---------------------------------------------------------------*/
+
+#include <stdio.h>
+
+#include <stdlib.h>
+#include <assert.h>
+
+#include "storage.h"
+#include "ir_defs.h"
+
+
+
+
+
+/*---------------------------------------------------------------*/
+/*--- Test ---*/
+/*---------------------------------------------------------------*/
+
+int main ( void )
+{
+ Cell bb;
+ Cell stmts;
+
+ storage_init();
+ register_IR_tags();
+
+ stmts = cons( mkSTPut(8,4, mkEXAtomI(mkWord32(99))),
+ cons( mkSTPut(7,3, mkEXTmp(mkIRTemp(55))),
+ NIL ));
+
+ bb = mkBB(NIL, stmts, mkUJump(mkWord32(65565)));
+ ppIRBB(stdout, bb);
+
+ storage_done();
+
+ return 0;
+}
+
+
+
--- /dev/null
+
+/*---------------------------------------------------------------*/
+/*--- ---*/
+/*--- This file (storage.c) is ---*/
+/*--- Copyright (c) 2004 OpenWorks LLP. All rights reserved. ---*/
+/*--- ---*/
+/*---------------------------------------------------------------*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+#include "storage.h"
+#include "storage_private.h"
+
+
+static Cell heap[N_HEAP_CELLS];
+static Int heap_used = 1; /* cell==0 is not allowed */
+
+static Char* tag_name[N_TAGS];
+static UChar tag_arity[N_TAGS]; /* 0xFF indicates unregistered. */
+
+static Bool init_done = False;
+
+#define IS_VALID_CELL(cc) ((cc) < 0 && (cc) > -heap_used)
+#define IS_VALID_TAG(tt) ((tt) > 0 && (tt) < N_TAGS)
+
+
+void panic ( Char* who )
+{
+ fprintf(stderr, "panic: %s\n", who);
+ exit(1);
+}
+
+
+/* Initialise the storage subsystem. */
+void storage_init ( void )
+{
+ Int i;
+ assert(!init_done);
+ init_done = True;
+ for (i = 0; i < N_TAGS; i++) {
+ tag_name[i] = NULL;
+ tag_arity[i] = 0xFF; /* unregistered */
+ }
+ heap_used = 1;
+ storage_register_tag ( TagCONS, 2, "cons" );
+ storage_register_tag ( TagPAIR, 2, "pair" );
+ storage_register_tag ( TagTRIPLE, 3, "triple" );
+ storage_register_tag ( TagWord8, 1, "word8" );
+ storage_register_tag ( TagWord16, 1, "word16" );
+ storage_register_tag ( TagWord32, 1, "word32" );
+ storage_register_tag ( TagWord64, 1, "word64" );
+}
+
+void storage_done ( void )
+{
+ printf ("storage_done: used %d cells\n", heap_used-1 );
+}
+
+void storage_register_tag ( Tag tag, Int arity, Char* name )
+{
+ assert(init_done);
+ assert(IS_VALID_TAG(tag));
+ assert(tag_arity[tag] == 0xFF); /* check not already registered */
+ assert(name != NULL);
+ assert(arity >= 0 && arity <= 5);
+ tag_name[tag] = name;
+ tag_arity[tag] = arity;
+}
+
+
+Tag getTag ( Cell c )
+{
+ Tag t;
+ assert(IS_VALID_CELL(c));
+ t = heap[-c];
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] != 0xFF);
+ return t;
+}
+
+/* ------------------ Construct/query for Size = 0 --------------------- */
+
+Cell tuple0 ( Tag t )
+{
+ assert(init_done);
+ assert(heap_used <= N_HEAP_CELLS-1);
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 0);
+ heap[heap_used] = t;
+ heap_used += 1;
+ return -(heap_used - 1);
+}
+
+
+/* ------------------ Construct/query for Size = 1 --------------------- */
+
+Cell tuple1 ( Tag t, Cell x )
+{
+ assert(init_done);
+ assert(heap_used <= N_HEAP_CELLS-2);
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 1);
+ heap[heap_used] = t;
+ heap[heap_used+1] = x;
+ heap_used += 2;
+ return -(heap_used - 2);
+}
+
+Cell sel11 ( Cell tup )
+{
+ Tag t;
+ assert(IS_VALID_CELL(tup));
+ t = heap[-tup];
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 1);
+ return heap[-tup+1];
+}
+
+/* ------------------ Construct/query for Size = 2 --------------------- */
+
+Cell tuple2 ( Tag t, Cell x, Cell y )
+{
+ assert(init_done);
+ assert(heap_used <= N_HEAP_CELLS-3);
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 2);
+ heap[heap_used] = t;
+ heap[heap_used+1] = x;
+ heap[heap_used+2] = y;
+ heap_used += 3;
+ return -(heap_used - 3);
+}
+
+Cell sel21 ( Cell tup )
+{
+ Tag t;
+ assert(IS_VALID_CELL(tup));
+ t = heap[-tup];
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 2);
+ return heap[-tup+1];
+}
+
+Cell sel22 ( Cell tup )
+{
+ Tag t;
+ assert(IS_VALID_CELL(tup));
+ t = heap[-tup];
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 2);
+ return heap[-tup+2];
+}
+
+
+/* ------------------ Construct/query for Size = 3 --------------------- */
+
+Cell tuple3 ( Tag t, Cell x, Cell y, Cell z )
+{
+ assert(init_done);
+ assert(heap_used <= N_HEAP_CELLS-4);
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 3);
+ heap[heap_used] = t;
+ heap[heap_used+1] = x;
+ heap[heap_used+2] = y;
+ heap[heap_used+3] = z;
+ heap_used += 4;
+ return -(heap_used - 4);
+}
+
+Cell sel31 ( Cell tup )
+{
+ Tag t;
+ assert(IS_VALID_CELL(tup));
+ t = heap[-tup];
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 3);
+ return heap[-tup+1];
+}
+
+Cell sel32 ( Cell tup )
+{
+ Tag t;
+ assert(IS_VALID_CELL(tup));
+ t = heap[-tup];
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 3);
+ return heap[-tup+2];
+}
+
+Cell sel33 ( Cell tup )
+{
+ Tag t;
+ assert(IS_VALID_CELL(tup));
+ t = heap[-tup];
+ assert(IS_VALID_TAG(t));
+ assert(tag_arity[t] == 3);
+ return heap[-tup+3];
+}
+
+
+/* ------------------ Helpers for lists --------------------- */
+
+Cell cons ( Cell hd, Cell tl )
+{
+ return tuple2(TagCONS, hd, tl);
+}
+
+Cell head ( Cell list )
+{
+ if (isNil(list)) panic("head(NIL)");
+ if (getTag(list) != TagCONS) panic("head(not-a-list)");
+ return sel21(list);
+}
+
+Cell tail ( Cell list )
+{
+ if (isNil(list)) panic("tail(NIL)");
+ if (getTag(list) != TagCONS) panic("tail(not-a-list)");
+ return sel22(list);
+}
+
+
+/* ------------------ Helpers for Word* --------------------- */
+
+Cell mkWord8 ( UInt w8 )
+{
+ return tuple1 ( TagWord8, w8 & 0xFF );
+}
+
+Cell mkWord16 ( UInt w16 )
+{
+ return tuple1 ( TagWord16, w16 & 0xFFFF );
+}
+
+Cell mkWord32 ( UInt w32 )
+{
+ return tuple1 ( TagWord32, w32 );
+}
+
+Cell mkWord64 ( ULong w64 )
+{
+ UInt hi = (UInt)(w64 >> 32);
+ UInt lo = (UInt)(w64 & 0x00000000FFFFFFFFLL);
+ return tuple2 ( TagWord64, hi, lo );
+}
+
+UInt getWord8 ( Cell c )
+{
+ assert(getTag(c) == TagWord8 );
+ return sel11(c);
+}
+
+UInt getWord16 ( Cell c )
+{
+ assert(getTag(c) == TagWord16 );
+ return sel11(c);
+}
+
+UInt getWord32 ( Cell c )
+{
+ assert(getTag(c) == TagWord32 );
+ return sel11(c);
+}
+
+ULong getWord64 ( Cell c )
+{
+ UInt hi, lo;
+ assert(getTag(c) == TagWord64 );
+ hi = (UInt)sel21(c);
+ lo = (UInt)sel22(c);
+ return (((ULong)hi) << 32) | ((ULong)lo);
+}
+
--- /dev/null
+
+/*---------------------------------------------------------------*/
+/*--- ---*/
+/*--- This file (storage.h) is ---*/
+/*--- Copyright (c) 2004 OpenWorks LLP. All rights reserved. ---*/
+/*--- ---*/
+/*---------------------------------------------------------------*/
+
+#ifndef __STORAGE_H
+#define __STORAGE_H
+
+/* Public header file for heap storage. */
+
+/* Address ranges:
+ -(N_HEAP_CELLS-1) .. -1 pointers into the heap
+ 0 NIL
+ 1 .. N_TAGS-1 tags
+ All tags must be registered (register_tag) before use.
+ Heap cell 0 is never used. Tag 0 is never used.
+ (0 means NIL).
+*/
+
+#include "basictypes.h"
+
+extern void panic ( Char* );
+
+typedef Int Cell;
+typedef Int Tag;
+
+/* Here are some common-use tags. */
+#define TagCONS 1 /* arity 2 */
+#define TagPAIR 2 /* arity 2 */
+#define TagTRIPLE 3 /* arity 3 */
+#define TagWord8 4 /* arity 1 */
+#define TagWord16 5 /* arity 1 */
+#define TagWord32 6 /* arity 1 */
+#define TagWord64 7 /* arity 2 */
+
+
+/* First you must initialise the storage subsystem. This also
+ initialises the "common use" tags. */
+extern void storage_init ( void );
+
+/* Shut down (print stats) */
+extern void storage_done ( void );
+
+/* Then you need to register some tags. */
+extern void storage_register_tag ( Tag tag, Int arity, Char* name );
+
+/* Now you can build closures using the tags you registered ..
+ and take them apart again.
+*/
+extern Cell tuple1 ( Tag, Cell );
+extern Cell sel11 ( Cell );
+
+extern Cell tuple2 ( Tag, Cell, Cell );
+extern Cell sel21 ( Cell );
+extern Cell sel22 ( Cell );
+
+extern Cell tuple3 ( Tag, Cell, Cell, Cell );
+extern Cell sel31 ( Cell );
+extern Cell sel32 ( Cell );
+extern Cell sel33 ( Cell );
+
+
+/* Get the tag of a closure. This must be given a reference to
+ a closure header. */
+extern Tag getTag ( Cell );
+
+/* NILness */
+#define NIL ((Cell)0)
+#define isNil(cell) ((cell)==NIL)
+#define nonNil(cell) (!(isNil(cell)))
+
+/* Various helpful things to do with lists */
+typedef Cell List;
+extern List cons ( Cell, List );
+extern List head ( List );
+extern Cell tail ( List );
+
+/* Give a name for association lists (a list of pairs). */
+typedef Cell AList;
+
+/* To do with the Word* types. */
+extern Cell mkWord8 ( UInt );
+extern Cell mkWord16 ( UInt );
+extern Cell mkWord32 ( UInt );
+extern Cell mkWord64 ( ULong );
+
+extern UInt getWord8 ( Cell );
+extern UInt getWord16 ( Cell );
+extern UInt getWord32 ( Cell );
+extern ULong getWord64 ( Cell );
+
+
+#endif /* ndef __STORAGE_H */
--- /dev/null
+
+/*---------------------------------------------------------------*/
+/*--- ---*/
+/*--- This file (storage_private.h) is ---*/
+/*--- Copyright (c) 2004 OpenWorks LLP. All rights reserved. ---*/
+/*--- ---*/
+/*---------------------------------------------------------------*/
+
+/* Total size of the heap */
+#define N_HEAP_CELLS 10000
+
+/* The number of tags that may be registered. */
+#define N_TAGS 500