conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* restructuring .../bin

This commit is contained in:
Abdulaziz Ghuloum 2007-10-17 09:22:47 -04:00
parent 90bf017e61
commit 63c7e7f1d3
19 changed files with 297 additions and 504 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
bin/Makefile
View File

@ -11,54 +11,51 @@ endif
objects = ikarus-collect.o ikarus-runtime.o ikarus-main.o ikarus-fasl.o \
ikarus-exec.o ikarus-print.o ikarus-enter.o ikarus-symbol-table.o \
ikarus-weak-pairs.o ikarus-numerics.o ikarus-flonums.o \
verify-integrity.o winmmap.o
ikarus-verify-integrity.o ikarus-winmmap.o
all: ikarus
ikarus: $(objects)
$(CC) -o ikarus $(objects) $(LDFLAGS)
ikarus-main.o: ikarus-main.c ikarus.h
ikarus-main.o: ikarus-main.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-main.c
ikarus-enter.o: ikarus-enter.s ikarus.h
ikarus-enter.o: ikarus-enter.s ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-enter.s
ikarus-runtime.o: ikarus-runtime.c ikarus.h
ikarus-runtime.o: ikarus-runtime.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-runtime.c
ikarus-fasl.o: ikarus-fasl.c ikarus.h
ikarus-fasl.o: ikarus-fasl.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-fasl.c
verify-integrity.o: verify-integrity.c ikarus.h
$(CC) $(CFLAGS) -c verify-integrity.c
ikarus-verify-integrity.o: ikarus-verify-integrity.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-verify-integrity.c
ikarus-exec.o: ikarus-exec.c ikarus.h
ikarus-exec.o: ikarus-exec.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-exec.c
ikarus-print.o: ikarus-print.c ikarus.h
ikarus-print.o: ikarus-print.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-print.c
ikarus-collect.o: ikarus-collect.c ikarus.h
ikarus-collect.o: ikarus-collect.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-collect.c
ikarus-weak-pairs.o: ikarus-weak-pairs.c ikarus.h
ikarus-weak-pairs.o: ikarus-weak-pairs.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-weak-pairs.c
ikarus-symbol-table.o: ikarus-symbol-table.c ikarus.h
ikarus-symbol-table.o: ikarus-symbol-table.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-symbol-table.c
ikarus-numerics.o: ikarus-numerics.c ikarus.h
ikarus-numerics.o: ikarus-numerics.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-numerics.c
ikarus-flonums.o: ikarus-flonums.c ikarus.h
ikarus-flonums.o: ikarus-flonums.c ikarus-data.h
$(CC) $(CFLAGS) -c ikarus-flonums.c
winmmap.o: winmmap.c winmmap.h
$(CC) $(CFLAGS) -c winmmap.c
ikarus.h: ikarus-data.h
touch ikarus.h
ikarus-winmmap.o: ikarus-winmmap.c ikarus-winmmap.h
$(CC) $(CFLAGS) -c ikarus-winmmap.c
clean:
rm -f $(objects)

BIN
bin/ikarus
View File

Binary file not shown.

2
bin/ikarus-collect.c
View File

@ -1,5 +1,5 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <stdlib.h>
#include <stdio.h>
#include <stdint.h>

189
bin/ikarus-data.h
View File

