]> git.ipfire.org Git - thirdparty/valgrind.git/commitdiff
Add new files, for defining the IR.
authorJulian Seward <jseward@acm.org>
Sun, 20 Jun 2004 12:26:53 +0000 (12:26 +0000)
committerJulian Seward <jseward@acm.org>
Sun, 20 Jun 2004 12:26:53 +0000 (12:26 +0000)
git-svn-id: svn://svn.valgrind.org/vex/trunk@14

VEX/backend/ir_defs.c [new file with mode: 0644]
VEX/backend/ir_defs.h [new file with mode: 0644]
VEX/backend/main.c [new file with mode: 0644]
VEX/backend/storage.c [new file with mode: 0644]
VEX/backend/storage.h [new file with mode: 0644]
VEX/backend/storage_private.h [new file with mode: 0644]

diff --git a/VEX/backend/ir_defs.c b/VEX/backend/ir_defs.c
new file mode 100644 (file)
index 0000000..35198bd
--- /dev/null
@@ -0,0 +1,271 @@
+
+/*---------------------------------------------------------------*/
+/*---                                                         ---*/
+/*--- 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 );
+}
+
+
diff --git a/VEX/backend/ir_defs.h b/VEX/backend/ir_defs.h
new file mode 100644 (file)
index 0000000..b8177ea
--- /dev/null
@@ -0,0 +1,165 @@
+
+/*---------------------------------------------------------------*/
+/*---                                                         ---*/
+/*--- 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 */
diff --git a/VEX/backend/main.c b/VEX/backend/main.c
new file mode 100644 (file)
index 0000000..353c26d
--- /dev/null
@@ -0,0 +1,46 @@
+
+/*---------------------------------------------------------------*/
+/*---                                                         ---*/
+/*--- 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;
+}
+
+
+
diff --git a/VEX/backend/storage.c b/VEX/backend/storage.c
new file mode 100644 (file)
index 0000000..f6a5919
--- /dev/null
@@ -0,0 +1,275 @@
+
+/*---------------------------------------------------------------*/
+/*---                                                         ---*/
+/*--- 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);
+}
+
diff --git a/VEX/backend/storage.h b/VEX/backend/storage.h
new file mode 100644 (file)
index 0000000..abbbe2d
--- /dev/null
@@ -0,0 +1,96 @@
+
+/*---------------------------------------------------------------*/
+/*---                                                         ---*/
+/*--- 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 */
diff --git a/VEX/backend/storage_private.h b/VEX/backend/storage_private.h
new file mode 100644 (file)
index 0000000..af6257b
--- /dev/null
@@ -0,0 +1,13 @@
+
+/*---------------------------------------------------------------*/
+/*---                                                         ---*/
+/*--- 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