gscheme/SchemeTypes.m

#import "SchemeTypes.h"

@implementation SCMType

static int allocatedAfterGC = 0;
static NSMutableSet *scmobjects = nil;
static NSMutableSet *scmmarkables = nil;
static int currentMark = -1;
static int totalAllocated = 0;


+ (int)allocatedAfterGC
{
    return allocatedAfterGC;
}

+ (int)totalAllocated
{
    return totalAllocated;
}

+ (int)nextMark
{
    currentMark++;
    return currentMark;
}

+ addToMarkables:(id)item
{
    NSValue *entry = 
        [NSValue valueWithBytes:&item objCType:@encode(id)];

    if(scmmarkables==nil){
        scmmarkables = [NSMutableSet setWithCapacity:1];
        [scmmarkables retain];
    }

    [scmmarkables addObject:entry];

    return self;
}

+ removeFromMarkables:(id)item
{
    NSValue *entry = 
        [NSValue valueWithBytes:&item objCType:@encode(id)];

    if(scmmarkables==nil){
        scmmarkables = [NSMutableSet setWithCapacity:1];
        [scmmarkables retain];
    }

    [scmmarkables removeObject:entry];

    return self;
}

+ currentMarkForMarkables
{
    NSEnumerator *enumerator;
    NSValue *curval;
    id markable;

    if(scmmarkables==nil){
        scmmarkables = [NSMutableSet setWithCapacity:1];
    }
    enumerator = [scmmarkables objectEnumerator];

    while((curval = (NSValue *)[enumerator nextObject])!=nil){
        [curval getValue:&markable];
        if(MARKABLE(markable)){
            [markable setMarkToCurrent];
        }
    }

    return self;
}

+ runGC
{
    NSMutableSet *nextobjects = [NSMutableSet setWithCapacity:1];
    NSEnumerator *enumerator = [scmobjects objectEnumerator];
    // NSValue *curval;
    SCMType *current;
    
    while((current = (SCMType *)[enumerator nextObject])!=nil){
        // [curval getValue:&current];
        if([current mark]!=currentMark){
            [current free];
        }
        else{
            [nextobjects addObject:current]; // curval];
        }
    }

    [scmobjects release];

    scmobjects = nextobjects;
    [scmobjects retain];

    allocatedAfterGC = totalAllocated = [scmobjects count];
}

+ alloc
{
    id inst = [super alloc];
    /* NSValue *entry = 
       [NSValue valueWithBytes:&inst objCType:@encode(id)]; */

    if(scmobjects==nil){
        scmobjects = [NSMutableSet setWithCapacity:1];
        [scmobjects retain];
    }

    [scmobjects addObject:inst]; // entry];
    totalAllocated++;

    return [inst setMark:-1];
}


- (int)mark
{
    return mark;
}

- setMark:(int)newMark
{
    mark = newMark;
    return self;
}

- setMarkToCurrent
{
    mark = currentMark;
    return self;
}


- (void)free
{
    int count = [self retainCount];

    while(count>2){ // count>1 (leave one release for the set)
        count--;
        [self release];
    }

    [super release];
}
@end

@implementation Pair
    
+ (int)length:(Pair *)list
{
    return (list==(Pair *)[NSNull null] ? 
            0 : 1+[self length:[list cdr]]);
}

+ newCar:(id)carval Cdr:(id)cdrval
{
    return [[super alloc] initCar:carval Cdr:cdrval];
}

- initCar:(id)carval Cdr:(id)cdrval
{
    car = carval; [car retain];
    cdr = cdrval; [cdr retain];

    return self;
}


- car
{
    return car;
}

- cdr
{
    return cdr;
}

- setcar:(id)carval
{
    car = carval; [car retain];
    return self;
}

- setcdr:(id)cdrval
{
    cdr = cdrval; [cdr retain];
    return self;
}

- setMarkToCurrent
{
    if(mark==currentMark){
        return;
    }

    mark = currentMark;
    if(MARKABLE(car)){
        [car setMarkToCurrent];
    }
    if(MARKABLE(cdr)){
        [cdr setMarkToCurrent];
    }
    
    return self;
}


@end

@implementation Vector

+ newFromList:(Pair *)list
{
    return [[super alloc]
               initWithList:list];
}

+ newWithItem:(id)item count:(int)cval
{
    return [[super alloc]
               initWithItem:item count:cval];
}


- initWithList:(Pair *)list
{
    Pair *current = list;
    int index = 0, length = [Pair length:list];

    count = length;
    data = NSZoneMalloc([self zone], length*sizeof(id));

    while(isPair(current)){
        data[index] = [current car]; [data[index++] retain];
        current = [current cdr];
    }

    return self;
}

- initWithItem:(id)item count:(int)cval
{
    count = cval;
    data = NSZoneMalloc([self zone], cval*sizeof(id));

    while(cval--){
        data[cval] = item; [item retain];
    }

    return self;
}


