Added left/right shifts (and a load of gc stuff as placeholders...)

Ignore-this: 7f7ea9c4cd36945689f8188ec528c0cb

darcs-hash:20100226173825-6ac22-bb83c19921e8958ad10286c888569e69f6a6a0ee.gz

Epic/CodegenC.lhs

@@ -290,6 +290,8 @@
 > doOp t Minus l r = tmp t ++ " = INTOP(-,"++tmp l ++ ", "++tmp r++");"
 > doOp t Times l r = tmp t ++ " = MULT("++tmp l ++ ", "++tmp r++");"
 > doOp t Divide l r = tmp t ++ " = INTOP(/,"++tmp l ++ ", "++tmp r++");"
+> doOp t ShL l r = tmp t ++ " = INTOP(<<,"++tmp l ++ ", "++tmp r++");"
+> doOp t ShR l r = tmp t ++ " = INTOP(>>,"++tmp l ++ ", "++tmp r++");"
 > doOp t OpEQ l r = tmp t ++ " = INTOP(==,"++tmp l ++ ", "++tmp r++");"
 > doOp t OpGT l r = tmp t ++ " = INTOP(>,"++tmp l ++ ", "++tmp r++");"
 > doOp t OpLT l r = tmp t ++ " = INTOP(<,"++tmp l ++ ", "++tmp r++");"

Epic/Language.lhs

@@ -111,6 +111,7 @@ Get the arity of a definition in the context
 >    compare _ _ = EQ
 
 > data Op = Plus | Minus | Times | Divide | OpEQ | OpLT | OpLE | OpGT | OpGE
+>         | ShL  | ShR
 >   deriving (Show, Eq)
 
 > instance Show CaseAlt where

Epic/Lexer.lhs

@@ -84,6 +84,8 @@
 >       | TokenLE
 >       | TokenGT
 >       | TokenLT
+>       | TokenShL
+>       | TokenShR
 >       | TokenArrow
 >       | TokenColon
 >       | TokenUnit
@@ -141,6 +143,8 @@
 > lexer cont ('=':'=':cs) = cont TokenEQ cs
 > lexer cont ('>':'=':cs) = cont TokenGE cs
 > lexer cont ('<':'=':cs) = cont TokenLE cs
+> lexer cont ('<':'<':cs) = cont TokenShL cs
+> lexer cont ('>':'>':cs) = cont TokenShR cs
 > lexer cont ('>':cs) = cont TokenGT cs
 > lexer cont ('<':cs) = cont TokenLT cs
 > lexer cont ('=':cs) = cont TokenEquals cs

Epic/Parser.y

@@ -71,6 +71,8 @@ import Epic.Lexer
       eq              { TokenEQ }
       le              { TokenLE }
       ge              { TokenGE }
+      shl             { TokenShL }
+      shr             { TokenShR }
       '<'             { TokenLT }
       '>'             { TokenGT }
       ':'             { TokenColon }
@@ -93,6 +95,7 @@ import Epic.Lexer
 %left eq
 %left ';'
 %left '<' '>' le ge
+%left shl shr
 %left '+' '-'
 %left '*' '/'
 %left NEG
@@ -196,6 +199,8 @@ MathExpr : Expr '+' Expr { Op Plus $1 $3 }
          | '-' Expr %prec NEG { Op Minus (Const (MkInt 0)) $2 }
          | Expr '*' Expr { Op Times $1 $3 }
          | Expr '/' Expr { Op Divide $1 $3 }
+         | Expr shl Expr { Op ShL $1 $3 }
+         | Expr shr Expr { Op ShR $1 $3 }
          | Expr '<' Expr { Op OpLT $1 $3 }
          | Expr '>' Expr { Op OpGT $1 $3 }
          | Expr le Expr { Op OpLE $1 $3 }

epic.cabal

@@ -1,5 +1,5 @@
 Name:		epic
-Version:	0.1.4
+Version:	0.1.5
 Author:		Edwin Brady
 License:	BSD3
 License-file:	LICENSE