@ -1,5 +1,187 @@
#ifndef IKARUS_DATA_H
#define IKARUS_DATA_H
#ifndef IKARUS_H
#define IKARUS_H
#include <stdio.h>
#include <sys/resource.h>
extern int total_allocated_pages;
extern int total_malloced;
extern int hash_table_count;
#define cardsize 512
#define cards_per_page 8
#define most_bytes_in_minor 0x10000000
#define old_gen_mask 0x00000007
#define new_gen_mask 0x00000008
#define gen_mask 0x0000000F
#define new_gen_tag 0x00000008
#define meta_dirty_mask 0x000000F0
#define type_mask 0x00000F00
#define scannable_mask 0x0000F000
#define dealloc_mask 0x000F0000
#define large_object_mask 0x00100000
#define meta_dirty_shift 4
#define hole_type 0x00000000
#define mainheap_type 0x00000100
#define mainstack_type 0x00000200
#define pointers_type 0x00000300
#define dat_type 0x00000400
#define code_type 0x00000500
#define weak_pairs_type 0x00000600
#define symbols_type 0x00000700
#define scannable_tag 0x00001000
#define unscannable_tag 0x00000000
#define dealloc_tag_un 0x00010000
#define dealloc_tag_at 0x00020000
#define retain_tag 0x00000000
#define large_object_tag 0x00100000
#define hole_mt (hole_type | unscannable_tag | retain_tag)
#define mainheap_mt (mainheap_type | unscannable_tag | retain_tag)
#define mainstack_mt (mainstack_type | unscannable_tag | retain_tag)
#define pointers_mt (pointers_type | scannable_tag | dealloc_tag_un)
#define symbols_mt (symbols_type | scannable_tag | dealloc_tag_un)
#define data_mt (dat_type | unscannable_tag | dealloc_tag_un)
#define code_mt (code_type | scannable_tag | dealloc_tag_un)
#define weak_pairs_mt (weak_pairs_type | scannable_tag | dealloc_tag_un)
static int
inthash(int key) {
key += ~(key << 15);
key ^= (key >> 10);
key += (key << 3);
key ^= (key >> 6);
key += ~(key << 11);
key ^= (key >> 16);
return key;
return inthash(key);
}
#define wordsize 4
#define wordshift 2
#define pagesize 4096
#define generation_count 5 /* generations 0 (nursery), 1, 2, 3, 4 */
typedef unsigned char* ikp;
void ik_error(ikp args);
typedef struct ikpage{
ikp base;
struct ikpage* next;
} ikpage;
typedef struct ikpages{
ikp base;
int size;
struct ikpages* next;
} ikpages;
typedef struct ikdl{ /* double-link */
struct ikdl* prev;
struct ikdl* next;
} ikdl;
#define ik_ptr_page_size \
((pagesize - sizeof(int) - sizeof(struct ik_ptr_page*))/sizeof(ikp))
typedef struct ik_ptr_page{
int count;
struct ik_ptr_page* next;
ikp ptr[ik_ptr_page_size];
} ik_ptr_page;
typedef struct ikpcb{
/* the first locations may be accessed by some */
/* compiled code to perform overflow/underflow ops */
ikp allocation_pointer; /* offset = 0 */
ikp allocation_redline; /* offset = 4 */
ikp frame_pointer; /* offset = 8 */
ikp frame_base; /* offset = 12 */
ikp frame_redline; /* offset = 16 */
ikp next_k; /* offset = 20 */
void* system_stack; /* offset = 24 */
unsigned int* dirty_vector; /* offset = 28 */
ikp arg_list; /* offset = 32 */
int engine_counter; /* offset = 36 */
int interrupted; /* offset = 40 */
ikp base_rtd; /* offset = 44 */
ikp collect_key; /* offset = 48 */
/* the rest are not used by any scheme code */
/* they only support the runtime system (gc, etc.) */
unsigned int* segment_vector;
ikp weak_pairs_ap;
ikp weak_pairs_ep;
ikp heap_base;
int heap_size;
ikpages* heap_pages;
ikpage* cached_pages; /* pages cached so that we don't map/unmap */
ikpage* uncached_pages; /* ikpages cached so that we don't malloc/free */
ikp cached_pages_base;
int cached_pages_size;
ikp stack_base;
int stack_size;
ikp symbol_table;
ikp gensym_table;
ik_ptr_page* guardians[generation_count];
ik_ptr_page* guardians_dropped[generation_count];
unsigned int* dirty_vector_base;
unsigned int* segment_vector_base;
unsigned char* memory_base;
unsigned char* memory_end;
int collection_id;
int allocation_count_minor;
int allocation_count_major;
struct timeval collect_utime;
struct timeval collect_stime;
struct timeval collect_rtime;
} ikpcb;
void ikarus_usage_short(void);
void* ik_malloc(int);
void ik_free(void*, int);
void* ik_mmap(int);
void* ik_mmap_typed(int size, unsigned int type, ikpcb*);
void* ik_mmap_ptr(int size, int gen, ikpcb*);
void* ik_mmap_data(int size, int gen, ikpcb*);
void* ik_mmap_code(int size, int gen, ikpcb*);
void* ik_mmap_mixed(int size, ikpcb*);
void ik_munmap(void*, int);
void ik_munmap_from_segment(unsigned char*, int, ikpcb*);
ikpcb* ik_make_pcb();
void ik_delete_pcb(ikpcb*);
void ik_free_symbol_table(ikpcb* pcb);
void ik_fasl_load(ikpcb* pcb, char* filename);
void ik_relocate_code(ikp);
ikp ik_exec_code(ikpcb* pcb, ikp code_ptr);
void ik_print(ikp x);
void ik_fprint(FILE*, ikp x);
ikp ikrt_string_to_symbol(ikp, ikpcb*);
ikp ikrt_strings_to_gensym(ikp, ikp, ikpcb*);
ikp ik_cstring_to_symbol(char*, ikpcb*);
ikp ik_asm_enter(ikpcb*, ikp code_object, ikp arg);
ikp ik_asm_reenter(ikpcb*, ikp code_object, ikp val);
ikp ik_underflow_handler(ikpcb*);
ikp ik_alloc(ikpcb* pcb, int size);
#define IK_FASL_HEADER "#@IK01"
#define IK_FASL_HEADER_LEN (strlen(IK_FASL_HEADER))
@ -242,4 +424,7 @@
#define disp_ratnum_den 8
#define disp_ratnum_unused 12
#define ik_eof_p(x) ((x) == ik_eof_object)
#define page_index(x) (((unsigned int)(x)) >> pageshift)
#endif

