├── Makefile ├── README.md ├── bin └── .gitkeep ├── csrc ├── Makefile ├── boot.l ├── boot2.l ├── buffer.c ├── chartab.h ├── eval.c ├── eval2.c ├── eval3.c ├── gc.c ├── gc.h ├── libgc.c └── wcs.c ├── doc ├── IA32.txt ├── eval.txt ├── primitives.l └── style.txt ├── examples ├── args.l ├── fp-ops.c ├── hello-world.l └── unused.l ├── obj ├── eval.linux.s └── eval.osx.s ├── src ├── boot.l ├── emit-llvm.l ├── emit.l ├── eval.l ├── mkosdefs.c ├── osdefs.linux.k └── osdefs.osx.k └── test ├── pepsi ├── boot.l ├── boot2.l ├── parser.l ├── peg-compile.l ├── peg.l ├── port.l ├── pretty-print.l ├── repl.l └── test-pepsi.l ├── test-boot.l ├── test-fsubr.l ├── test-subr-binary.l ├── test-subr-logical.l ├── test-subr-relation.l ├── test-subr.l ├── test-unbalanced.l └── unit-test.l /Makefile: -------------------------------------------------------------------------------- 1 | SHELL=bash 2 | 3 | all: bin/eval 4 | 5 | evalm = bin/eval src/boot.l 6 | 7 | evaln = bin/eval.new src/boot.l 8 | 9 | eval1 = bin/eval1 -b csrc/boot.l 10 | 11 | eval2 = bin/eval2 -b csrc/boot2.l 12 | 13 | eval3 = bin/eval3 -b csrc/boot2.l 14 | 15 | gceval = bin/gceval -b csrc/boot.l 16 | 17 | eval = evalm 18 | 19 | bin = $(firstword ${${eval}}) 20 | 21 | run = ${${eval}} 22 | 23 | GCC = gcc -m32 24 | 25 | ifeq ($(OS),Windows_NT) 26 | OS = win 27 | else 28 | UNAME_S := $(shell uname -s) 29 | ifeq ($(UNAME_S),Linux) 30 | OS = linux 31 | endif 32 | ifeq ($(UNAME_S),Darwin) 33 | OS = osx 34 | GCC += -Wl,-no_pie 35 | endif 36 | endif 37 | 38 | clean: 39 | -rm bin/* src/osdefs.k 2>/dev/null || true 40 | 41 | bin/eval: 42 | git show master:obj/eval.${OS}.s | ${GCC} -x assembler - -o bin/eval 43 | 44 | bin/eval.new: obj/eval.s 45 | ${GCC} $^ -o $@ 46 | 47 | promote: bin/eval.new 48 | make tests eval=evaln 49 | mv bin/eval.new bin/eval 50 | 51 | src/osdefs.k : bin/mkosdefs 52 | $^ > $@ 53 | 54 | bin/mkosdefs : src/mkosdefs.c 55 | gcc -o $@ $^ 56 | 57 | obj/eval.s: bin/eval src/boot.l src/osdefs.k src/emit.l src/eval.l 58 | bin/eval -O $(wordlist 2, 9, $^) > $@ 59 | 60 | obj/eval.%.s: bin/eval src/boot.l src/osdefs.%.k src/emit.l src/eval.l 61 | bin/eval -O $(wordlist 2, 9, $^) > $@ 62 | 63 | obj/eval.ll: bin/eval src/boot.l src/emit-llvm.l src/eval.l 64 | bin/eval -O src/boot.l src/emit-llvm.l src/eval.l > $@ 65 | 66 | %.e: %.l 67 | bin/eval src/boot.l $^ 68 | 69 | %.s: %.l 70 | if [ $$(grep -l "compile-begin" $^) ]; then \ 71 | bin/eval -O src/boot.l src/osdefs.k src/emit.l $^ > $@; \ 72 | else \ 73 | bin/eval -O src/boot.l src/osdefs.k src/emit.l <(echo "(compile-begin)"; cat $^; echo "(compile-end)") > $@; \ 74 | fi 75 | 76 | %.ll: %.l src/boot.l src/emit-llvm.l 77 | if [ $$(grep -l "compile-begin" $<) ]; then \ 78 | bin/eval -O src/boot.l src/emit-llvm.l $< > $@; \ 79 | else \ 80 | bin/eval -O src/boot.l src/emit-llvm.l <(echo "(compile-begin)"; cat $<; echo "(compile-end)") > $@; \ 81 | fi 82 | 83 | %: %.s 84 | ${GCC} $^ -o $@ 85 | 86 | %.s: %.ll 87 | llc-3.4 -march=x86 $^ > $@ 88 | 89 | %.ll: %.c 90 | clang -S -emit-llvm $^ -o $@ 91 | 92 | %.s: %.c 93 | gcc -S -fno-asynchronous-unwind-tables -m32 $^ -o $@ 94 | 95 | tests: bin/eval \ 96 | test/test-subr-logical \ 97 | test/test-subr-relation \ 98 | test/test-subr-binary \ 99 | test/test-subr \ 100 | test/test-fsubr \ 101 | test/test-boot 102 | 103 | test-%: test-%.l ${bin} 104 | ${run} $< 105 | 106 | test-bootstrap: src/boot.l src/osdefs.${OS}.k src/emit.l src/eval.l 107 | bin/eval -O $^ > obj/eval-temp.s 108 | diff obj/eval.${OS}.s obj/eval-temp.s 109 | rm obj/eval-temp.s 110 | 111 | test-unbalanced: bin/eval bin/eval1 112 | -bin/eval test/test-unbalanced.l 113 | -bin/eval1 -b test/test-unbalanced.l 114 | 115 | test-pepsi: bin/eval1 bin/eval2 bin/eval3 bin/gceval 116 | cd test/pepsi; ../../bin/eval1 repl.l test-pepsi.l > test-pepsi.eval1 117 | cd test/pepsi; ../../bin/eval2 repl.l test-pepsi.l > test-pepsi.eval2 118 | cd test/pepsi; ../../bin/eval3 repl.l test-pepsi.l > test-pepsi.eval3 119 | cd test/pepsi; ../../bin/gceval repl.l test-pepsi.l > test-pepsi.gceval 120 | 121 | # fails with "undefined variable: string->double" as eval does not support double values 122 | test-pepsi-eval: bin/eval 123 | cd test/pepsi; ../../bin/eval ../../src/boot.l ../unit-test.l repl.l test-pepsi.l 124 | 125 | test-llvm: 126 | make examples/args.ll 127 | make obj/eval.ll 128 | 129 | stats: 130 | cat src/boot.l src/emit.l src/eval.l | sed 's/.*debug.*//;s/;.*//;/^\s*$$/d' | wc -l 131 | cat src/boot.l src/emit.l src/eval.l | grep '(' -o | wc -l 132 | 133 | OFLAGS = -O3 -fomit-frame-pointer -DNDEBUG 134 | CFLAGS = -Wall -Wno-comment -g $(OFLAGS) 135 | LIBS = -lm -lffi -ldl 136 | 137 | bin/eval1 : csrc/eval.c csrc/gc.c csrc/gc.h csrc/buffer.c csrc/chartab.h csrc/wcs.c 138 | $(CC) -g $(CFLAGS) -o $@ $< $(LIBS) 139 | 140 | bin/eval2 : csrc/eval2.c csrc/gc.c csrc/gc.h csrc/buffer.c csrc/chartab.h csrc/wcs.c src/osdefs.k 141 | $(CC) -g $(CFLAGS) -o $@ $< $(LIBS) 142 | 143 | bin/eval3 : csrc/eval3.c csrc/gc.c csrc/gc.h csrc/buffer.c csrc/chartab.h csrc/wcs.c src/osdefs.k 144 | $(CC) -g $(CFLAGS) -o $@ $< $(LIBS) 145 | 146 | bin/gceval: csrc/eval.c csrc/libgc.c csrc/buffer.c csrc/chartab.h csrc/wcs.c 147 | $(CC) -g $(CFLAGS) -DLIB_GC=1 -o $@ $< $(LIBS) -lgc 148 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Maru 2 | 3 | > Maru is a symbolic expression evaluator that can compile its own implementation language. 4 | 5 | -- http://piumarta.com/software/maru/ 6 | 7 | This fork aims to eliminate the dependence on C as the implementation language 8 | by updating the maru-in-maru interpreter to include all the features of the 9 | maru-in-C interpreter. 10 | 11 | ## Objective 12 | * src/eval.l to have the same features as csrc/eval.c 13 | * able to run test-pepsi example 14 | 15 | ## Other improvements 16 | * write tests for eval 17 | * document the maru language 18 | * add LLVM support 19 | 20 | ## Bootstrapping 21 | eval.s is the interpreter compiled to IA32 assembly, it can be compiled to a binary with gcc via the Makefile 22 | 23 | `make bin/eval` 24 | 25 | The binary can regenerate eval.s from source via the Makefile 26 | 27 | ``` 28 | rm obj/eval.s 29 | make obj/eval.s 30 | ``` 31 | 32 | The generate eval.s is identical to the version in the repository 33 | 34 | 35 | -------------------------------------------------------------------------------- /bin/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/melvinzhang/maru/730de45b64d801593b22a6529c7508cac4d1c6ac/bin/.gitkeep -------------------------------------------------------------------------------- /csrc/Makefile: -------------------------------------------------------------------------------- 1 | OFLAGS = -O3 -fomit-frame-pointer -DNDEBUG 2 | CFLAGS = -Wall -Wno-comment -g $(OFLAGS) 3 | LIBS = -lm -lffi -ldl 4 | 5 | BIN = eval1 eval2 eval3 gceval 6 | 7 | all: ${BIN} 8 | 9 | eval1 : eval.c gc.c gc.h buffer.c chartab.h wcs.c 10 | $(CC) -g $(CFLAGS) -o $@ eval.c $(LIBS) 11 | 12 | eval2 : eval2.c gc.c gc.h buffer.c chartab.h wcs.c ../osdefs.k 13 | $(CC) -g $(CFLAGS) -o $@ eval2.c $(LIBS) 14 | 15 | eval3 : eval3.c gc.c gc.h buffer.c chartab.h wcs.c ../osdefs.k 16 | $(CC) -g $(CFLAGS) -o $@ eval3.c $(LIBS) 17 | 18 | gceval : eval.c libgc.c buffer.c chartab.h wcs.c 19 | $(CC) -g $(CFLAGS) -DLIB_GC=1 -o $@ eval.c $(LIBS) -lgc 20 | 21 | clean: 22 | -rm ${BIN} 23 | -------------------------------------------------------------------------------- /csrc/buffer.c: -------------------------------------------------------------------------------- 1 | struct buffer 2 | { 3 | wchar_t *buffer; 4 | int size; 5 | int position; 6 | }; 7 | 8 | #define BUFFER_INITIALISER { 0, 0, 0 } 9 | 10 | static void buffer_reset(struct buffer *b) { b->position= 0; } 11 | 12 | #if 0 13 | static int buffer_position(struct buffer *b) { return b->position; } 14 | #endif 15 | 16 | #if 0 17 | static int buffer_last(struct buffer *b) { return (b->position > 0) ? b->buffer[b->position - 1] : -1; } 18 | #endif 19 | 20 | #if 0 21 | static int buffer_read(struct buffer *b) 22 | { 23 | int c= b->buffer[b->position++]; 24 | if (!c) b->position--; 25 | return c; 26 | } 27 | #endif 28 | 29 | static void buffer_append(struct buffer *b, int c) 30 | { 31 | if (b->position == b->size) 32 | b->buffer= b->buffer 33 | ? realloc(b->buffer, sizeof(wchar_t) * (b->size *= 2)) 34 | : malloc(sizeof(wchar_t) * (b->size= 32)); 35 | b->buffer[b->position++]= c; 36 | } 37 | 38 | static void buffer_appendAll(struct buffer *b, const wchar_t *s) 39 | { 40 | while (*s) buffer_append(b, *s++); 41 | } 42 | 43 | #if 0 44 | static void buffer_seek(struct buffer *b, int off) 45 | { 46 | if (off < 0) { if ((b->position += off) < 0) b->position= 0; } 47 | else { while (off--) buffer_append(b, 0); } 48 | } 49 | #endif 50 | 51 | static wchar_t *buffer_contents(struct buffer *b) 52 | { 53 | buffer_append(b, 0); 54 | b->position--; 55 | return (wchar_t *)b->buffer; 56 | } 57 | -------------------------------------------------------------------------------- /csrc/chartab.h: -------------------------------------------------------------------------------- 1 | #define CHAR_PRINT (1<<0) 2 | #define CHAR_BLANK (1<<1) 3 | #define CHAR_ALPHA (1<<2) 4 | #define CHAR_DIGIT10 (1<<3) 5 | #define CHAR_DIGIT16 (1<<4) 6 | #define CHAR_LETTER (1<<5) 7 | 8 | static char chartab[]= { 9 | /* 00 nul */ 0, 10 | /* 01 soh */ 0, 11 | /* 02 stx */ 0, 12 | /* 03 etx */ 0, 13 | /* 04 eot */ 0, 14 | /* 05 enq */ 0, 15 | /* 06 ack */ 0, 16 | /* 07 bel */ 0, 17 | /* 08 bs */ 0, 18 | /* 09 ht */ 0, 19 | /* 0a nl */ CHAR_PRINT | CHAR_BLANK, 20 | /* 0b vt */ 0, 21 | /* 0c np */ CHAR_PRINT | CHAR_BLANK, 22 | /* 0d cr */ CHAR_PRINT | CHAR_BLANK, 23 | /* 0e so */ 0, 24 | /* 0f si */ 0, 25 | /* 10 dle */ 0, 26 | /* 11 dc1 */ 0, 27 | /* 12 dc2 */ 0, 28 | /* 13 dc3 */ 0, 29 | /* 14 dc4 */ 0, 30 | /* 15 nak */ 0, 31 | /* 16 syn */ 0, 32 | /* 17 etb */ 0, 33 | /* 18 can */ 0, 34 | /* 19 em */ 0, 35 | /* 1a sub */ 0, 36 | /* 1b esc */ 0, 37 | /* 1c fs */ 0, 38 | /* 1d gs */ 0, 39 | /* 1e rs */ 0, 40 | /* 1f us */ 0, 41 | /* 20 sp */ CHAR_PRINT | CHAR_BLANK, 42 | /* 21 ! */ CHAR_PRINT | CHAR_LETTER, 43 | /* 22 " */ CHAR_PRINT | CHAR_PRINT, 44 | /* 23 # */ CHAR_PRINT | CHAR_LETTER, 45 | /* 24 $ */ CHAR_PRINT | CHAR_LETTER, 46 | /* 25 % */ CHAR_PRINT | CHAR_LETTER, 47 | /* 26 & */ CHAR_PRINT | CHAR_LETTER, 48 | /* 27 ' */ CHAR_PRINT, 49 | /* 28 ( */ CHAR_PRINT, 50 | /* 29 ) */ CHAR_PRINT, 51 | /* 2a * */ CHAR_PRINT | CHAR_LETTER, 52 | /* 2b + */ CHAR_PRINT | CHAR_LETTER, 53 | /* 2c , */ CHAR_PRINT | CHAR_LETTER, 54 | /* 2d - */ CHAR_PRINT | CHAR_LETTER, 55 | /* 2e . */ CHAR_PRINT | CHAR_LETTER, 56 | /* 2f / */ CHAR_PRINT | CHAR_LETTER, 57 | /* 30 0 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 58 | /* 31 1 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 59 | /* 32 2 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 60 | /* 33 3 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 61 | /* 34 4 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 62 | /* 35 5 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 63 | /* 36 6 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 64 | /* 37 7 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 65 | /* 38 8 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 66 | /* 39 9 */ CHAR_PRINT | CHAR_DIGIT10 | CHAR_DIGIT16, 67 | /* 3a : */ CHAR_PRINT | CHAR_LETTER, 68 | /* 3b ; */ CHAR_PRINT, 69 | /* 3c < */ CHAR_PRINT | CHAR_LETTER, 70 | /* 3d = */ CHAR_PRINT | CHAR_LETTER, 71 | /* 3e > */ CHAR_PRINT | CHAR_LETTER, 72 | /* 3f ? */ CHAR_PRINT | CHAR_LETTER, 73 | /* 40 @ */ CHAR_PRINT | CHAR_LETTER, 74 | /* 41 A */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 75 | /* 42 B */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 76 | /* 43 C */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 77 | /* 44 D */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 78 | /* 45 E */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 79 | /* 46 F */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 80 | /* 47 G */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 81 | /* 48 H */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 82 | /* 49 I */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 83 | /* 4a J */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 84 | /* 4b K */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 85 | /* 4c L */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 86 | /* 4d M */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 87 | /* 4e N */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 88 | /* 4f O */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 89 | /* 50 P */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 90 | /* 51 Q */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 91 | /* 52 R */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 92 | /* 53 S */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 93 | /* 54 T */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 94 | /* 55 U */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 95 | /* 56 V */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 96 | /* 57 W */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 97 | /* 58 X */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 98 | /* 59 Y */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 99 | /* 5a Z */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 100 | /* 5b [ */ CHAR_PRINT, 101 | /* 5c \ */ CHAR_PRINT | CHAR_LETTER, 102 | /* 5d ] */ CHAR_PRINT, 103 | /* 5e ^ */ CHAR_PRINT | CHAR_LETTER, 104 | /* 5f _ */ CHAR_PRINT | CHAR_LETTER, 105 | /* 60 ` */ CHAR_PRINT, 106 | /* 61 a */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 107 | /* 62 b */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 108 | /* 63 c */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 109 | /* 64 d */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 110 | /* 65 e */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 111 | /* 66 f */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA | CHAR_DIGIT16, 112 | /* 67 g */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 113 | /* 68 h */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 114 | /* 69 i */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 115 | /* 6a j */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 116 | /* 6b k */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 117 | /* 6c l */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 118 | /* 6d m */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 119 | /* 6e n */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 120 | /* 6f o */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 121 | /* 70 p */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 122 | /* 71 q */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 123 | /* 72 r */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 124 | /* 73 s */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 125 | /* 74 t */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 126 | /* 75 u */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 127 | /* 76 v */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 128 | /* 77 w */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 129 | /* 78 x */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 130 | /* 79 y */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 131 | /* 7a z */ CHAR_PRINT | CHAR_LETTER | CHAR_ALPHA, 132 | /* 7b { */ CHAR_PRINT, 133 | /* 7c | */ CHAR_PRINT | CHAR_LETTER, 134 | /* 7d } */ CHAR_PRINT, 135 | /* 7e ~ */ CHAR_PRINT | CHAR_LETTER, 136 | /* 7f del */ 0, 137 | }; 138 | -------------------------------------------------------------------------------- /csrc/gc.c: -------------------------------------------------------------------------------- 1 | /* gc.c -- trivial single-threaded stop-world non-moving mark-sweep collector 2 | ** 3 | ** Copyright (c) 2008 Ian Piumarta 4 | ** All Rights Reserved 5 | ** 6 | ** Permission is hereby granted, free of charge, to any person obtaining a 7 | ** copy of this software and associated documentation files (the 'Software'), 8 | ** to deal in the Software without restriction, including without limitation 9 | ** the rights to use, copy, modify, merge, publish, distribute, and/or sell 10 | ** copies of the Software, and to permit persons to whom the Software is 11 | ** furnished to do so, provided that the above copyright notice(s) and this 12 | ** permission notice appear in all copies of the Software. Inclusion of the 13 | ** the above copyright notice(s) and this permission notice in supporting 14 | ** documentation would be appreciated but is not required. 15 | ** 16 | ** THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. 17 | ** 18 | ** Last edited: 2012-09-09 11:38:29 by piumarta on linux32 19 | */ 20 | 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | 27 | #include "gc.h" 28 | 29 | #define GC_ALIGN sizeof(long) 30 | #define GC_MEMORY 0x7fffffff 31 | #define GC_QUANTUM 50*1024 32 | #if defined(DEBUGGC) 33 | # define ALLOCS_PER_GC 1 34 | #else 35 | # define ALLOCS_PER_GC 32768 36 | #endif 37 | 38 | #define VERBOSE 0 39 | 40 | #define BITS_PER_WORD (sizeof(long) * 8) 41 | 42 | typedef struct _gcheader 43 | { 44 | unsigned long size : BITS_PER_WORD - 8 __attribute__((__packed__)); 45 | union { 46 | unsigned int flags : 3; 47 | struct { 48 | unsigned int used : 1; 49 | unsigned int atom : 1; 50 | unsigned int mark : 1; 51 | } __attribute__((__packed__)); 52 | } __attribute__((__packed__)); 53 | struct _gcheader *next; 54 | struct _gcfinaliser *finalisers; 55 | #ifndef NDEBUG 56 | const char *file; 57 | long line; 58 | const char *func; 59 | #endif 60 | #if defined(GC_APP_HEADER) 61 | GC_APP_HEADER 62 | #endif 63 | } gcheader; 64 | 65 | static inline void *hdr2ptr(gcheader *hdr) { return (void *)(hdr + 1); } 66 | static inline gcheader *ptr2hdr(void *ptr) { return (gcheader *)ptr - 1; } 67 | 68 | #ifndef NDEBUG 69 | 70 | GC_API void *GC_stamp(void *ptr, const char *file, long line, const char *func) 71 | { 72 | gcheader *hdr= ptr2hdr(ptr); 73 | hdr->file= file; 74 | hdr->line= line; 75 | hdr->func= func; 76 | return ptr; 77 | } 78 | 79 | GC_API const char *GC_file(void *ptr) { return ptr2hdr(ptr)->file; } 80 | GC_API long GC_line(void *ptr) { return ptr2hdr(ptr)->line; } 81 | GC_API const char *GC_function(void *ptr) { return ptr2hdr(ptr)->func; } 82 | 83 | #endif 84 | 85 | typedef struct _gcfinaliser 86 | { 87 | void *ptr; 88 | GC_finaliser_t finaliser; 89 | void *data; 90 | struct _gcfinaliser *next; 91 | } gcfinaliser; 92 | 93 | static gcheader gcbase= { 0, { -1 }, &gcbase }; 94 | static gcheader *gcnext= &gcbase; 95 | 96 | static size_t gcQuantum= GC_QUANTUM; 97 | static int gcCount= ALLOCS_PER_GC; 98 | static int gcAllocs= ALLOCS_PER_GC; 99 | static size_t gcMemory= GC_MEMORY; 100 | 101 | static gcfinaliser *finalisable= 0; 102 | 103 | //static void bkpt() {} 104 | 105 | GC_API void *GC_malloc(size_t lbs) 106 | { 107 | gcheader *hdr, *org; 108 | size_t split; 109 | if ((!--gcAllocs) || (gcMemory < lbs)) { 110 | //fprintf(stderr, "%i %lu %ld\t", gcAllocs, gcMemory, lbs); 111 | # if VERBOSE >= 1 112 | if (gcAllocs > 0) fprintf(stderr, "GC: heap full after %i allocations\n", gcCount - gcAllocs); 113 | # endif 114 | gcAllocs= gcCount; 115 | GC_gcollect(); 116 | //fprintf(stderr, "GC %i %lu %ld\n", gcAllocs, gcMemory, lbs); 117 | if (gcMemory < lbs) goto full; 118 | } 119 | org= hdr= gcnext; 120 | lbs= (lbs + GC_ALIGN-1) & ~(GC_ALIGN-1); 121 | #if VERBOSE > 1 122 | fprintf(stderr, "malloc %i\n", (int)lbs); 123 | #endif 124 | again: 125 | #if VERBOSE > 4 126 | { 127 | gcheader *h= gcnext; 128 | do { 129 | fprintf(stderr, " %2d %p -> %p = %i\n", h->flags, h, h->next, (int)h->size); 130 | h= h->next; 131 | } while (h != gcnext); 132 | } 133 | #endif 134 | split= lbs + sizeof(gcheader) + GC_ALIGN; 135 | do { 136 | # if VERBOSE > 3 137 | fprintf(stderr, "? %2d %p -> %p = %i\n", hdr->flags, hdr, hdr->next, (int)hdr->size); 138 | # endif 139 | if (!hdr->used) { 140 | while ((!hdr->next->used) && (hdr2ptr(hdr) + hdr->size == hdr->next)) { 141 | hdr->size += sizeof(gcheader) + hdr->next->size; 142 | hdr->next= hdr->next->next; 143 | } 144 | if ((hdr->size >= split) || (hdr->size == lbs)) 145 | { 146 | void *mem; 147 | if (hdr->size >= split) 148 | { 149 | gcheader *ins= (gcheader *)(hdr2ptr(hdr) + lbs); 150 | ins->flags= 0; 151 | ins->next= hdr->next; 152 | ins->size= hdr->size - lbs - sizeof(gcheader); 153 | hdr->next= ins; 154 | hdr->size= lbs; 155 | } 156 | hdr->used= 1; 157 | hdr->finalisers= 0; 158 | gcnext= hdr->next; 159 | mem= hdr2ptr(hdr); 160 | # if VERBOSE > 2 161 | //if ((long)hdr == 0x800248) abort(); 162 | fprintf(stderr, "MALLOC %p -> %p + %i\n", mem, hdr, (int)GC_size(mem)); 163 | # endif 164 | memset(mem, 0, hdr->size); 165 | gcMemory -= hdr->size; 166 | //if (mem == (void *)0x82dd534) { fprintf(stderr, "ALLOCATING %p\n", mem); bkpt(); } 167 | return mem; 168 | } 169 | } 170 | hdr= hdr->next; 171 | } while (hdr != org); 172 | { 173 | size_t incr= gcQuantum; 174 | size_t req= sizeof(gcheader) + lbs; 175 | while (incr <= req) incr *= 2; 176 | //fprintf(stderr, "extending by %ld => %ld @ %d\n", req, incr, (int)(gcCount - gcAllocs)); 177 | hdr= (gcheader *)malloc(incr); 178 | //fprintf(stderr, "buffer at %x\n", (int)hdr); 179 | if (hdr != (gcheader *)-1) 180 | { 181 | hdr->flags= 0; 182 | hdr->next= gcbase.next; 183 | gcbase.next= hdr; 184 | hdr->size= incr - sizeof(gcheader); 185 | #if VERBOSE 186 | fprintf(stderr, "extend by %i at %p\n", (int)hdr->size, hdr); 187 | #endif 188 | goto again; 189 | } 190 | fprintf(stderr, "GC: sbrk failed\n"); 191 | } 192 | full: 193 | fprintf(stderr, "GC: out of memory\n"); 194 | abort(); 195 | return 0; 196 | } 197 | 198 | GC_API void *GC_malloc_atomic(size_t lbs) 199 | { 200 | void *mem= GC_malloc(lbs); 201 | ptr2hdr(mem)->atom= 1; 202 | return mem; 203 | } 204 | 205 | GC_API void *GC_realloc(void *ptr, size_t lbs) 206 | { 207 | gcheader *hdr= ptr2hdr(ptr); 208 | void *mem; 209 | if (lbs <= hdr->size) return ptr; 210 | mem= GC_malloc(lbs); 211 | memcpy(mem, ptr, hdr->size); 212 | ptr2hdr(mem)->atom= hdr->atom; 213 | GC_free(ptr); 214 | return mem; 215 | } 216 | 217 | static gcheader *GC_freeHeader(gcheader *hdr) 218 | { 219 | #if VERBOSE > 2 220 | fprintf(stderr, "FREE %p -> %p %s:%ld %s\n", hdr2ptr(hdr), hdr, hdr->file, hdr->line, hdr->func); 221 | if (hdr->line == 0) { 222 | fflush(stdout); 223 | abort(); 224 | } 225 | #endif 226 | hdr->flags= 0; 227 | gcMemory += hdr->size; 228 | return hdr; 229 | } 230 | 231 | GC_API void GC_free(void *ptr) 232 | { 233 | gcnext= GC_freeHeader(ptr2hdr(ptr)); 234 | } 235 | 236 | GC_API size_t GC_size(void *ptr) 237 | { 238 | return ptr2hdr(ptr)->size; 239 | } 240 | 241 | GC_API void GC_default_pre_mark_function(void) {} 242 | 243 | GC_pre_mark_function_t GC_pre_mark_function= GC_default_pre_mark_function; 244 | 245 | GC_API void GC_default_mark_function(void *ptr) 246 | { 247 | gcheader *hdr= ptr2hdr(ptr); 248 | void **pos= ptr; 249 | void **lim= hdr2ptr(hdr) + hdr->size - sizeof(void *); 250 | while (pos <= lim) 251 | { 252 | void *field= *pos; 253 | if (field && !((long)field & 1)) 254 | GC_mark(field); 255 | ++pos; 256 | } 257 | } 258 | 259 | GC_mark_function_t GC_mark_function= GC_default_mark_function; 260 | 261 | GC_API void GC_mark(void *ptr) 262 | { 263 | if ((long)ptr & 1) return; 264 | gcheader *hdr= ptr2hdr(ptr); 265 | #if VERBOSE > 3 266 | fprintf(stderr, "mark? %p -> %p used %d atom %d mark %d\n", ptr, hdr, hdr->used, hdr->atom, hdr->mark); 267 | #endif 268 | if (!hdr->mark) { 269 | hdr->mark= 1; 270 | if (!hdr->atom) 271 | GC_mark_function(ptr); 272 | } 273 | } 274 | 275 | GC_API void GC_mark_leaf(void *ptr) 276 | { 277 | ptr2hdr(ptr)->mark= 1; 278 | } 279 | 280 | GC_free_function_t GC_free_function= 0; 281 | 282 | GC_API void GC_sweep(void) 283 | { 284 | gcheader *hdr= gcbase.next; 285 | do { 286 | #if VERBOSE > 3 287 | fprintf(stderr, "sweep? %p %d\n", hdr, hdr->flags); 288 | #endif 289 | if (hdr->flags) 290 | { 291 | if (hdr->mark) 292 | hdr->mark= 0; 293 | else { 294 | if (hdr->finalisers) { 295 | while (hdr->finalisers) { 296 | gcfinaliser *gcf= hdr->finalisers; 297 | hdr->finalisers= gcf->next; 298 | gcf->next= finalisable; 299 | finalisable= gcf; 300 | } 301 | } 302 | else { 303 | if (GC_free_function) GC_free_function(hdr2ptr(hdr)); 304 | hdr= GC_freeHeader(hdr); 305 | } 306 | } 307 | } 308 | hdr= hdr->next; 309 | } while (hdr != &gcbase); 310 | gcnext= gcbase.next; 311 | while (finalisable) 312 | { 313 | gcfinaliser *gcf= finalisable; 314 | gcf->finaliser(gcf->ptr, gcf->data); 315 | finalisable= gcf->next; 316 | free(gcf); 317 | } 318 | } 319 | 320 | static void ***roots= 0; 321 | static size_t numRoots= 0; 322 | static size_t maxRoots= 0; 323 | 324 | struct GC_StackRoot *GC_stack_roots= 0; 325 | 326 | GC_API void GC_add_root(void *root) 327 | { 328 | if (numRoots == maxRoots) 329 | roots= maxRoots 330 | ? realloc(roots, sizeof(roots[0]) * (maxRoots *= 2)) 331 | : malloc ( sizeof(roots[0]) * (maxRoots= 128)); 332 | roots[numRoots++]= (void **)root; 333 | assert(root); 334 | } 335 | 336 | GC_API void GC_delete_root(void *root) 337 | { 338 | int i; 339 | for (i= 0; i < numRoots; ++i) 340 | if (roots[i] == (void **)root) 341 | break; 342 | if (i < numRoots) 343 | { 344 | memmove(roots + i, roots + i + 1, sizeof(roots[0]) * (numRoots - i)); 345 | --numRoots; 346 | } 347 | } 348 | 349 | GC_API long GC_collections= 0; 350 | 351 | GC_API void GC_gcollect(void) 352 | { 353 | int i; 354 | struct GC_StackRoot *sr; 355 | ++GC_collections; 356 | #if !defined(NDEBUG) 357 | { 358 | # undef static 359 | static char *cursors= "-/|\\"; 360 | static int cursor= 0; 361 | if (GC_collections % 1000 == 0) { 362 | if (0 == cursors[cursor]) cursor= 0; 363 | fprintf(stderr, "%c\010", cursors[cursor]); 364 | ++cursor; 365 | } 366 | # if (NONSTATIC) 367 | # define static 368 | # endif 369 | } 370 | #endif 371 | GC_pre_mark_function(); 372 | #if VERBOSE >= 1 373 | fprintf(stderr, "*** GC: mark roots\n"); 374 | #endif 375 | for (i= 0; i < numRoots; ++i) 376 | if (*roots[i]) { 377 | # if VERBOSE >= 2 378 | fprintf(stderr, "*** GC: root %i *%p -> %p\n", i, roots[i], *roots[i]); 379 | # endif 380 | GC_mark(*roots[i]); 381 | } 382 | #if VERBOSE > 0 383 | fprintf(stderr, "*** GC: mark stack\n"); 384 | #endif 385 | for (sr= GC_stack_roots; sr; sr= sr->next) { 386 | #if VERBOSE > 2 && defined(DEBUGGC) 387 | fprintf(stderr, "*** GC: stack root %p %s %s:%ld\n", *sr->root, sr->name, sr->file, sr->line); 388 | #endif 389 | if (*(sr->root)) GC_mark(*(sr->root)); 390 | } 391 | #if VERBOSE > 0 392 | fprintf(stderr, "*** GC: sweep\n"); 393 | #endif 394 | GC_sweep(); 395 | #if VERBOSE > 0 396 | fprintf(stderr, "*** GC: done\n"); 397 | #endif 398 | } 399 | 400 | GC_API size_t GC_count_objects(void) 401 | { 402 | gcheader *hdr= gcbase.next; 403 | size_t count= 0; 404 | do { 405 | if (hdr->used) 406 | ++count; 407 | hdr= hdr->next; 408 | } while (hdr != &gcbase); 409 | return count; 410 | } 411 | 412 | GC_API size_t GC_count_bytes(void) 413 | { 414 | gcheader *hdr= gcbase.next; 415 | size_t count= 0; 416 | do { 417 | if (hdr->used) 418 | count += hdr->size; 419 | hdr= hdr->next; 420 | } while (hdr != &gcbase); 421 | return count; 422 | } 423 | 424 | GC_API double GC_count_fragments(void) 425 | { 426 | gcheader *hdr= gcbase.next; 427 | size_t used= 0; 428 | size_t free= 0; 429 | do { 430 | if (hdr->used) { 431 | ++used; 432 | //printf("%p\t%7d\n", hdr, (int)hdr->size); 433 | } 434 | else { 435 | while ((!hdr->next->used) && (hdr2ptr(hdr) + hdr->size == hdr->next)) { 436 | hdr->size += sizeof(gcheader) + hdr->next->size; 437 | hdr->next= hdr->next->next; 438 | } 439 | ++free; 440 | //printf("%p\t\t%7d\n", hdr, (int)hdr->size); 441 | } 442 | hdr= hdr->next; 443 | } while (hdr != &gcbase); 444 | return (double)free / (double)used; 445 | } 446 | 447 | GC_API void *GC_first_object(void) 448 | { 449 | gcheader *hdr= gcbase.next; 450 | while (!hdr->used && hdr != &gcbase) hdr= hdr->next; 451 | if (hdr == &gcbase) return 0; 452 | return hdr2ptr(hdr); 453 | } 454 | 455 | GC_API void *GC_next_object(void *ptr) 456 | { 457 | if (!ptr) return 0; 458 | gcheader *hdr= ptr2hdr(ptr)->next; 459 | while (!hdr->used && hdr != &gcbase) hdr= hdr->next; 460 | if (hdr == &gcbase) return 0; 461 | return hdr2ptr(hdr); 462 | } 463 | 464 | GC_API int GC_atomic(void *ptr) 465 | { 466 | return ptr2hdr(ptr)->atom; 467 | } 468 | 469 | #ifndef NDEBUG 470 | 471 | GC_API void *GC_check(void *ptr) 472 | { 473 | gcheader *hdr= ptr2hdr(ptr); 474 | if (!hdr->used) { 475 | hdr->used= 1; 476 | printf("accessible dead object %p %s:%ld %s\n", ptr, hdr->file, hdr->line, hdr->func); 477 | } 478 | return ptr; 479 | } 480 | 481 | #endif 482 | 483 | GC_API void GC_register_finaliser(void *ptr, GC_finaliser_t finaliser, void *data) 484 | { 485 | gcheader *gch = ptr2hdr(ptr); 486 | gcfinaliser *gcf = (struct _gcfinaliser *)malloc(sizeof(struct _gcfinaliser)); 487 | gcf->ptr = ptr; 488 | gcf->finaliser = finaliser; 489 | gcf->data = data; 490 | gcf->next = gch->finalisers; 491 | gch->finalisers = gcf; 492 | } 493 | 494 | #if defined(GC_SAVE) 495 | 496 | #include 497 | 498 | #define GC_MAGIC 0x4f626a4d 499 | 500 | //static void put8 (FILE *out, uint8_t value) { fwrite(&value, sizeof(value), 1, out); } 501 | //static void put16 (FILE *out, uint16_t value) { fwrite(&value, sizeof(value), 1, out); } 502 | static void put32 (FILE *out, uint32_t value) { fwrite(&value, sizeof(value), 1, out); } 503 | //static void put64 (FILE *out, uint64_t value) { fwrite(&value, sizeof(value), 1, out); } 504 | 505 | static void putobj(FILE *out, void *value) 506 | { 507 | //printf(" field %p\n", value); 508 | if (value && !((long)value & 1)) 509 | fwrite(&ptr2hdr(value)->finalisers, sizeof(void *), 1, out); 510 | else 511 | fwrite(&value, sizeof(void *), 1, out); 512 | } 513 | 514 | GC_API void GC_saver(FILE *out, void *ptr) 515 | { 516 | gcheader *hdr= ptr2hdr(ptr); 517 | if (out) { 518 | if (hdr->atom) 519 | fwrite(hdr2ptr(hdr), hdr->size, 1, out); 520 | else { 521 | int i; 522 | for (i= 0; i < hdr->size; i += sizeof(void *)) 523 | putobj(out, *(void **)(ptr + i)); 524 | } 525 | } 526 | } 527 | 528 | GC_API void GC_save(FILE *out, void (*saver)(FILE *, void *)) 529 | { 530 | long numObjs= 0; 531 | long numBytes= 0; 532 | gcheader *hdr= gcbase.next; 533 | int i; 534 | if (!saver) saver= GC_saver; 535 | do { 536 | if (hdr->used) { 537 | hdr->finalisers= (void *)(numBytes + sizeof(gcheader)); 538 | numBytes += sizeof(gcheader) + hdr->size; 539 | ++numObjs; 540 | } 541 | hdr= hdr->next; 542 | } while (hdr != &gcbase); 543 | printf("saving %ld bytes, %ld objects, %ld roots\n", numBytes, numObjs, (long)numRoots); 544 | put32(out, GC_MAGIC); 545 | put32(out, numObjs); 546 | put32(out, numBytes); 547 | hdr= gcbase.next; 548 | do { 549 | if (hdr->used) { 550 | //printf("writing object %p -> %p\n", hdr2ptr(hdr), hdr->finalisers); 551 | put32(out, hdr->size); 552 | put32(out, hdr->flags); 553 | saver(out, hdr2ptr(hdr)); 554 | --numObjs; 555 | } 556 | hdr= hdr->next; 557 | } while (hdr != &gcbase); assert(numObjs == 0); 558 | put32(out, GC_MAGIC + 1); 559 | put32(out, numRoots); 560 | for (i= 0; i < numRoots; ++i) { 561 | void *p= *roots[i]; 562 | //printf("writing root %p -> %p\n", roots[i], p); 563 | putobj(out, p); 564 | } 565 | put32(out, GC_MAGIC + 2); 566 | hdr= gcbase.next; 567 | do { 568 | hdr->finalisers= 0; 569 | hdr= hdr->next; 570 | } while (hdr != &gcbase); 571 | } 572 | 573 | static int32_t get32(FILE *in, int32_t *p) { if(fread(p, sizeof(*p), 1, in)); return *p; } 574 | 575 | static void *getobj(FILE *in, void **value) 576 | { 577 | if (fread(value, sizeof(void *), 1, in)); 578 | if (*value && !(((long)*value) & 1)) *value += (long)gcbase.next; 579 | //printf(" field %p\n", *value); 580 | return *value; 581 | } 582 | 583 | GC_API void GC_loader(FILE *in, void *ptr) 584 | { 585 | gcheader *hdr= ptr2hdr(ptr); 586 | if (hdr->atom) { if (fread(hdr2ptr(hdr), hdr->size, 1, in)); } 587 | else { int i; for (i= 0; i < hdr->size; i += sizeof(void *)) getobj(in, ptr + i); } 588 | } 589 | 590 | GC_API int GC_load(FILE *in, void (*loader)(FILE *, void*)) 591 | { 592 | int32_t magic = 0; 593 | int32_t numObjs = 0; 594 | int32_t numBytes = 0; 595 | int32_t tmp32; 596 | int i; 597 | if (!loader) loader= GC_loader; 598 | if (get32(in, &magic) != GC_MAGIC) return 0; 599 | get32(in, &numObjs); 600 | get32(in, &numBytes); 601 | //printf("loading %i bytes, %i objects\n", (int)numBytes, (int)numObjs); 602 | gcheader *hdr= (gcheader *)malloc(numBytes + sizeof(gcheader)); 603 | memset(hdr, 0, numBytes + sizeof(gcheader)); 604 | if (!hdr) { 605 | fprintf(stderr, "GC_load: could not allocate %i bytes\n", numBytes); 606 | exit(1); 607 | } 608 | gcbase.next= hdr; 609 | hdr->flags= 0; 610 | hdr->next= &gcbase; 611 | hdr->size= numBytes; 612 | while (numObjs--) { 613 | void *ptr= hdr2ptr(hdr); 614 | //printf("reading object %p -> %p\n", hdr2ptr(hdr) - (long)gcbase.next, hdr2ptr(hdr)); 615 | hdr->size= get32(in, &tmp32); 616 | hdr->flags= get32(in, &tmp32); 617 | loader(in, hdr2ptr(hdr)); 618 | numBytes -= sizeof(gcheader) + hdr->size; assert(numBytes >= 0); 619 | hdr->next= ptr + hdr->size; 620 | hdr= hdr->next; 621 | hdr->flags= 0; 622 | hdr->next= &gcbase; 623 | hdr->size= numBytes; 624 | }; assert(numBytes == 0); 625 | get32(in, &tmp32); 626 | assert(tmp32 == GC_MAGIC + 1); 627 | if (numRoots != get32(in, &tmp32)) { 628 | fprintf(stderr, "GC_load: wrong number of roots (expected %i, found %i)\n", (int)numRoots, (int)tmp32); 629 | exit(1); 630 | } 631 | for (i= 0; i < numRoots; ++i) getobj(in, roots[i]); 632 | get32(in, &tmp32); 633 | assert(tmp32 == GC_MAGIC + 2); 634 | return 1; 635 | } 636 | 637 | #endif 638 | 639 | #if 0 640 | 641 | #undef VERBOSE 642 | //#define VERBOSE 1 643 | 644 | #include 645 | 646 | long objs= 0, bytes= 0; 647 | 648 | #define RAND(N) ({ long n= (1 + (int)((float)N * (rand() / (RAND_MAX + 1.0)))); bytes += n; n; }) 649 | 650 | struct cell { int tag; struct cell *next; }; 651 | 652 | void *mklist(int n) 653 | { 654 | struct cell *cell; 655 | if (!n) return 0; 656 | cell= GC_malloc(8); ++objs; bytes += 8; 657 | GC_PROTECT(cell); 658 | cell->tag= n << 1 | 1; 659 | cell->next= mklist(n - 1); 660 | GC_UNPROTECT(cell); 661 | return cell; 662 | } 663 | 664 | void delist(struct cell *cell) 665 | { 666 | if (cell && cell->next && cell->next->next) { 667 | cell->next= cell->next->next; 668 | delist(cell->next->next); 669 | } 670 | } 671 | 672 | int main() 673 | { 674 | int i, j; 675 | void *a, *b, *c, *d, *e; 676 | for (i= 0; i < 10000; ++i) { 677 | a= 0; GC_PROTECT(a); 678 | b= 0; GC_PROTECT(b); 679 | c= 0; GC_PROTECT(c); 680 | d= 0; GC_PROTECT(d); 681 | e= 0; GC_PROTECT(e); 682 | #if !VERBOSE 683 | # define printf(...) 684 | #endif 685 | //#define GC_malloc malloc 686 | //#define GC_free free 687 | a= GC_malloc(RAND(1)); printf("%p\n", a); ++objs; 688 | b= GC_malloc(RAND(10)); printf("%p\n", b); ++objs; 689 | c= GC_malloc(RAND(100)); printf("%p\n", c); ++objs; 690 | d= GC_malloc(RAND(1000)); printf("%p\n", d); ++objs; 691 | e= GC_malloc(RAND(10000)); printf("%p\n", e); ++objs; 692 | GC_free(a); a= 0; 693 | GC_free(b); b= 0; 694 | // GC_free(c); 695 | GC_free(d); d= 0; 696 | GC_free(e); e= 0; 697 | a= GC_malloc(RAND(100)); printf("%p\n", a); ++objs; 698 | b= GC_malloc(RAND(200)); printf("%p\n", b); ++objs; 699 | c= GC_malloc(RAND(300)); printf("%p\n", c); ++objs; 700 | d= GC_malloc(RAND(400)); printf("%p\n", d); ++objs; 701 | e= GC_malloc(RAND(500)); printf("%p\n", e); ++objs; 702 | GC_free(e); e= 0; 703 | GC_free(d); d= 0; 704 | // GC_free(c); 705 | GC_free(b); b= 0; 706 | GC_free(a); a= 0; 707 | a= GC_malloc(RAND(4)); printf("%p\n", a); ++objs; 708 | b= GC_malloc(RAND(16)); printf("%p\n", b); ++objs; 709 | c= GC_malloc(RAND(64)); printf("%p\n", c); ++objs; 710 | d= GC_malloc(RAND(256)); printf("%p\n", d); ++objs; 711 | e= GC_malloc(RAND(1024)); printf("%p\n", e); ++objs; 712 | GC_free(e); e= 0; 713 | GC_free(b); b= 0; 714 | // GC_free(c); 715 | GC_free(d); d= 0; 716 | GC_free(a); a= 0; 717 | a= GC_malloc(RAND(713)); printf("%p\n", a); ++objs; 718 | b= GC_malloc(RAND(713)); printf("%p\n", b); ++objs; 719 | c= GC_malloc(RAND(713)); printf("%p\n", c); ++objs; 720 | d= GC_malloc(RAND(713)); printf("%p\n", d); ++objs; 721 | e= GC_malloc(RAND(713)); printf("%p\n", e); ++objs; 722 | GC_free(a); a= 0; 723 | GC_free(c); c= 0; 724 | // GC_free(e); 725 | GC_free(d); d= 0; 726 | GC_free(b); b= 0; 727 | #undef printf 728 | if (i % 1000 == 0) printf("alloc: %ld bytes in %ld objects; alive: %ld bytes in %ld objects\n", bytes, objs, GC_count_bytes(), GC_count_objects()); 729 | GC_gcollect(); 730 | if (i % 1000 == 0) printf(" gc: %ld bytes in %ld objects; alive: %ld bytes in %ld objects\n", bytes, objs, GC_count_bytes(), GC_count_objects()); 731 | GC_UNPROTECT(a); 732 | } 733 | { 734 | a= 0; 735 | GC_PROTECT(a); 736 | for (i= 0; i < 10; ++i) { 737 | for (j= 0; j < 100; ++j) { 738 | a= mklist(2000); 739 | delist(a); 740 | #if VERBOSE 741 | { 742 | struct cell *c= a; 743 | printf("----\n"); 744 | while (c) { 745 | printf("%p %d %p\n", c, c->tag >> 1, c->next); 746 | c= c->next; 747 | } 748 | } 749 | #endif 750 | } 751 | printf("alloc: %ld bytes in %ld objects; alive: %ld bytes in %ld objects\n", bytes, objs, GC_count_bytes(), GC_count_objects()); 752 | GC_gcollect(); 753 | printf(" gc: %ld bytes in %ld objects; alive: %ld bytes in %ld objects\n", bytes, objs, GC_count_bytes(), GC_count_objects()); 754 | } 755 | GC_UNPROTECT(a); 756 | } 757 | printf("alive: %ld bytes in %ld objects\n", GC_count_bytes(), GC_count_objects()); 758 | GC_gcollect(); 759 | printf(" gc: %ld bytes in %ld objects\n", GC_count_bytes(), GC_count_objects()); 760 | printf(" gc: %ld collections\n", GC_collections); 761 | return 0; 762 | } 763 | 764 | #endif 765 | -------------------------------------------------------------------------------- /csrc/gc.h: -------------------------------------------------------------------------------- 1 | #ifndef _GC_H_ 2 | #define _GC_H_ 3 | 4 | struct GC_StackRoot 5 | { 6 | void **root; 7 | struct GC_StackRoot *next; 8 | #if !defined(NDEBUG) 9 | int live; 10 | const char *name; 11 | const char *file; 12 | long line; 13 | #endif 14 | }; 15 | 16 | #if defined(NDEBUG) 17 | # define GC_PROTECT(V) struct GC_StackRoot _sr_##V; _sr_##V.root= (void *)&V; GC_push_root(&_sr_##V) 18 | # define GC_UNPROTECT(V) GC_pop_root(&_sr_##V) 19 | #else 20 | # define GC_PROTECT(V) struct GC_StackRoot _sr_##V; _sr_##V.root= (void *)&V; GC_push_root(&_sr_##V, #V, __FILE__, __LINE__) 21 | # define GC_UNPROTECT(V) GC_pop_root(&_sr_##V, #V, __FILE__, __LINE__) 22 | #endif 23 | 24 | 25 | #define GC_INIT() 26 | #define GC_init() 27 | 28 | #if !defined(GC_API) 29 | # define GC_API 30 | #endif 31 | 32 | GC_API void *GC_malloc(size_t nbytes); 33 | GC_API void *GC_malloc_atomic(size_t nbytes); 34 | GC_API void *GC_realloc(void *ptr, size_t lbs); 35 | GC_API void GC_free(void *ptr); 36 | GC_API size_t GC_size(void *ptr); 37 | GC_API void GC_add_root(void *root); 38 | GC_API void GC_delete_root(void *root); 39 | GC_API void GC_mark(void *ptr); 40 | GC_API void GC_mark_leaf(void *ptr); 41 | GC_API void GC_sweep(void); 42 | GC_API void GC_gcollect(void); 43 | GC_API size_t GC_count_objects(void); 44 | GC_API size_t GC_count_bytes(void); 45 | GC_API double GC_count_fragments(void); 46 | 47 | GC_API void *GC_first_object(void); 48 | GC_API void *GC_next_object(void *prev); 49 | 50 | GC_API int GC_atomic(void *ptr); 51 | 52 | #ifndef NDEBUG 53 | GC_API void *GC_check(void *ptr); 54 | GC_API void *GC_stamp(void *ptr, const char *file, long line, const char *func); 55 | GC_API const char *GC_file(void *ptr); 56 | GC_API long GC_line(void *ptr); 57 | GC_API const char *GC_function(void *ptr); 58 | #else 59 | # define GC_check(PTR) (PTR) 60 | # define GC_stamp(PTR, FILE, LINE, FUNC) (PTR) 61 | # define GC_file(PTR) "?" 62 | # define GC_line(PTR) 0 63 | # define GC_function(PTR) "?" 64 | #endif 65 | 66 | typedef void (*GC_finaliser_t)(void *ptr, void *data); 67 | 68 | GC_API void GC_register_finaliser(void *ptr, GC_finaliser_t finaliser, void *data); 69 | 70 | extern struct GC_StackRoot *GC_stack_roots; 71 | 72 | #if defined(NDEBUG) 73 | 74 | GC_API inline void GC_push_root(struct GC_StackRoot *sr) 75 | { 76 | sr->next= GC_stack_roots; 77 | GC_stack_roots= sr; 78 | } 79 | 80 | GC_API inline void GC_pop_root(struct GC_StackRoot *sr) 81 | { 82 | # if 0 83 | GC_stack_roots= sr->next; 84 | # else /* paranoid version for broken code warns of mismatched pops with a SEGV */ 85 | struct GC_StackRoot *nr= sr->next; 86 | while (nr != GC_stack_roots) GC_stack_roots= GC_stack_roots->next; 87 | # endif 88 | } 89 | 90 | #else 91 | 92 | GC_API inline void GC_push_root(struct GC_StackRoot *sr, const char *name, const char *file, int line) 93 | { 94 | sr->next= GC_stack_roots; 95 | sr->name= name; 96 | sr->file= file; 97 | sr->line= line; 98 | sr->live= 1; 99 | GC_stack_roots= sr; 100 | } 101 | 102 | static int GC_roots_include(struct GC_StackRoot *roots, struct GC_StackRoot *root) 103 | { 104 | while (roots) { 105 | if (roots == root) return 1; 106 | roots= roots->next; 107 | } 108 | return 0; 109 | } 110 | 111 | GC_API inline void GC_pop_root(struct GC_StackRoot *sr, const char *name, const char *file, int line) 112 | { 113 | struct GC_StackRoot *nr= sr->next; 114 | struct GC_StackRoot *gr= GC_stack_roots; 115 | if (!sr->live) { fprintf(stderr, "*** %s %d %s: STALE POP IN GC_pop_root\n", file, line, name); goto die; } 116 | sr->live= 0; 117 | if (GC_roots_include(nr, sr)) { fprintf(stderr, "*** %s %d %s: CYCLE IN GC_pop_root\n", file, line, name); goto die; } 118 | int n= 0; 119 | while (nr != gr) { 120 | if (n++ > 10) { fprintf(stderr, "*** %s %d %s: LOOP IN GC_pop_root\n", file, line, name); goto die; } 121 | gr= gr->next; 122 | } 123 | GC_stack_roots= gr; 124 | return; 125 | die: 126 | fprintf(stderr, "* gc stack roots = %p %s %ld %s\n", gr, gr->file, gr->line, gr->name); 127 | fprintf(stderr, "* popped root = %p %s %ld %s\n", sr, sr->file, sr->line, sr->name); 128 | while (nr) { 129 | fprintf(stderr, "* next root = %p %s %ld %s\n", nr, nr ? nr->file : 0, nr ? nr->line : 0, nr ? nr->name : 0); 130 | nr= nr->next; 131 | } 132 | abort(); 133 | } 134 | 135 | #endif 136 | 137 | typedef void (*GC_pre_mark_function_t)(void); 138 | extern GC_pre_mark_function_t GC_pre_mark_function; 139 | 140 | typedef void (*GC_mark_function_t)(void *ptr); 141 | extern GC_mark_function_t GC_mark_function; 142 | 143 | typedef void (*GC_free_function_t)(void *ptr); 144 | extern GC_free_function_t GC_free_function; 145 | 146 | #if defined(GC_SAVE) 147 | # include 148 | GC_API void GC_saver (FILE *out, void *ptr); 149 | GC_API void GC_save (FILE *out, void (*saver)(FILE *, void *)); 150 | GC_API void GC_loader(FILE *in, void *ptr); 151 | GC_API int GC_load (FILE *in, void (*loader)(FILE *, void*)); 152 | #endif 153 | 154 | #endif /* _GC_H_ */ 155 | -------------------------------------------------------------------------------- /csrc/libgc.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | struct _header 4 | { 5 | GC_APP_HEADER 6 | int size; 7 | }; 8 | 9 | #define hdr2ptr(ptr) ((void *)((struct _header *)(ptr) + 1)) 10 | #define ptr2hdr(ptr) ( ((struct _header *)(ptr) - 1)) 11 | 12 | static inline void *GC_malloc_z(size_t size) 13 | { 14 | struct _header *hdr= GC_malloc(sizeof(struct _header) + size); 15 | memset(hdr, 0, sizeof(struct _header) + size); 16 | hdr->size= size; 17 | return hdr2ptr(hdr); 18 | } 19 | 20 | static inline void *GC_malloc_atomic_z(size_t size) 21 | { 22 | struct _header *hdr= GC_malloc(sizeof(struct _header) + size); 23 | memset(hdr, 0, sizeof(struct _header) + size); 24 | hdr->size= size; 25 | return hdr2ptr(hdr); 26 | } 27 | 28 | static inline void *GC_realloc_z(void *ptr, size_t size) 29 | { 30 | struct _header *hdr= GC_realloc(ptr2hdr(ptr), sizeof(struct _header) + size); 31 | return hdr2ptr(hdr); 32 | } 33 | 34 | #define FUDGE 0 35 | 36 | #define GC_malloc(size) GC_malloc_z(size) 37 | #define GC_malloc_atomic(size) GC_malloc_atomic_z(size) 38 | #define GC_realloc(ptr, size) GC_realloc_z(ptr, size) 39 | 40 | #define GC_size(ptr) (ptr2hdr(ptr)->size) 41 | #define GC_atomic(obj) (ptr2hdr(obj)->type == Long || ptr2hdr(obj)->type == Double || ptr2hdr(obj)->type == Symbol || ptr2hdr(obj)->type == Subr) 42 | 43 | #define GC_add_root(oopp) 44 | 45 | #define GC_PROTECT(obj) 46 | #define GC_UNPROTECT(obj) 47 | -------------------------------------------------------------------------------- /csrc/wcs.c: -------------------------------------------------------------------------------- 1 | #define _WIDEN(x) L ## x 2 | #define WIDEN(x) _WIDEN(x) 3 | 4 | #include 5 | #include 6 | 7 | static wchar_t *mbs2wcs(char *mbs) 8 | { 9 | static wchar_t *wcs= 0; 10 | static size_t bufSize= 0; 11 | size_t len= strlen(mbs) + 1; 12 | if (bufSize < len) 13 | { 14 | wcs= wcs ? (wchar_t *)realloc(wcs, sizeof(wchar_t) * len) : (wchar_t *)malloc(sizeof(wchar_t) * len); 15 | bufSize= len; 16 | } 17 | mbstowcs(wcs, mbs, bufSize); 18 | return wcs; 19 | } 20 | 21 | static char *wcs2mbs(wchar_t *wcs) 22 | { 23 | typedef struct { char *mbs; size_t size; } buf_t; 24 | static buf_t bufs[32]= {{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0},{0,0}}; 25 | static int bufn= 0; 26 | buf_t *buf= bufs + bufn++; 27 | if (bufn == 32) bufn= 0; 28 | size_t len= 6 * wcslen(wcs) + 1; 29 | if (buf->size < len) { 30 | buf->mbs= buf->mbs ? (char *)realloc(buf->mbs, len) : (char *)malloc(len); 31 | buf->size= len; 32 | } 33 | wcstombs(buf->mbs, wcs, buf->size); 34 | return buf->mbs; 35 | } 36 | 37 | 38 | #if defined(__MACH__) && !defined(__MAC_10_7) 39 | 40 | static wchar_t *wcsdup(wchar_t *s) 41 | { 42 | size_t len= wcslen(s) + 1; 43 | wchar_t *t= malloc(sizeof(wchar_t) * len); 44 | if (t) wcscpy(t, s); 45 | return t; 46 | } 47 | 48 | #endif 49 | 50 | 51 | #if 0 52 | 53 | static void wperror(wchar_t *s) 54 | { 55 | perror(wcs2mbs(s)); 56 | } 57 | 58 | static FILE *wfopen(wchar_t *wpath, wchar_t *wmode) 59 | { 60 | size_t pathlen= wcslen(wpath), modelen= wcslen(wmode); 61 | char *path= malloc(sizeof(wchar_t) * (pathlen + 1)); wcstombs(path, wpath, pathlen); 62 | char *mode= malloc(sizeof(wchar_t) * (modelen + 1)); wcstombs(mode, wmode, modelen); 63 | FILE *fp= fopen(path, mode); 64 | free(path); 65 | free(mode); 66 | return fp; 67 | } 68 | 69 | #endif 70 | -------------------------------------------------------------------------------- /doc/IA32.txt: -------------------------------------------------------------------------------- 1 | suffixes: 2 | l = 4 bytes 3 | b = 1 byte 4 | 5 | condition codes: 6 | CF = carry flag 7 | ZF = zero flag 8 | SF = sign flag 9 | OF = overflow flag 10 | 11 | memory reference: 12 | displacement(base register, offset register, scalar) 13 | 4(%eax, %edx, 2) = [eax + 4 + edx * 2] 14 | 15 |