@@ -16,8 +16,8 @@ Description:    Epic is a simple functional language which compiles to
                 (<http://www.cs.st-and.ac.uk/~eb/Idris>).
 	        It can be invoked either as a library or an application.
 
-Data-files:    evm/libevm.a evm/closure.h evm/stdfuns.h evm/stdfuns.c evm/mainprog.c 
-Extra-source-files: evm/closure.c evm/closure.h evm/stdfuns.h evm/mainprog.c evm/stdfuns.c evm/Makefile 
+Data-files:    evm/libevm.a evm/closure.h evm/stdfuns.h evm/emalloc.h evm/stdfuns.c evm/mainprog.c 
+Extra-source-files: evm/closure.c evm/closure.h evm/stdfuns.h evm/mainprog.c evm/stdfuns.c evm/emalloc.h evm/emalloc.c evm/Makefile 
 
 Cabal-Version:  >= 1.2.3
 Build-type:     Custom

evm/Makefile

@@ -1,11 +1,11 @@
 CC = gcc
 #CFLAGS = -Wall -g
 CFLAGS = -Wall -O3
-OBJS = closure.o stdfuns.o
+OBJS = closure.o stdfuns.o emalloc.o
 INSTALLDIR = ${PREFIX}/lib/evm
 
 TARGET = libevm.a
-INSTALLHDRS = closure.h stdfuns.h mainprog.c
+INSTALLHDRS = closure.h stdfuns.h emalloc.h mainprog.c
 
 ${TARGET} : ${OBJS}
 	ar r ${TARGET} ${OBJS}

evm/closure.c

@@ -7,16 +7,16 @@
 
 VAL one;
 VAL* zcon;
-void* blob = NULL;
-int blobnext = 0;
+//void* blob = NULL;
+//int blobnext = 0;
 
-void* FASTMALLOC(int size) {
+/*void* FASTMALLOC(int size) {
     if (blob == NULL) { blob = malloc(10001000); }
     void* newblock = blob+blobnext;
     blobnext+=((size+4) & 0xfffffffc);
     if (blobnext>10000000) blobnext=0;
     return newblock;
-}
+    }*/
 
 void dumpClosureA(Closure* c, int rec);
 
@@ -113,6 +113,7 @@ inline VAL CLOSURE(func x, int arity, int args, void** block)
 
     SETTY(c, FUN);
     c->info = (void*)fn;
+    EREADY(c);
     return c;
 }
 
@@ -129,6 +130,7 @@ inline VAL CONSTRUCTORn(int tag, int arity, void** block)
     }
     SETTY(c, CON);
     c->info = (void*)cn;
+    EREADY(c);
     return c;
 }
 
@@ -141,6 +143,7 @@ inline VAL CONSTRUCTOR1(int tag, VAL a1)
     cn->args[0] = a1;
     SETTY(c,CON);
     c->info = (void*)cn;
+    EREADY(c);
     return c;
 }
 
@@ -154,6 +157,7 @@ inline VAL CONSTRUCTOR2(int tag, VAL a1, VAL a2)
     cn->args[1] = a2;
     SETTY(c,CON);
     c->info = (void*)cn;
+    EREADY(c);
     return c;
 }
 
@@ -168,6 +172,7 @@ inline VAL CONSTRUCTOR3(int tag, VAL a1, VAL a2, VAL a3)
     cn->args[2] = a3;
     SETTY(c,CON);
     c->info = (void*)cn;
+    EREADY(c);
     return c;
 }
 
@@ -183,6 +188,7 @@ inline VAL CONSTRUCTOR4(int tag, VAL a1, VAL a2, VAL a3, VAL a4)
     cn->args[3] = a4;
     SETTY(c,CON);
     c->info = (void*)cn;
+    EREADY(c);
     return c;
 }
 
@@ -199,6 +205,7 @@ inline VAL CONSTRUCTOR5(int tag, VAL a1, VAL a2, VAL a3, VAL a4, VAL a5)
     cn->args[4] = a5;
     SETTY(c,CON);
     c->info = (void*)cn;