- (id *)entries
{
    return data;
}

- (unsigned)count
{
    return count;
}

- setMarkToCurrent
{
    int index;

    if(mark==currentMark){
        return;
    }

    mark = currentMark;

    for(index=0; index<count; index++){
        id obj = data[index];
        if(MARKABLE(obj)){
            [obj setMarkToCurrent];
        }
    }

    return self;
}


- (void)free
{
    NSZoneFree([self zone], data);
    [super free];
}

@end

@implementation Closure

+ newArgs:(id)argsval Body:(id)codes Env:(id)envval
{
    return [[super alloc]
               initArgs:argsval Body:codes Env:envval];
}

- initArgs:(id)argsval Body:(id)codes Env:(id)envval
{
    [super init];
    args = argsval; [args retain];
    body = codes;   [body retain];
    env  = envval;  [env retain];

    return self;
}

- args
{
    return args;
}

- body
{
    return body;
}

- env
{
    return env;
}

- setMarkToCurrent
{
    if(mark==currentMark){
        return;
    }

    mark = currentMark;
    if(MARKABLE(args)){
        [args setMarkToCurrent];
    }
    if(MARKABLE(body)){
        [body setMarkToCurrent];
    }
    if(MARKABLE(env)){
        [env setMarkToCurrent];
    }
    
    return self;
}

@end

@implementation Thunk

+ newArgp:(int)argpval Envp:(int)envpval Codep:(int)codepval
{
    return [[super alloc] 
               initArgp:argpval Envp:envpval Codep:codepval];
}

- initArgp:(int)argpval Envp:(int)envpval Codep:(int)codepval
{
    argp = argpval;
    envp = envpval;
    codep = codepval;
    return self;
}

- (int)argp
{
    return argp;
}

- setArgp:(int)argpval
{
    argp = argpval;
    return self;
}

- (int)envp
{
    return envp;
}

- setEnvp:(int)envpval
{
    envp = envpval;
    return self;
}

- (int)codep
{
    return codep;
}

- setCodep:(int)codepval
{
    codep = codepval;
    return self;
}

@end



@implementation Environment

+ newParent:(Environment *)par Data:(NSMapTable *)entries
{
    return [[super alloc]
               initParent:par Data:entries];
}

- initParent:(Environment *)par Data:(NSMapTable *)entries
{
    [super init];

    parent = par;
    [parent retain];
    
    data = entries; // [entries mutableCopy]; 
    // [data retain];

    return self;
}

- (int)chainLength
{
    return (parent==nil ? 1 : 1+[parent chainLength]);
}

- (NSMapTable *)lookup:(NSString *)sym
{
    if(NSMapGet(data, sym)!=NULL){
        return data;
    }

    return (parent==nil ? NULL : [parent lookup:sym]);
}

- (Environment *)parent
{
    return parent;
}

- (NSMapTable *)data
{
    return data;
}

- setMarkToCurrent
{
    NSMapEnumerator enumerator = NSEnumerateMapTable(data);
    id item;
  
    if(mark==currentMark){
        return;
    }

    mark = currentMark;

    id key, val;
    while(NSNextMapEnumeratorPair
	  (&enumerator, (void**)&key, (void**)&val)){
        if(MARKABLE(val)){
            [val setMarkToCurrent];
        }
    }
    
    if(MARKABLE(parent)){
        [parent setMarkToCurrent];
    }
    
    return self;
}

- (void)free
{
    NSFreeMapTable(data);
    [super free];
}

@end


@implementation Triple

+ newTag:(int)tagval
{
    return [[super alloc] 
               initTag:tagval
               Arg1:nil Arg2:nil Arg3:nil];
}

+ newTag:(int)tagval IntArg1:(int)arg1;
{
    // NSNumber *num = [NSNumber numberWithInt:arg1];
    Int *num = [[Int alloc] initSCMInt:arg1];

    return [[super alloc] 
               initTag:tagval
               Arg1:num Arg2:nil Arg3:nil];
}

+ newTag:(int)tagval Arg1:(id)arg1
{
    return [[super alloc] 
               initTag:tagval
               Arg1:arg1 Arg2:nil Arg3:nil];
}

+ newTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2
{
    return [[super alloc] 
               initTag:tagval
               Arg1:arg1 Arg2:arg2 Arg3:nil];
}

+ newTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2 Arg3:(id)arg3
{
    return [[super alloc] 
               initTag:tagval
               Arg1:arg1 Arg2:arg2 Arg3:arg3];
}


- initTag:(int)tagval Arg1:(id)arg1 Arg2:(id)arg2 Arg3:(id)arg3
{
    tag = tagval;

    items[0] = arg1; 
    if(arg1!=nil){ 
	[arg1 retain]; 
    }

    items[1] = arg2;
    if(arg2!=nil){ 
	[arg2 retain]; 
    }

    items[2] = arg3;
    if(arg3!=nil){ 
	[arg3 retain]; 
    }

    return self;
}