2
bin/ikarus-exec.c
View File

@ -1,4 +1,4 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>

18
bin/ikarus-fasl.c
View File

@ -1,6 +1,6 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
@ -66,7 +66,11 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
void ik_fasl_load(ikpcb* pcb, char* fasl_file){
int fd = open(fasl_file, O_RDONLY);
if(fd == -1){
fprintf(stderr, "failed to open %s: %s\n", fasl_file, strerror(errno));
fprintf(stderr,
"ikarus: failed to open boot file \"%s\": %s\n",
fasl_file,
strerror(errno));
ikarus_usage_short();
exit(-1);
}
int filesize;
@ -74,7 +78,10 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
struct stat buf;
int err = fstat(fd, &buf);
if(err != 0){
fprintf(stderr, "failed to stat %s: %s\n", fasl_file, strerror(errno));
fprintf(stderr,
"ikarus: failed to stat \"%s\": %s\n",
fasl_file,
strerror(errno));
exit(-1);
}
filesize = buf.st_size;
@ -88,7 +95,10 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
fd,
0);
if(mem == MAP_FAILED){
fprintf(stderr, "Mapping failed for %s: %s\n", fasl_file, strerror(errno));
fprintf(stderr,
"ikarus: mapping failed for %s: %s\n",
fasl_file,
strerror(errno));
exit(-1);
}
fasl_port p;

2
bin/ikarus-flonums.c
View File

@ -1,5 +1,5 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <stdlib.h>
#include <string.h>
#include <errno.h>

76
bin/ikarus-main.c
View File

