+++ /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 */
projects / thirdparty / valgrind.git / commitdiff