- (int)tag
{
    return tag;
}

- (int)intarg1
{
    return [items[0] intVal];
}

- setIntArg1:(int)val
{
    // items[0] = [NSNumber numberWithInt:val];
    items[0] = [[Int alloc] initSCMInt:val];
    [items[0] retain];
    return self;
}
    
- arg1
{
    return items[0];
}

- arg2
{
    return items[1];
}

- arg3
{
    return items[2];
}

- setMarkToCurrent
{
    if(mark==currentMark){
        return;
    }

    mark = currentMark;
    if(MARKABLE(items[0])){
        [items[0] setMarkToCurrent];
    }
    if(MARKABLE(items[1])){
        [items[1] setMarkToCurrent];
    }
    if(MARKABLE(items[2])){
        [items[2] setMarkToCurrent];
    }
    
    return self;
}

@end

@implementation Boolean

- initSCMBoolean:(BOOL)val
{
    [super init];
    value = val;
    return self;
}

- (BOOL)boolVal
{
    return value;
}

@end

@implementation Char

- initSCMChar:(char)val
{
    [super init];
    value = val;
    return self;
}

- (char)charVal
{
    return value;
}

@end

@implementation Int

- initSCMInt:(long int)val
{
    [super init];
    value = val;
    return self;
}

- (long int)intVal
{
    return value;
}

- (double)doubleVal
{
    return (double)value;
}

@end

@implementation Double

- initSCMDouble:(double)val
{
    [super init];
    value = val;
    return self;
}

- (double)doubleVal
{
    return value;
}

@end

@implementation Symbol

- initSCMSymbol:(char *)val
{
    [super init];

    value = [NSString stringWithCString:val];
    [value retain];

    return self;
}

- (NSString *)symVal
{
    return value;
}

- (void)free
{
    [value release];
    [super free];
}

@end

@implementation String

- initSCMStringLEX:(char *)val
{
    char *cp, *buf, *from, *to;
    int len = strlen(val);

    [super init];

    cp = strdup(val); from = cp+1; cp[len-1] = 0;
    buf = to = malloc(len-1);

    while(*from){
        if(*from == '\\'){
            from++;
        }
        *to++ = *from++;
    }
    *to = 0;

    value = [NSString stringWithCString:buf];
    [value retain];

    free(buf);
    free(cp);

    return self;
}

- initSCMString:(char *)val
{
    [super init];

    value = [NSString stringWithCString:val];
    [value retain];

    return self;
}

- (NSString *)strVal
{
    return value;
}

- (void)free
{
    [value release];
    [super free];
}

@end

#define BASE_CAPACITY 16

@implementation ByteCodes

+ new
{
    id inst = [super alloc];
    [inst init];
    return inst;
}

- init
{
    [super init];

    capacity = BASE_CAPACITY;
    length = 0;
    data = (id *)NSZoneMalloc(NSDefaultMallocZone(), capacity*sizeof(id));

    root = NO;
    source = nil;

    return self;
}

- prependTriple:(Triple *)theTriple
{
    if(length==capacity){
	capacity *= 2;
	data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
    }

    memmove(data+1, data, length*sizeof(id));
    length++;

    data[0] = theTriple;
    [theTriple retain];

    return self;
}

- addTriple:(Triple *)theTriple
{
    if(length==capacity){
	capacity *= 2;
	data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
    }

    data[length++] = theTriple;
    [theTriple retain];

    return self;
}

- appendByteCodes:(ByteCodes *)codes
{
    unsigned int otherLength = [codes length];
    id *otherData = [codes codes];

    if(length+otherLength>capacity){
	while(length+otherLength>capacity){
	    capacity *= 2;
	}
	data = (id *)NSZoneRealloc(NSDefaultMallocZone(), data, capacity*sizeof(id));
    }

    unsigned int pos;
    for(pos=0; pos<otherLength; pos++){
	data[length] = otherData[pos]; 
	[data[length] retain];
	length++;
    }

    return self;
}


- (id *)codes
{
    return data;
}

- (unsigned int)length
{
    return length;
}


- setMarkToCurrent
{
    if(mark==currentMark){
        return;
    }

    mark = currentMark;

    unsigned int index;
    for(index=0; index<length; index++){
        id obj = data[index];
        if(MARKABLE(obj)){
            [obj setMarkToCurrent];
        }
    }

    if(MARKABLE(source)){
	[source setMarkToCurrent];
    }

    return self;
}

- (BOOL)root
{
    return root;
}

- setRoot:(BOOL)rflag
{
    root = rflag;
    return self;
}

- source
{
    return source;
}

- setSource:(id)src
{
    source = src;
    [src retain];
    return self;
}

- (void)free
{
    NSZoneFree(NSDefaultMallocZone(), data);
    [super free];
}

@end