+    EREADY(c);
     return c;
 }
 
@@ -367,6 +374,7 @@ inline VAL CLOSURE_APPLY(VAL f, int args, void** block)
 
     SETTY(c,THUNK);
     c->info = (void*)fn;
+    EREADY(c);
     return c;
 }
 
@@ -386,6 +394,7 @@ inline VAL aux_CLOSURE_APPLY1(VAL f, VAL a1)
 
     SETTY(c,THUNK);
     c->info = (void*)fn;
+    EREADY(c);
     return c;
 }
 
@@ -406,6 +415,7 @@ inline VAL aux_CLOSURE_APPLY2(VAL f, VAL a1, VAL a2)
 
     SETTY(c,THUNK);
     c->info = (void*)fn;
+    EREADY(c);
     return c;
 }
 
@@ -427,6 +437,7 @@ inline VAL aux_CLOSURE_APPLY3(VAL f, VAL a1, VAL a2, VAL a3)
 
     SETTY(c,THUNK);
     c->info = (void*)fn;
+    EREADY(c);
     return c;
 }
 
@@ -449,6 +460,7 @@ inline VAL aux_CLOSURE_APPLY4(VAL f, VAL a1, VAL a2, VAL a3, VAL a4)
 
     SETTY(c,THUNK);
     c->info = (void*)fn;
+    EREADY(c);
     return c;
 }
 
@@ -472,6 +484,7 @@ inline VAL aux_CLOSURE_APPLY5(VAL f, VAL a1, VAL a2, VAL a3, VAL a4, VAL a5)
 
     SETTY(c,THUNK);
     c->info = (void*)fn;
+    EREADY(c);
     return c;
 }
 
@@ -639,6 +652,7 @@ VAL DO_EVAL(VAL x, int update) {
     default:
 	assert(0); // Can't happen
     }
+    EREADY(x);
     return x;
 }
 
@@ -670,6 +684,7 @@ void* NEWBIGINT(char* intstr)
 
     SETTY(c, BIGINT);
     c->info = (void*)bigint;
+    EREADY(c);
     return c;
 }
 
@@ -683,6 +698,7 @@ void* MKBIGINT(mpz_t* big)
 
     SETTY(c, BIGINT);
     c->info = (void*)bigint;
+    EREADY(c);
     return c;
 }
 
@@ -710,6 +726,7 @@ void* MKSTR(char* x)
 // Since MKSTR is used to build strings from foreign calls, the string
 // itself will already have been allocated so we just want the closure.
     c->info=x;
+    EREADY(c);
     return c;
 }
 
@@ -718,6 +735,7 @@ void* MKPTR(void* x)
     VAL c = MKCLOSURE;
     SETTY(c, PTR);
     c->info = x;
+    EREADY(c);
     return c;
 }
 
@@ -738,6 +756,7 @@ void* MKFREE(int x)
     VAL c = MKCLOSURE;
     SETTY(c, FREEVAR);
     c->info = (void*)x;
+    EREADY(c);
     return c;
 }
 
@@ -749,4 +768,5 @@ void init_evm()
     for(i=0;i<255;++i) {
 	zcon[i] = CONSTRUCTORn(i,0,0);
     }
+    EREADY(zcon);
 }

evm/closure.h

@@ -1,20 +1,14 @@
 #ifndef _CLOSURE_H
 #define _CLOSURE_H
 
-# ifndef WIN32
-#  include <pthread.h>
-#  define GC_THREADS
-# else
-#  define GC_WIN32_THREADS
-# endif
-
-#include <gc/gc.h>
+#include <emalloc.h>
 #include <gmp.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <stdint.h>
 
 #define EMALLOC GC_MALLOC
+#define EREADY(x) 
 #define EREALLOC GC_REALLOC
 #define EFREE GC_FREE
 
