Work

Makefile

@@ -3,7 +3,7 @@
 
 OUTNAME = flisp
 
-CFLAGS = -O0 -Wall -Wextra -g -pipe 
+CFLAGS = -O0 -Wall -Wextra -g -pipe -Wno-cast-function-type 
 
 CC = gcc
 

TODO.md

@@ -0,0 +1,14 @@
+- Load files
+- Benchmarks
+- Tests
+- Assign on declaration
+- Rework assign/call to work better
+- Finish internal allocator
+- Strings
+- String casts
+- Core functions
+- Type checks
+- Scopes  
+  
+- Type propagation
+- Bytecode gen

examples/1p1.flsp

@@ -0,0 +1,6 @@
+(var a)
+(var b)
+(a 1)
+(b 1)
+(write (+ a b))
+(newline)

src/byte_defs.h

@@ -86,6 +86,13 @@ typedef struct {
 
 } PACKED ValueArray;
 
+typedef struct {
+
+  // Cast to a 48bit FnSig ptr
+  u8 __raw_bytes[6];
+
+} PACKED ValueFn;
+
 typedef struct {
 
   PACKED union {
@@ -102,6 +109,7 @@ typedef struct {
     Value4B       v4B;
     ValueArray varray;
     ValueStr     vstr;
+    ValueFn       vfn;
   };
 
   Tag tag;
@@ -124,6 +132,12 @@ typedef struct {
 } FnSig;
 
 #ifndef win
-//_Static_assert(sizeof(Value) == 8);
+_Static_assert(sizeof(Value) == 8);
 #endif
 _Static_assert(sizeof(Tag) <= sizeof(i32));
+
+static inline FnSig *get_fnsig(Value *x){
+  u64 rval = *((u64*)x);
+  rval &= 0xFFFFFFFFFFFF; // 48bits - should be (mostly) fine
+  return (void*)rval; 
+}

src/code_defs.h

@@ -89,4 +89,4 @@ typedef struct {
 
 } ASTStack;
 
-_Static_assert(BI_assign >= ST__end);
+_Static_assert((int)BI_assign >= ST__end);

src/exec_common.c

@@ -1,4 +1,5 @@
 #include <stdlib.h>
+#include <string.h>
 #include <stdio.h>
 #include <math.h>
 
@@ -6,11 +7,25 @@
 #include "types.h"
 #include "code_defs.h"
 #include "byte_defs.h"
+#include "exec_common.h"
+
+typedef struct {
+
+  u32 pos;
+  u32 size;
+
+} AllocBlock;
+
+void *internal_buf;
+AllocBlock *blocks;
+u32 *usage; // bitmap for usage, by 8byte chunks
+size_t internal_size;
+u32 block_count;
 
 // Utils
 
 void runtime_err(char *s){
-  printf("Runtime Error : %s\n", s);
+  fprintf(stderr,"Runtime Error : %s\n", s);
   exit(1);
 }
 
@@ -35,6 +50,61 @@ int evaluate(Value val){
   }
 }
 
+int alloc_init(){
+  internal_buf = malloc(4096);
+  printf("55\n");
+  blocks = malloc(sizeof(AllocBlock));
+  printf("57\n");
+  block_count = 0;
+  usage = malloc(sizeof(u32)*4096/32/8);
+  printf("60\n");
+  if(!internal_buf || !blocks || !usage)
+    return 1;
+  memset(usage, 0, sizeof(u32)*4096/32/8); 
+  return 0;
+}
+
+u32 flisp_alloc(size_t size){
+  u32 pos = 32;
+  u32 curr_free = 0;
+  while(pos < internal_size){
+    if(usage[pos/32/8]){
+      for(int i = 0; i < 32; i++){
+        if((usage[pos/32/8]>>i) & 1)
+          curr_free = 0;
+        else
+          curr_free+=8;
+      }
+    }
+    else {
+      curr_free += 32*8;
+    }
+    if(curr_free >= size){
+      blocks = realloc(blocks, sizeof(AllocBlock)*(block_count+1));
+      if(!blocks)
+        return 0;
+      AllocBlock *block = &blocks[block_count++];
+      block->pos = pos - curr_free;
+      block->size = size;
+      for(u32 i = block->pos; i < block->pos+size; i++){
+        usage[i/32/8] |= 1<<(i%(32*8));
+      }
+      memset(get_addr(block->pos),0xB0B69420,size);
+      return block->pos;
+    }
+    pos++;
+  }
+  return 0;
+}
+
+void flisp_free(u32 pos){
+
+}
+
+void *get_addr(u32 pos){
+  return internal_buf + pos;
+}
+
 // Lesser special functions
 
 Value is(Tag tag, Value b){
@@ -43,8 +113,85 @@ Value is(Tag tag, Value b){
   return ret;
 }
 
-Value cast(Tag type, Value b){
+typedef Value (cast_fn_t)(Value);
 
+Value int_to_fix(Value x){
+  x.tag.type = T_fix;
+  x.v4B.value = fix(x.v4B.value);
+  return x; 
+}
+
+Value int_to_flt(Value x){
+  x.tag.type = T_float;
+  x.v4B.vfl = (float)x.v4B.value;
+  return x;
+}
+
+Value fix_to_int(Value x){
+  x.tag.type = T_int;
+  x.v4B.value = ffloor(x.v4B.value);
+  return x;
+}
+
+Value fix_to_flt(Value x){
+  x.tag.type = T_float;
+  x.v4B.vfl = f2float(x.v4B.value);
+  return x;
+}
+
+Value flt_to_int(Value x){
+  x.tag.type = T_int;
+  x.v4B.value = (i32)(x.v4B.vfl);
+  return x;
+}
+
+Value flt_to_fix(Value x){
+  x.tag.type = T_fix;
+  x.v4B.value = fixfloat(x.v4B.vfl);
+  return x;
+}
+
+Value int_to_str(Value x){
+  runtime_err("TODO : int_to_str");
+}
+
+Value fix_to_str(Value x){
+  runtime_err("TODO : fix_to_str");
+}
+
+Value flt_to_str(Value x){
+  runtime_err("TODO : flt_to_str");
+}
+
+Value str_to_int(Value x){
+
+}
+
+Value str_to_fix(Value x){
+
+}
+
+Value str_to_flt(Value x){
+
+}
+
+// [from][to]
+cast_fn_t *cast_table[4][4] = {
+  {NULL      , int_to_fix, int_to_flt, int_to_str},
+  {fix_to_int, NULL      , fix_to_flt, fix_to_str},
+  {flt_to_int, flt_to_fix, NULL      , flt_to_str},
+  {str_to_int, str_to_fix, str_to_flt, NULL      }
+};
+
+Value cast(Tag type, Value b){
+  if(type.type == b.tag.type)
+    return b;
+  if(type.type == T_null || b.tag.type == T_null || type.type == T_fn
+       || b.tag.type == T_fn || type.is_array || b.tag.is_array){
+    b.tag.type = T_null;
+    return b;
+  }
+  return cast_table[b.tag.type-1][type.type-1](b);
 }
 
 // Generic builtins
@@ -219,16 +366,20 @@ Value write(Value a){
       printf("%f",a.v4B.vfl);
       break;
     case T_str:
+      // TODO replace strdup
+      char *nstr;
       if(a.vstr.len > 4){
-        runtime_err("Not implem");
+        char *str = get_addr(a.vstr.pos);
+        nstr = strndup(str, a.vstr.len);
       }
       else{
-        char *nstr = strndup(a.vstr.str, 4);
-        nstr[a.vstr.len] = '\0';
+        nstr = strndup(a.vstr.str, 4);
+      }
       printf("%s",nstr);
       free(nstr);
-     }
+      break;
     case T_fn:
+      printf("<fn @%lx>", (u64)get_fnsig(&a));
       break;
     default:
       break;

src/exec_common.h

@@ -4,10 +4,22 @@
 
 #pragma once
 
+
 void runtime_err(char *s);
 
 int evaluate(Value val);
 
+int alloc_init();
+
+// All internal allocator memory is guaranteed to be free range and 32bit
+u32 flisp_alloc(size_t size);
+
+void flisp_free(u32 pos);
+
+void *flisp_realloc(u32 pos, size_t size);
+
+void *get_addr(u32 pos);
+
 Value is(Tag tag, Value b);
 
 void symbol_map_add_bi(HashMap *map);

src/interpreter.c

@@ -61,7 +61,7 @@ Value execute(Statement *stat){
       FnSig *fn = stat->func;
       Statement **params;
       if(fn->n_param)
-        params = ((Statement*)stat->children[0])->children;
+        params = (Statement**)((Statement*)stat->children[0])->children;
       if(fn->is_builtin){
         switch(fn->n_param){
           case 0:

src/parse_utils.c

@@ -7,6 +7,7 @@
 #include "types.h"
 #include "byte_defs.h"
 #include "code_defs.h"
+#include "exec_common.h"
 #include "parser.h"
 #include "hash.h"
 
@@ -53,6 +54,10 @@ Statement *make_iconst(i32 val){
   return stat;
 }
 
+Statement *make_strconst(char *str){
+  
+}
+
 Statement *declare(i32 type, Tag vtype, char *name){
   i32 len = strcspn(name, " \t\n)");
   char *name2 = strndup(name, len);
@@ -87,6 +92,7 @@ Statement *make_block(Statement *first){
   stat->type = ST_Block; 
   stat->children = malloc(sizeof(void*));
   stat->children[0] = first;
+  first->parent = stat;
   stat->child_n = 1;
   return stat;
 }
@@ -94,6 +100,7 @@ Statement *make_block(Statement *first){
 Statement *add_block(Statement *block, Statement *add){
   block->children = realloc(block->children, sizeof(void*)*(block->child_n+1));
   block->children[block->child_n++] = add;
+  add->parent = block;
   return block;
 }
 
@@ -134,6 +141,8 @@ Statement *make_operation(i32 type, Tag vtype, char *name, i32 nparam, ...){
       stat->func = fnsig;
     }
     if(nparam){
+      if(!fnsig)
+        yyerror("Calling function that has not been specified");
       if(param->child_n > fnsig->n_param)
         yyerror("Too many parameters to function");
     }
@@ -145,12 +154,15 @@ Statement *make_operation(i32 type, Tag vtype, char *name, i32 nparam, ...){
 
   stat->type = type;
  
-  if(nparam)
+  if(nparam){
     stat->children[stat->child_n++] = param;
+    param->parent = stat;
+  }
   // TODO : Type checks
   for(int i = 1; i < nparam; i++){
     Statement *prm_n = va_arg(prm, Statement*);
     stat->children[stat->child_n++] = prm_n;
+    prm_n->parent = stat;
   }
   va_end(prm);
 

src/parser.l

@@ -9,6 +9,7 @@
 
 %%
 
+#.+\n                                 ;
 
 ":vec"                                return VEC;
 
@@ -26,6 +27,11 @@
 "block"                               return BLOCK;
 "is"                                  return IS;
 
+\"[^"\n]*["\n]                        {
+                                        yylval.st = make_strconst(yytext+1);
+                                        printf("STRCST : %s\n",yytext);
+                                        return CST;
+                                      }
 
 [-+*/%<=>!a-zA-Z]+                    {
                                         yylval.str = yytext;

src/parser.y

@@ -1,10 +1,12 @@
 %{
   #include <stdio.h>
+  #include <string.h>
   #include <stdlib.h>
   #include "types.h"
   #include "code_defs.h"
   #include "parser.h"
   #include "interpreter.h"
+  #include "exec_common.h"
 
   int yylex();
 %}
@@ -34,7 +36,8 @@
 %%
 
 program:
-  expr_list ';'                        {execute($1); exit(0); }
+  expr_list ';'                        {execute($1);}
+  | expr_list YYEOF                    {execute($1);}
   ;
 
 type:
@@ -117,9 +120,28 @@ void yyerror(char *s){
   exit(1);
 }
 
-int main(){
-  printf("fLisp interactive env - v0.1\nFcalva 2025\nUnder the terms of the GPL v3.0 license\n");
+extern FILE *yyin;
+
+int main(int argc, char *argv[]){
+  alloc_init();
+
+  if(argc < 2){
+    printf("fLisp interactive env - v0.1\nFcalva 2025\n");
+    printf("Under the terms of the GPL v3.0 license\n");
+    yyin = stdin;
+  }
+  else {
+    yyin = fopen(argv[1], "r"); 
+    if(!yyin){
+      fprintf(stderr,"Failed to open file \"%s\"", argv[1]);
+      exit(1);
+    }
+  }
+
   make_stack();
   yyparse();
+
+  fclose(yyin);
+
   return 0;
 }