@ -1,6 +1,6 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
@ -15,6 +15,39 @@
void register_handlers();
void register_alt_stack();
void ikarus_usage_short(){
fprintf(stderr, "ikarus -h for more help\n");
}
void ikarus_usage(){
static char* helpstring =
"\n\
Options for running ikarus scheme:\n\
\n ikarus -h\n\
Prints this help message then exits.\n\
\n ikarus [-b <bootfile>] --r6r-script <scriptfile> opts ...\n\
Starts ikarus in r6rs-script mode. The script file is treated\n\
as an R6RS-script. The options opts ... can be obtained using\n\
the \"command-line\" procedure in the (rnrs programs) library.\n\
\n ikarus [-b <bootfile>] <file> ... [-- opts ...]\n\
Starts ikarus in interactive mode. Each of the files is first\n\
loaded into the interaction environment before the interactive\n\
repl is started. The options opts can be obtained using the\n\
\"command-line\" procedure.\n\
\n\
If the option [-b <bootfile>] is provided, the bootfile is used\n\
as the system's initial boot file from which the environment is\n\
initialized. If the -b option is not supplied, the default boot\n\
file (ikarus.boot if the executable name is ikarus) is used based\n\
on where the executable file is located in the PATH. If ikarus\n\
was invoked using a path (e.g. ./ikarus or /bin/ikarus), then the\n\
PATH is not searched, instead, the path to the executable is used\n\
to locate the boot file (e.g. ./ikarus.boot or /bin/ikarus.boot).\n\
Consult the ikarus manual for more details.\n\n";
fprintf(stderr, helpstring);
}
ikpcb* the_pcb;
/* get_option
@ -38,7 +71,10 @@ get_option(char* opt, int argc, char** argv){
return rv;
}
else {
fprintf(stderr, "Error: option %s not provided\n", opt);
fprintf(stderr,
"ikarus error: option %s requires a value, none provided\n",
opt);
ikarus_usage_short();
exit(-1);
}
}
@ -49,6 +85,25 @@ get_option(char* opt, int argc, char** argv){
return 0;
}
int
get_option0(char* opt, int argc, char** argv){
int i;
for(i=1; i<argc; i++){
if(strcmp(opt, argv[i]) == 0){
int j;
for(j=i+1; j<argc; j++, i++){
argv[i] = argv[j];
}
return 1;
}
else if(strcmp("--", argv[i]) == 0){
return 0;
}
}
return 0;
}
int
file_exists(char* filename){
struct stat sb;
@ -93,6 +148,10 @@ static char* mystpcpy(char* x, char* y){
int main(int argc, char** argv){
if(get_option0("-h", argc, argv)){
ikarus_usage();
exit(0);
}
char buff[FILENAME_MAX];
char* boot_file = get_option("-b", argc, argv);
if(boot_file){
@ -102,7 +161,10 @@ int main(int argc, char** argv){
/* search path name */
char* path = getenv("PATH");
if(path == NULL){
fprintf(stderr, "unable to locate boot file\n");
fprintf(stderr,
"ikarus: unable to locate boot file in PATH=%s\n",
path);
ikarus_usage_short();
exit(-1);
}
while(*path){
@ -119,7 +181,11 @@ int main(int argc, char** argv){
if(path[len]){
path += (len+1);
} else {
fprintf(stderr, "unable to locate %s\n", argv[0]);
fprintf(stderr,
"ikarus: unable to locate executable \"%s\" in PATH=%s\n",
argv[0],
getenv("PATH"));
ikarus_usage_short();
exit(-1);
}
}
@ -132,8 +198,6 @@ int main(int argc, char** argv){
boot_file = buff;
}
if(sizeof(mp_limb_t) != sizeof(int)){
fprintf(stderr, "ERROR: limb size\n");
}

2
bin/ikarus-numerics.c
View File

@ -1,5 +1,5 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <stdlib.h>
#include <stdio.h>
#include <string.h>

2
bin/ikarus-print.c
View File

@ -1,6 +1,6 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <stdio.h>
#include <stdlib.h>

4
bin/ikarus-runtime.c
View File

@ -1,4 +1,4 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <time.h>
#include <stdio.h>
#include <stdlib.h>
@ -255,7 +255,7 @@ void ik_free(void* x, int size){
}
#define CACHE_SIZE (pagesize * 8) /* must be multiple of pagesize*/
#define CACHE_SIZE (pagesize * 1) /* must be multiple of pagesize*/
ikpcb* ik_make_pcb(){
ikpcb* pcb = ik_malloc(sizeof(ikpcb));

2
bin/ikarus-symbol-table.c
View File

@ -1,5 +1,5 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <strings.h>
#include <string.h>
#include <stdlib.h>

2
bin/verify-integrity.c → bin/ikarus-verify-integrity.c
View File

@ -1,5 +1,5 @@
#include "ikarus.h"
#include "ikarus-data.h"
#include <stdlib.h>
#include <assert.h>

2
bin/ikarus-weak-pairs.c
View File

@ -1,5 +1,5 @@
#include "ikarus.h"
#include "ikarus-data.h"
ikp
ikrt_weak_cons(ikp a, ikp d, ikpcb* pcb){

0
bin/winmmap.c → bin/ikarus-winmmap.c
View File

0
bin/winmmap.h → bin/ikarus-winmmap.h
View File

237
bin/ikarus.at.c
View File

@ -1,237 +0,0 @@
junk junk junk
#include "ikarus.at.h"
#include <stdio.h>
#include <strings.h>
#include <assert.h>
#define page_size (4096)
#define segment_size (page_size * segment_pages)
#define align_to_next_segment(x) \
((((x)+segment_size-1)/segment_size)*segment_size)
#define align_to_next_page(x) \
((((x)+page_size-1)/page_size)*page_size)
#define segment_index(x) \
(((unsigned int)(x)) / segment_size)
#define page_index(x) \
(((unsigned int)(x)) / page_size)
#ifndef NDEBUG
static int malloc_count = 0;
static unsigned int mmap_count = 0;
static void ikat_malloc_count(size_t n){
malloc_count += n;
fprintf(stderr, "ikat_malloc_count=0x%08x (%ld)\n", malloc_count, n);
assert(malloc_count >= 0);
}
static void ikat_mmap_count(size_t n){
mmap_count += n;
fprintf(stderr, "ikat_mmap_count=0x%08x (%ld)\n", mmap_count, n);
assert(mmap_count >= 0);
}
static void ikat_done(){
assert(malloc_count == 0);
assert(mmap_count == 0);
}
#else
static inline void ikat_malloc_count(size_t n){}
static inline void ikat_done(){}
static inline void ikat_mmap_count(size_t n){}
#endif
static inline void*
ikat_malloc(size_t n){
ikat_malloc_count(n);
void* x = malloc(n);
if (x){
return x;
}
fprintf(stderr, "Error in ikat_malloc\n");
exit(-1);
}
static inline void
ikat_free(void* addr, size_t n){
ikat_malloc_count(-n);
free(addr);
}
static inline void*
ikat_mmap(size_t n){
assert(n == align_to_next_segment(n));
ikat_mmap_count(n);
void* x = mmap(0, n, PROT_READ|PROT_WRITE, MAP_ANON, -1, 0);
if(x != (void*)-1){
return x;
}
fprintf(stderr, "Error in ikat_mmap\n");
exit(-1);
}
static inline void
ikat_munmap(void* addr, size_t n){
fprintf(stderr, "unmap: ");
ikat_mmap_count(-n);
munmap(addr, n);
}
ikat*
ikat_make_allocation_table(unsigned int types){
unsigned int* tbl = ikat_mmap(segment_size);
bzero(tbl, segment_size);
ikat* x = ikat_malloc(sizeof(ikat));
bzero(x, sizeof(ikat));
x->alloc_table = tbl;
ikat_ll** lls = ikat_malloc(types * sizeof(ikat_ll*));
bzero(lls, types * sizeof(ikat_ll*));
x->lls_count = types;
x->lls = lls;
return x;
}
static void
ikat_free_ll(ikat* x, ikat_ll* p){
while(p){
ikat_ll* next = p->next;
ikat_unmap(x, p->base, p->size);
ikat_free(p, sizeof(ikat_ll));
p = next;
}
}
void
ikat_free_allocation_table(ikat* x){
int i;
for(i=0; i<x->lls_count; i++){
ikat_free_ll(x, x->lls[i]);
}
ikat_free_ll(x, x->llcache);
ikat_free(x->lls, x->lls_count * sizeof(ikat_ll*));
ikat_munmap(x->alloc_table, segment_size);
ikat_free(x, sizeof(ikat));
ikat_done();
}
unsigned char*
ikat_map_bigpage(ikat* x, size_t size){
assert(size == align_to_next_segment(size));
unsigned char* p = ikat_mmap(size);
if((unsigned int)p != align_to_next_segment((unsigned int)p)){
ikat_munmap(p, size);
p = ikat_mmap(size+segment_size);
unsigned char* q = (unsigned char*)align_to_next_segment((unsigned int)p);
if(p == q){
fprintf(stderr, "retry1\n");
ikat_munmap(p+size, segment_size);
} else {
fprintf(stderr, "retry2\n");
size_t fst = q - p;
ikat_munmap(p, fst);
ikat_munmap(q+size, segment_size-fst);
p = q;
}
} else {
fprintf(stderr, "noretry\n");
}
unsigned int idx = segment_index(p);
unsigned int idx_hi = idx + size/segment_size;
while(idx < idx_hi){
x->alloc_table[idx] = -1;
idx++;
}
return p;
}
void
ikat_unmap(ikat* x, unsigned char* addr, size_t size){
assert(size == align_to_next_page(size));
size_t pages = page_index(size);
if(pages < segment_pages){
size_t segment = segment_index(addr);
size_t page_offset = page_index(addr) & (segment_pages-1);
unsigned int alloc_bits = x->alloc_table[segment];
unsigned int this_bits = ((1 << pages) - 1) << page_offset;
unsigned int new_bits = alloc_bits & ~ this_bits;
fprintf(stderr, "0x%08x bits=0x%08x ^~ 0x%08x = 0x%08x pages=%d/%d, m=0x%08x\n",
addr, alloc_bits, this_bits, new_bits, pages, size, ((1<<pages)-1));
assert((alloc_bits & this_bits) == this_bits);
x->alloc_table[segment] = new_bits;
if(new_bits == 0){
ikat_munmap((unsigned char*)(segment * segment_size), segment_size);
}
} else {
fprintf(stderr, "ikat_unmap large\n");
exit(-1);
}
}
unsigned char*
ikat_map(ikat* x, size_t size, unsigned int type){
assert(size == align_to_next_page(size));
assert(type < x->lls_count);
ikat_ll* llp = x->lls[type];
size_t pages = page_index(size);
if(pages < segment_pages){
ikat_ll* ll = llp;
ikat_ll** prev = &(x->lls[type]);
while(ll){
size_t lsize = ll->size;
if(lsize == size){
/* unwire */
*prev = ll->next;
ll->next = x->llcache;
x->llcache = ll;
return ll->base;
} else if (lsize > size){
unsigned char* addr = ll->base;
ll->size -= size;
ll->base += size;
return addr;
} else {
prev = &(ll->next);
ll = ll->next;
}
}
unsigned char* base = ikat_map_bigpage(x, segment_size);
ikat_ll* cache = x->llcache;
if(cache){
x->llcache = cache->next;
} else {
cache = ikat_malloc(sizeof(ikat_ll));
}
cache->base = base + size;
cache->size = segment_size - size;
cache->next = x->lls[type];
x->lls[type] = cache;
return base;
} else {
size_t aligned_size = align_to_next_segment(size);
unsigned char* base = ikat_map_bigpage(x, aligned_size);
if(aligned_size != size){
ikat_ll* cache = x->llcache;
if(cache){
x->llcache = cache->next;
} else {
cache = ikat_malloc(sizeof(ikat_ll));
}
cache->base = base + size;
cache->size = aligned_size - size;
cache->next = x->lls[type];
x->lls[type] = cache;
}
return base;
}
}

38
bin/ikarus.at.h
View File

@ -1,38 +0,0 @@
#ifndef IKARUS_AT
#define IKARUS_AT
#include <stdlib.h>
#include <sys/types.h>
#include <sys/mman.h>
#define segment_pages (8 * sizeof(unsigned int))
typedef struct ikat_ll{
unsigned char* base;
size_t size;
struct ikat_ll* next;
} ikat_ll;
typedef struct {
unsigned int* alloc_table;
ikat_ll** lls;
int lls_count;
unsigned char* ap;
unsigned char* ep;
ikat_ll* llcache;
} ikat;
ikat* ikat_make_allocation_table(unsigned int types);
void ikat_free_allocation_table(ikat*);
unsigned char* ikat_map_bigpage(ikat*, size_t size);
unsigned char* ikat_map(ikat*, size_t size, unsigned int type);
unsigned char* ikat_map_code(ikat*, size_t size, unsigned int type);
void ikat_unmap(ikat*, unsigned char* addr, size_t size);
#endif

188
bin/ikarus.h
View File

@ -1,188 +0,0 @@
#ifndef IKARUS_H
#define IKARUS_H
#include <stdio.h>
#include <sys/resource.h>
extern int total_allocated_pages;
extern int total_malloced;
extern int hash_table_count;
#define cardsize 512
#define cards_per_page 8
#define most_bytes_in_minor 0x10000000
#define old_gen_mask 0x00000007
#define new_gen_mask 0x00000008
#define gen_mask 0x0000000F
#define new_gen_tag 0x00000008
#define meta_dirty_mask 0x000000F0
#define type_mask 0x00000F00
#define scannable_mask 0x0000F000
#define dealloc_mask 0x000F0000
#define large_object_mask 0x00100000
#define meta_dirty_shift 4
#define hole_type 0x00000000
#define mainheap_type 0x00000100
#define mainstack_type 0x00000200
#define pointers_type 0x00000300
#define dat_type 0x00000400
#define code_type 0x00000500
#define weak_pairs_type 0x00000600
#define symbols_type 0x00000700
#define scannable_tag 0x00001000
#define unscannable_tag 0x00000000
#define dealloc_tag_un 0x00010000
#define dealloc_tag_at 0x00020000
#define retain_tag 0x00000000
#define large_object_tag 0x00100000
#define hole_mt (hole_type | unscannable_tag | retain_tag)
#define mainheap_mt (mainheap_type | unscannable_tag | retain_tag)
#define mainstack_mt (mainstack_type | unscannable_tag | retain_tag)
#define pointers_mt (pointers_type | scannable_tag | dealloc_tag_un)
#define symbols_mt (symbols_type | scannable_tag | dealloc_tag_un)
#define data_mt (dat_type | unscannable_tag | dealloc_tag_un)
#define code_mt (code_type | scannable_tag | dealloc_tag_un)
#define weak_pairs_mt (weak_pairs_type | scannable_tag | dealloc_tag_un)
static int
inthash(int key) {
key += ~(key << 15);
key ^= (key >> 10);
key += (key << 3);
key ^= (key >> 6);
key += ~(key << 11);
key ^= (key >> 16);
return key;
return inthash(key);
}
#define wordsize 4
#define wordshift 2
#define pagesize 4096
#define generation_count 5 /* generations 0 (nursery), 1, 2, 3, 4 */
typedef unsigned char* ikp;
void ik_error(ikp args);
typedef struct ikpage{
ikp base;
struct ikpage* next;
} ikpage;
typedef struct ikpages{
ikp base;
int size;
struct ikpages* next;
} ikpages;
typedef struct ikdl{ /* double-link */
struct ikdl* prev;
struct ikdl* next;
} ikdl;
#define ik_ptr_page_size \
((pagesize - sizeof(int) - sizeof(struct ik_ptr_page*))/sizeof(ikp))
typedef struct ik_ptr_page{
int count;
struct ik_ptr_page* next;
ikp ptr[ik_ptr_page_size];
} ik_ptr_page;
typedef struct ikpcb{
/* the first locations may be accessed by some */
/* compiled code to perform overflow/underflow ops */
ikp allocation_pointer; /* offset = 0 */
ikp allocation_redline; /* offset = 4 */
ikp frame_pointer; /* offset = 8 */
ikp frame_base; /* offset = 12 */
ikp frame_redline; /* offset = 16 */
ikp next_k; /* offset = 20 */
void* system_stack; /* offset = 24 */
unsigned int* dirty_vector; /* offset = 28 */
ikp arg_list; /* offset = 32 */
int engine_counter; /* offset = 36 */
int interrupted; /* offset = 40 */
ikp base_rtd; /* offset = 44 */
ikp collect_key; /* offset = 48 */
/* the rest are not used by any scheme code */
/* they only support the runtime system (gc, etc.) */
unsigned int* segment_vector;
ikp weak_pairs_ap;
ikp weak_pairs_ep;
ikp heap_base;
int heap_size;
ikpages* heap_pages;
ikpage* cached_pages; /* pages cached so that we don't map/unmap */
ikpage* uncached_pages; /* ikpages cached so that we don't malloc/free */
ikp cached_pages_base;
int cached_pages_size;
ikp stack_base;
int stack_size;
ikp symbol_table;
ikp gensym_table;
ik_ptr_page* guardians[generation_count];
ik_ptr_page* guardians_dropped[generation_count];
unsigned int* dirty_vector_base;
unsigned int* segment_vector_base;
unsigned char* memory_base;
unsigned char* memory_end;
int collection_id;
int allocation_count_minor;
int allocation_count_major;
struct timeval collect_utime;
struct timeval collect_stime;
struct timeval collect_rtime;
} ikpcb;
void* ik_malloc(int);
void ik_free(void*, int);
void* ik_mmap(int);
void* ik_mmap_typed(int size, unsigned int type, ikpcb*);
void* ik_mmap_ptr(int size, int gen, ikpcb*);
void* ik_mmap_data(int size, int gen, ikpcb*);
void* ik_mmap_code(int size, int gen, ikpcb*);
void* ik_mmap_mixed(int size, ikpcb*);
void ik_munmap(void*, int);
void ik_munmap_from_segment(unsigned char*, int, ikpcb*);
ikpcb* ik_make_pcb();
void ik_delete_pcb(ikpcb*);
void ik_free_symbol_table(ikpcb* pcb);
void ik_fasl_load(ikpcb* pcb, char* filename);
void ik_relocate_code(ikp);
ikp ik_exec_code(ikpcb* pcb, ikp code_ptr);
void ik_print(ikp x);
void ik_fprint(FILE*, ikp x);
ikp ikrt_string_to_symbol(ikp, ikpcb*);
ikp ikrt_strings_to_gensym(ikp, ikp, ikpcb*);
ikp ik_cstring_to_symbol(char*, ikpcb*);
ikp ik_asm_enter(ikpcb*, ikp code_object, ikp arg);
ikp ik_asm_reenter(ikpcb*, ikp code_object, ikp val);
ikp ik_underflow_handler(ikpcb*);
ikp ik_alloc(ikpcb* pcb, int size);
#include "ikarus-data.h"
#define ik_eof_p(x) ((x) == ik_eof_object)
#define page_index(x) (((unsigned int)(x)) >> pageshift)
#endif