@@ -50,7 +44,8 @@ typedef enum {
     STRING, 
     UNIT, 
     PTR,
-    FREEVAR 
+    FREEVAR,
+    IND
 } ClosureType;
 
 typedef struct {
@@ -206,7 +201,8 @@ void* FASTMALLOC(int size);
     ((con*)((VAL)c+1))->args = (void*)c+sizeof(Closure)+sizeof(con); \
     ((con*)((VAL)c+1))->args[0] = x; \
     SETTY(((VAL)c),CON);	 \
-    ((VAL)c)->info = (void*)((con*)((VAL)c+1));
+    ((VAL)c)->info = (void*)((con*)((VAL)c+1)); \
+    EREADY(c);
 
 #define CONSTRUCTOR2m(c,t,x,y)		\
     c=EMALLOC(sizeof(Closure)+sizeof(con)+2*sizeof(VAL)); \
@@ -215,7 +211,8 @@ void* FASTMALLOC(int size);
     ((con*)((VAL)c+1))->args[0] = x; \
     ((con*)((VAL)c+1))->args[1] = y; \
     SETTY(((VAL)c),CON);	 \
-    ((VAL)c)->info = (void*)((con*)((VAL)c+1));
+    ((VAL)c)->info = (void*)((con*)((VAL)c+1)); \
+    EREADY(c);
 
 #define CONSTRUCTOR3m(c,t,x,y,z)		\
     c=EMALLOC(sizeof(Closure)+sizeof(con)+3*sizeof(VAL)); \
@@ -225,7 +222,8 @@ void* FASTMALLOC(int size);
     ((con*)((VAL)c+1))->args[1] = y; \
     ((con*)((VAL)c+1))->args[2] = z; \
     SETTY(((VAL)c),CON);	 \
-    ((VAL)c)->info = (void*)((con*)((VAL)c+1));
+    ((VAL)c)->info = (void*)((con*)((VAL)c+1)); \
+    EREADY(c);
 
 #define CONSTRUCTOR4m(c,t,x,y,z,w)			  \
     c=EMALLOC(sizeof(Closure)+sizeof(con)+4*sizeof(VAL)); \
@@ -236,7 +234,8 @@ void* FASTMALLOC(int size);
     ((con*)((VAL)c+1))->args[2] = z; \
     ((con*)((VAL)c+1))->args[3] = w; \
     SETTY(((VAL)c),CON);	 \
-    ((VAL)c)->info = (void*)((con*)((VAL)c+1));
+    ((VAL)c)->info = (void*)((con*)((VAL)c+1)); \
+    EREADY(c);
 
 #define CONSTRUCTOR5m(c,t,x,y,z,w,v)			  \
     c=EMALLOC(sizeof(Closure)+sizeof(con)+5*sizeof(VAL)); \
@@ -248,7 +247,8 @@ void* FASTMALLOC(int size);
     ((con*)((VAL)c+1))->args[3] = w; \
     ((con*)((VAL)c+1))->args[4] = v; \
     SETTY(((VAL)c),CON);	 \
-    ((VAL)c)->info = (void*)((con*)((VAL)c+1));
+    ((VAL)c)->info = (void*)((con*)((VAL)c+1)); \
+    EREADY(c);
 
 //    s = EMALLOC(sizeof(Closure)+strlen(x)+sizeof(char)+1);	
 

evm/mainprog.c

@@ -9,11 +9,20 @@
 
 void* _do__U_main();
 
+void** _epic_top_of_stack;
+
 int main(int argc, char* argv[]) {
+    void* stacktop = NULL;
+    _epic_top_of_stack = (void**)&stacktop;
+
     GC_init();
     init_evm();
-//    GC_use_entire_heap = 1;
-//    GC_free_space_divisor = 1;
+    GC_use_entire_heap = 1;
+    GC_free_space_divisor = 2;
+//    GC_enable_incremental();
+//    GC_time_limit = GC_TIME_UNLIMITED;
+
+//    GC_full_freq=15;
 //    fprintf(stderr, "Heap: %d\n", GC_get_heap_size());
     GC_expand_hp(1000000);
 //    fprintf(stderr, "Heap: %d\n", GC_get_heap_size());