qf/quakeforge
0
0
Fork 0
mirror of https://git.code.sf.net/p/quake/quakeforge synced 2025-01-31 13:10:34 +00:00
Code Issues Projects Releases Packages Wiki Activity

Fix a slew of warnings found by -Wall.

Browse source 
-Wall still isn't used yet due to a missing method in Array, and
overzealous warnings in qfcc, but this covers the necessary fixes.
This commit is contained in:
Bill Currie 2010-12-16 20:01:49 +09:00
parent eace5b3c81
commit 6d494bfcdf
33 changed files with 181 additions and 151 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
ruamoko/cl_menu/CvarRangeView.h
View file

@ -14,6 +14,7 @@
Slider slider;
CvarRange range;
}
-(void)update;
-(id)initWithBounds:(Rect)aRect title:(string)_title sliderWidth:(integer)width :(CvarRange)_range;
-(void)inc;
-(void)dec;

1
ruamoko/cl_menu/CvarToggleView.h
View file

@ -12,6 +12,7 @@
Text value;
CvarToggle toggle;
}
-(void)update;
-(id)initWithBounds:(Rect)aRect title:(string)_title :(CvarToggle)_toggle;
-(void)toggle;
@end

1
ruamoko/cl_menu/CvarToggleView.r
View file

@ -4,6 +4,7 @@
#include "gui/Text.h"
#include "CvarToggleView.h"
#include "CvarToggle.h"
@implementation CvarToggleView

2
ruamoko/cl_menu/MenuGroup.h
View file

@ -9,6 +9,8 @@
integer current;
}
-(void)setBase:(integer)b;
-(void) next;
-(void) prev;
@end
#endif//__MenuGroup_h

2
ruamoko/cl_menu/MenuGroup.r
View file

@ -60,7 +60,7 @@
local View cur;
[super draw];
cur = (View) [views getItemAt:current];
cur = (View) [views objectAtIndex:current];
opt_cursor (cur.xabs - 8, cur.yabs);
}
@end

4
ruamoko/cl_menu/MouseToggle.h
View file

@ -1,10 +1,10 @@
#ifndef __MouseToggle_h
#define __MouseToggle_h
#include "CvarObject.h"
#include "CvarToggle.h"
@interface MouseToggle : CvarObject
@interface MouseToggle : CvarToggle
@end
#endif//__MouseToggle_h

4
ruamoko/cl_menu/RunToggle.h
View file

@ -1,9 +1,9 @@
#ifndef __RunToggle_h
#define __RunToggle_h
#include "CvarObject.h"
#include "CvarToggle.h"
@interface RunToggle : CvarObject
@interface RunToggle : CvarToggle
@end
#endif//__RunToggle_h

4
ruamoko/cl_menu/client_menu.qc
View file

@ -125,8 +125,8 @@ string (QFile f) get_comment =
local string line;
local PLItem plist;
plist = [PLItem newFromFile:f];
line = [(PLString) [plist getObjectForKey:"comment"] string];
plist = [PLItem fromFile:f];
line = [(PLString) [(PLDictionary) plist getObjectForKey:"comment"] string];
return line;
}

9
ruamoko/cl_menu/options.qc
View file

@ -50,6 +50,9 @@
#include "CvarRangeView.h"
#include "CvarColorView.h"
#include "CvarColor.h"
#include "CvarToggle.h"
Group video_options;
Group audio_options;
@ -140,7 +143,7 @@ MENU_video_options =
Menu_KeyEvent (KEY_video_options);
if (plist) {
ret = object_from_plist ([plist getObjectForKey:"video_options"]);
ret = object_from_plist ([(PLDictionary) plist getObjectForKey:"video_options"]);
video_options = ret.pointer_val;
}
@ -187,7 +190,7 @@ MENU_audio_options =
Menu_KeyEvent (KEY_audio_options);
if (plist) {
ret = object_from_plist ([plist getObjectForKey:"audio_options"]);
ret = object_from_plist ([(PLDictionary) plist getObjectForKey:"audio_options"]);
audio_options = ret.pointer_val;
}
@ -271,7 +274,7 @@ MENU_control_options =
Menu_KeyEvent (KEY_control_options);
if (plist) {
ret = object_from_plist ([plist getObjectForKey:"control_options"]);
ret = object_from_plist ([(PLDictionary) plist getObjectForKey:"control_options"]);
control_options = ret.pointer_val;
}

10
ruamoko/cl_menu/plistmenu.r
View file

@ -39,7 +39,7 @@ class_from_plist (PLDictionary pldict)
local @param ret;
local @va_list va_list = { 0, params };
local string classname, selname, paramstr;
local Class class;
local id class;
local id obj;
local PLArray messages, msg;
local integer message_count, i, j;
@ -122,10 +122,10 @@ rect_from_plist (PLString plstring)
if (str_mid (str, 0, 1) == "[") {
tmp = "(" + str_mid (str, 1, -1) + ")";
item = [PLItem fromString:tmp];
xp = stoi ([(PLString) [item getObjectAtIndex:0] string]);
yp = stoi ([(PLString) [item getObjectAtIndex:1] string]);
xl = stoi ([(PLString) [item getObjectAtIndex:2] string]);
yl = stoi ([(PLString) [item getObjectAtIndex:3] string]);
xp = stoi ([(PLString) [(PLArray) item getObjectAtIndex:0] string]);
yp = stoi ([(PLString) [(PLArray) item getObjectAtIndex:1] string]);
xl = stoi ([(PLString) [(PLArray) item getObjectAtIndex:2] string]);
yl = stoi ([(PLString) [(PLArray) item getObjectAtIndex:3] string]);
pr.r = makeRect (xp, yp, xl, yl);
}
return pr.p;

3
ruamoko/game/Axe.r
View file

@ -42,7 +42,8 @@
else {
sound (s, CHAN_WEAPON, "player/axhit2.wav", 1, ATTN_NORM);
WriteBytes (MSG_MULTICAST, SVC_TEMPENTITY, TE_GUNSHOT, 3.0);
WriteBytes (MSG_MULTICAST,
(float) SVC_TEMPENTITY, (float) TE_GUNSHOT, 3.0);
WriteCoordV (MSG_MULTICAST, org);
multicast (org, MULTICAST_PVS);
}

2
ruamoko/game/tempent.r
View file

@ -3,7 +3,7 @@
void(vector org, float damage) SpawnBlood =
{
WriteBytes (MSG_MULTICAST, SVC_TEMPENTITY, TE_BLOOD, 1.0);
WriteBytes (MSG_MULTICAST, (float) SVC_TEMPENTITY, (float) TE_BLOOD, 1.0);
WriteCoordV (MSG_MULTICAST, org);
multicast (org, MULTICAST_PVS);
};

1
ruamoko/lib/AutoreleasePool.r
View file

@ -1,4 +1,5 @@
#include "AutoreleasePool.h"
#include "Array+Private.h"
//@static AutoreleasePool sharedInstance;
@static Array poolStack;

8
ruamoko/lib/Entity.r
View file

@ -35,6 +35,12 @@ function PR_FindFunction (string func) = #0;
return self;
}
- (id) initWithEntity: (entity)e fromPlist: (plitem_t) dict
{
self = [self initWithEntity: e];
return self;
}
- (void) dealloc
{
if (own && ent)
@ -55,7 +61,7 @@ function PR_FindFunction (string func) = #0;
+ createFromPlist:(plitem_t) dict
{
local string classname;
local Class class;
local id class;
local entity ent;
local integer count;
local string field, value;

22
ruamoko/lib/PropertyList.r
View file

@ -22,20 +22,10 @@
return [PLString new:str];
}
+ (PLItem) fromString:(string) str
{
return [[PLItem itemClass: PL_GetPropertyList (str)] autorelease];
}
+ (PLItem) fromFile:(QFile) file
{
return [[PLItem itemClass: PL_GetFromFile (file)] autorelease];
}
+ itemClass:(plitem_t) item
{
local string classname = NIL;
local Class class;
local id class;
if (!PL_TEST (item))
return NIL;
@ -59,6 +49,16 @@
return [[class alloc] initWithItem: item];
}
+ (PLItem) fromString:(string) str
{
return [[PLItem itemClass: PL_GetPropertyList (str)] autorelease];
}
+ (PLItem) fromFile:(QFile) file
{
return [[PLItem itemClass: PL_GetFromFile (file)] autorelease];
}
- initWithItem:(plitem_t) item
{
if (!(self = [super init]))

3
ruamoko/scheme/BaseContinuation.r
View file

@ -1,4 +1,5 @@
#include "BaseContinuation.h"
#include "Cons.h"
instruction_t returninst;
BaseContinuation base;
@ -21,7 +22,7 @@ BaseContinuation base;
- (void) invokeOnMachine: (Machine) m
{
[m value: [[m stack] car]];
[m value: [(Cons) [m stack] car]];
[m state].program = &returninst;
}

4
ruamoko/scheme/Compiler.h
View file

@ -20,6 +20,10 @@
- (id) initWithLambda: (SchemeObject) xp scope: (Scope) sc;
- (SchemeObject) compile;
- (void) emitExpression: (SchemeObject) expression flags: (integer) fl;
- (void) emitLambda: (SchemeObject) expression;
- (void) emitConstant: (SchemeObject) expression;
- (void) emitApply: (SchemeObject) expression flags: (integer) fl;
@end
#endif //__Compiler_h

94
ruamoko/scheme/Compiler.r
View file

@ -52,7 +52,7 @@ Symbol beginSym;
scope = [Scope newWithOuter: scope];
count = 0;
for (cur = arguments; [cur isKindOfClass: [Cons class]]; cur = [cur cdr]) {
for (cur = arguments; [cur isKindOfClass: [Cons class]]; cur = [(Cons) cur cdr]) {
count++;
}
[code minimumArguments: count];
@ -62,9 +62,9 @@ Symbol beginSym;
[code addInstruction: [Instruction opcode: MAKEENV operand: count]];
[code addInstruction: [Instruction opcode: LOADENV]];
cur = arguments;
for (index = 0; index < count; cur = [cur cdr]) {
for (index = 0; index < count; cur = [(Cons) cur cdr]) {
if ([cur isKindOfClass: [Cons class]]) {
[scope addName: (Symbol) [cur car]];
[scope addName: (Symbol) [(Cons) cur car]];
[code addInstruction: [Instruction opcode: SET operand: index]];
} else if ([cur isKindOfClass: [Symbol class]]) {
[scope addName: (Symbol) cur];
@ -85,11 +85,11 @@ Symbol beginSym;
{
local SchemeObject cur;
for (cur = expressions; cur != [Nil nil]; cur = [cur cdr]) {
if ([cur cdr] == [Nil nil] && (fl & TAIL)) {
[self emitExpression: [cur car] flags: fl];
for (cur = expressions; cur != [Nil nil]; cur = [(Cons) cur cdr]) {
if ([(Cons) cur cdr] == [Nil nil] && (fl & TAIL)) {
[self emitExpression: [(Cons) cur car] flags: fl];
} else {
[self emitExpression: [cur car] flags: fl & ~TAIL];
[self emitExpression: [(Cons) cur car] flags: fl & ~TAIL];
}
if (err) return;
}
@ -119,22 +119,22 @@ Symbol beginSym;
local integer index = 0;
if (![expression isKindOfClass: [Cons class]] ||
![[expression cdr] isKindOfClass: [Cons class]]) {
![[(Cons) expression cdr] isKindOfClass: [Cons class]]) {
err = [Error type: "syntax"
message: "Malformed define statement"
by: expression];
return;
}
if ([[expression car] isKindOfClass: [Cons class]]) {
index = [code addConstant: [[expression car] car]];
if ([[(Cons) expression car] isKindOfClass: [Cons class]]) {
index = [code addConstant: [(Cons) [(Cons) expression car] car]];
[self emitLambda: cons(lambdaSym,
cons([[expression car] cdr],
[expression cdr]))];
cons([(Cons) [(Cons) expression car] cdr],
[(Cons) expression cdr]))];
if (err) return;
} else if ([[expression car] isKindOfClass: [Symbol class]]) {
index = [code addConstant: [expression car]];
[self emitExpression: [[expression cdr] car] flags: 0];
} else if ([[(Cons) expression car] isKindOfClass: [Symbol class]]) {
index = [code addConstant: [(Cons) expression car]];
[self emitExpression: [(Cons) [(Cons) expression cdr] car] flags: 0];
if (err) return;
} else {
err = [Error type: "syntax"
@ -153,7 +153,7 @@ Symbol beginSym;
local Instruction falseLabel, endLabel;
local integer index;
if (![expression isKindOfClass: [Cons class]] ||
![[expression cdr] isKindOfClass: [Cons class]]) {
![[(Cons) expression cdr] isKindOfClass: [Cons class]]) {
err = [Error type: "syntax"
message: "Malformed if expression"
by: expression];
@ -162,19 +162,19 @@ Symbol beginSym;
falseLabel = [Instruction opcode: LABEL];
endLabel = [Instruction opcode: LABEL];
[self emitExpression: [expression car] flags: fl & ~TAIL];
[self emitExpression: [(Cons) expression car] flags: fl & ~TAIL];
if (err) return;
[code addInstruction: [Instruction opcode: IFFALSE label: falseLabel]];
[self emitExpression: [[expression cdr] car] flags: fl];
[self emitExpression: [(Cons) [(Cons) expression cdr] car] flags: fl];
if (err) return;
[code addInstruction: [Instruction opcode: GOTO label: endLabel]];
[code addInstruction: falseLabel];
if ([[expression cdr] cdr] == [Nil nil]) {
if ([(Cons) [(Cons) expression cdr] cdr] == [Nil nil]) {
index = [code addConstant: [Void voidConstant]];
[code addInstruction: [Instruction opcode: LOADLITS]];
[code addInstruction: [Instruction opcode: GET operand: index]];
} else {
[self emitExpression: [[[expression cdr] cdr] car] flags: fl];
[self emitExpression: [(Cons) [(Cons) [(Cons) expression cdr] cdr] car] flags: fl];
if (err) return;
}
[code addInstruction: endLabel];
@ -190,8 +190,8 @@ Symbol beginSym;
local integer count;
if (!isList(expression) ||
!isList([expression car]) ||
![[expression cdr] isKindOfClass: [Cons class]]) {
!isList([(Cons) expression car]) ||
![[(Cons) expression cdr] isKindOfClass: [Cons class]]) {
err = [Error type: "syntax"
message: "Malformed letrec expression"
by: expression];
@ -201,8 +201,8 @@ Symbol beginSym;
count = 0;
for (bindings = [expression car]; bindings != [Nil nil]; bindings = [bindings cdr]) {
[scope addName: (Symbol) [[bindings car] car]];
for (bindings = [(Cons) expression car]; bindings != [Nil nil]; bindings = [(Cons) bindings cdr]) {
[scope addName: (Symbol) [(Cons) [(Cons) bindings car] car]];
count++;
}
@ -210,15 +210,15 @@ Symbol beginSym;
count = 0;
for (bindings = [expression car]; bindings != [Nil nil]; bindings = [bindings cdr]) {
[self emitSequence: [[bindings car] cdr] flags: fl & ~TAIL];
for (bindings = [(Cons) expression car]; bindings != [Nil nil]; bindings = [(Cons) bindings cdr]) {
[self emitSequence: [(Cons) [(Cons) bindings car] cdr] flags: fl & ~TAIL];
[code addInstruction: [Instruction opcode: PUSH]];
[code addInstruction: [Instruction opcode: LOADENV]];
[code addInstruction: [Instruction opcode: SET operand: count]];
count++;
}
[self emitSequence: [expression cdr] flags: fl];
[self emitSequence: [(Cons) expression cdr] flags: fl];
[code addInstruction: [Instruction opcode: POPENV]];
scope = [scope outer];
}
@ -229,18 +229,18 @@ Symbol beginSym;
[code source: [expression source]];
[code line: [expression line]];
if ([expression car] == lambdaSym) {
if ([(Cons) expression car] == lambdaSym) {
[self emitLambda: expression];
} else if ([expression car] == quoteSym) {
[self emitConstant: [[expression cdr] car]];
} else if ([expression car] == defineSym) {
[self emitDefine: [expression cdr]];
} else if ([expression car] == ifSym) {
[self emitIf: [expression cdr] flags: fl];
} else if ([expression car] == letrecSym) {
[self emitLetrec: [expression cdr] flags: fl];
} else if ([expression car] == beginSym) {
[self emitSequence: [expression cdr] flags: fl];
} else if ([(Cons) expression car] == quoteSym) {
[self emitConstant: [(Cons) [(Cons) expression cdr] car]];
} else if ([(Cons) expression car] == defineSym) {
[self emitDefine: [(Cons) expression cdr]];
} else if ([(Cons) expression car] == ifSym) {
[self emitIf: [(Cons) expression cdr] flags: fl];
} else if ([(Cons) expression car] == letrecSym) {
[self emitLetrec: [(Cons) expression cdr] flags: fl];
} else if ([(Cons) expression car] == beginSym) {
[self emitSequence: [(Cons) expression cdr] flags: fl];
} else {
[self emitApply: expression flags: fl];
}
@ -256,9 +256,9 @@ Symbol beginSym;
if (expression == [Nil nil]) {
return;
} else {
[self emitArguments: [expression cdr]];
[self emitArguments: [(Cons) expression cdr]];
if (err) return;
[self emitExpression: [expression car] flags: 0];
[self emitExpression: [(Cons) expression car] flags: 0];
if (err) return;
[code addInstruction: [Instruction opcode: PUSH]];
}
@ -270,9 +270,9 @@ Symbol beginSym;
if (!(fl & TAIL)) {
[code addInstruction: [Instruction opcode: MAKECONT label: label]];
}
[self emitArguments: [expression cdr]];
[self emitArguments: [(Cons) expression cdr]];
if (err) return;
[self emitExpression: [expression car] flags: fl & ~TAIL];
[self emitExpression: [(Cons) expression car] flags: fl & ~TAIL];
if (err) return;
[code addInstruction: [Instruction opcode: CALL]];
[code addInstruction: label];
@ -307,9 +307,9 @@ Symbol beginSym;
- (void) checkLambdaSyntax: (SchemeObject) expression
{
if (![expression isKindOfClass: [Cons class]] ||
[expression car] != lambdaSym ||
[expression cdr] == [Nil nil] ||
[[expression cdr] cdr] == [Nil nil]) {
[(Cons) expression car] != lambdaSym ||
[(Cons) expression cdr] == [Nil nil] ||
[(Cons) [(Cons) expression cdr] cdr] == [Nil nil]) {
err = [Error type: "syntax"
message: "malformed lambda expression"
by: expression];
@ -322,11 +322,11 @@ Symbol beginSym;
if (err) {
return err;
}
[self emitBuildEnvironment: [[sexpr cdr] car]];
[self emitBuildEnvironment: [(Cons) [(Cons) sexpr cdr] car]];
if (err) {
return err;
}
[self emitSequence: [[sexpr cdr] cdr] flags: TAIL];
[self emitSequence: [(Cons) [(Cons) sexpr cdr] cdr] flags: TAIL];
if (err) {
return err;
}

4
ruamoko/scheme/Cons.r
View file

@ -13,7 +13,7 @@ integer length (SchemeObject foo)
{
local integer len;
for (len = 0; [foo isKindOfClass: [Cons class]]; foo = [foo cdr]) {
for (len = 0; [foo isKindOfClass: [Cons class]]; foo = [(Cons) foo cdr]) {
len++;
}
@ -24,7 +24,7 @@ BOOL isList (SchemeObject ls)
{
return ls == [Nil nil] ||
([ls isKindOfClass: [Cons class]] &&
isList([ls cdr]));
isList([(Cons) ls cdr]));
}
@implementation Cons

1
ruamoko/scheme/Continuation.h
View file

@ -10,6 +10,7 @@
}
+ (id) newWithState: (state_t []) st pc: (integer) p;
- (id) initWithState: (state_t []) st pc: (integer) p;
- (void) restoreOnMachine: (Machine) m;
@end

4
ruamoko/scheme/Continuation.r
View file

@ -1,4 +1,6 @@
#include "Continuation.h"
#include "Machine.h"
#include "Cons.h"
#include "defs.h"
@implementation Continuation
@ -28,7 +30,7 @@
- (void) invokeOnMachine: (Machine) m
{
[m value: [[m stack] car]];
[m value: [(Cons) [m stack] car]];
[m state: &state];
return;
}

1
ruamoko/scheme/Machine.h
View file

@ -26,6 +26,7 @@
- (state_t []) state;
- (void) state: (state_t []) st;
- (void) reset;
- (void) procedure: (Procedure) pr;
@end
#endif //__Machine_h

22
ruamoko/scheme/Machine.r
View file

@ -134,13 +134,13 @@ void GlobalFree (void []ele, void []data)
state.stack = cons(value, state.stack);
break;
case POP:
value = [state.stack car];
value = [(Cons) state.stack car];
if (value) {
dprintf("Pop: %s\n", [value printForm]);
} else {
dprintf("Pop: NULL!!!!\n");
}
state.stack = [state.stack cdr];
state.stack = [(Cons) state.stack cdr];
break;
case MAKECLOSURE:
dprintf("Makeclosure\n");
@ -169,16 +169,16 @@ void GlobalFree (void []ele, void []data)
dprintf("Popenv\n");
state.env = [state.env getLink];
case GET:
value = [value get: operand];
value = [(Frame) value get: operand];
dprintf("Get: %i --> %s\n", operand, [value printForm]);
break;
case SET:
[value set: operand to: [state.stack car]];
dprintf("Set: %i --> %s\n", operand, [[state.stack car] printForm]);
state.stack = [state.stack cdr];
[(Frame) value set: operand to: [(Cons) state.stack car]];
dprintf("Set: %i --> %s\n", operand, [[(Cons) state.stack car] printForm]);
state.stack = [(Cons) state.stack cdr];
break;
case SETREST:
[value set: operand to: state.stack];
[(Frame) value set: operand to: state.stack];
dprintf("Setrest: %i --> %s\n", operand, [state.stack printForm]);
state.stack = [Nil nil];
break;
@ -188,7 +188,7 @@ void GlobalFree (void []ele, void []data)
break;
case GETLINK:
dprintf("Getlink\n");
value = [value getLink];
value = [(Frame) value getLink];
break;
case GETGLOBAL:
dprintf("Getglobal: %s\n", [value printForm]);
@ -204,8 +204,8 @@ void GlobalFree (void []ele, void []data)
break;
case SETGLOBAL:
dprintf("Setglobal: %s\n", [value printForm]);
[self addGlobal: (Symbol) value value: [state.stack car]];
state.stack = [state.stack cdr];
[self addGlobal: (Symbol) value value: [(Cons) state.stack car]];
state.stack = [(Cons) state.stack cdr];
break;
case CALL:
dprintf("Call\n");
@ -217,7 +217,7 @@ void GlobalFree (void []ele, void []data)
[value printForm], [state.stack printForm])
by: self];
}
[value invokeOnMachine: self];
[(Procedure) value invokeOnMachine: self];
break;
case RETURN:
dprintf("Return: %s\n", [value printForm]);

2
ruamoko/scheme/Makefile.am
View file

@ -4,7 +4,7 @@ pkglibdir=$(libdir)/ruamoko
QFCC_DEP=$(top_builddir)/tools/qfcc/source/qfcc$(EXEEXT)
QFCC=$(QFCC_DEP)
QCFLAGS=-qq -g -Werror
QCFLAGS=-qq -g -Werror -Wall -Wno-integer-divide
QCPPFLAGS=$(INCLUDES)
PAK=$(top_builddir)/tools/pak/pak$(EXEEXT)
GZIP=if echo $@ | grep -q .gz; then gzip -f `basename $@ .gz`; if test -f `basename $@ .dat.gz`.sym; then gzip -f `basename $@ .dat.gz`.sym; fi; fi

1
ruamoko/scheme/Number.h
View file

@ -9,6 +9,7 @@
+ (id) newFromInt: (integer) i;
- (id) initWithInt: (integer) i;
- (integer) intValue;
- (string) printForm;
@end
#endif //__Number_h

1
ruamoko/scheme/Primitive.r
View file

@ -1,5 +1,6 @@
#include "Primitive.h"
#include "Machine.h"
#include "Continuation.h"
@implementation Primitive
+ (id) newFromFunc: (primfunc_t) f

1
ruamoko/scheme/Procedure.r
View file

@ -1,4 +1,5 @@
#include "Procedure.h"
#include "Machine.h"
@implementation Procedure
- (void) invokeOnMachine: (Machine) m

1
ruamoko/scheme/SchemeObject.h
View file

@ -14,6 +14,7 @@
integer line;
string source;
}
+ (void) collectCheckPoint;
- (void) mark;
- (void) markReachable;
- (void) makeRootCell;

22
ruamoko/scheme/SchemeObject.r
View file

@ -26,11 +26,6 @@ integer checkpoint;
checkpoint = 0;
}
+ (id) dummyObject
{
return [[SchemeObject alloc] initDummy];
}
- (id) initDummy
{
self = [super init];
@ -40,13 +35,9 @@ integer checkpoint;
return self;
}
+ (void) collectCheckPoint
+ (id) dummyObject
{
if (checkpoint >= GC_AMOUNT)
{
[self collect];
checkpoint = 0;
}
return [[SchemeObject alloc] initDummy];
}
+ (void) collect
@ -105,6 +96,15 @@ integer checkpoint;
}
}
+ (void) collectCheckPoint
{
if (checkpoint >= GC_AMOUNT)
{
[self collect];
checkpoint = 0;
}
}
+ (void) finishCollecting
{
while (gc_state) {

2
ruamoko/scheme/Scope.h
View file

@ -14,7 +14,7 @@
- (integer) depthOf: (Symbol) sym;
- (integer) indexOf: (Symbol) sym;
- (void) addName: (Symbol) sym;
- (Scope) outer;
@end
#endif //__Scope_h

2
ruamoko/scheme/Scope.r
View file

@ -21,7 +21,7 @@
local integer index;
for (index = 0; index < [names count]; index++) {
if (sym == [names getItemAt: index]) {
if (sym == [names objectAtIndex: index]) {
return index;
}
}

1
ruamoko/scheme/Symbol.h
View file

@ -10,6 +10,7 @@
+ (Symbol) rightParen;
+ (Symbol) dot;
+ (Symbol) forString: (string) s;
+ (Symbol) quote;
@end
@extern Symbol symbol (string str);

92
ruamoko/scheme/builtins.r
View file

@ -12,7 +12,7 @@
BOOL num_args (SchemeObject list, integer num)
{
for (; [list isKindOfClass: [Cons class]]; list = [list cdr]) {
for (; [list isKindOfClass: [Cons class]]; list = [(Cons) list cdr]) {
num--;
}
return num == 0;
@ -25,7 +25,7 @@ SchemeObject bi_display (SchemeObject args, Machine m)
message: "expected 1 argument"
by: m];
}
print([[args car] printForm]);
print([[(Cons) args car] printForm]);
return [Void voidConstant];
}
@ -45,14 +45,14 @@ SchemeObject bi_add (SchemeObject args, Machine m)
local integer sum = 0;
local SchemeObject cur;
for (cur = args; cur != [Nil nil]; cur = [cur cdr]) {
if (![[cur car] isKindOfClass: [Number class]]) {
for (cur = args; cur != [Nil nil]; cur = [(Cons) cur cdr]) {
if (![[(Cons) cur car] isKindOfClass: [Number class]]) {
return [Error type: "+"
message: sprintf("non-number argument: %s\n",
[[cur car] printForm])
[[(Cons) cur car] printForm])
by: m];
}
sum += [(Number) [cur car] intValue];
sum += [(Number) [(Cons) cur car] intValue];
}
return [Number newFromInt: sum];
@ -69,7 +69,7 @@ SchemeObject bi_sub (SchemeObject args, Machine m)
by: m];
}
cur = [args car];
cur = [(Cons) args car];
if (![cur isKindOfClass: [Number class]]) {
return [Error type: "-"
@ -80,18 +80,18 @@ SchemeObject bi_sub (SchemeObject args, Machine m)
diff = [(Number) cur intValue];
if ([args cdr] == [Nil nil]) {
if ([(Cons) args cdr] == [Nil nil]) {
return [Number newFromInt: -diff];
}
for (cur = [args cdr]; cur != [Nil nil]; cur = [cur cdr]) {
if (![[cur car] isKindOfClass: [Number class]]) {
for (cur = [(Cons) args cdr]; cur != [Nil nil]; cur = [(Cons) cur cdr]) {
if (![[(Cons) cur car] isKindOfClass: [Number class]]) {
return [Error type: "-"
message: sprintf("non-number argument: %s\n",
[[cur car] printForm])
[[(Cons) cur car] printForm])
by: m];
}
diff -= [(Number) [cur car] intValue];
diff -= [(Number) [(Cons) cur car] intValue];
}
return [Number newFromInt: diff];
@ -102,14 +102,14 @@ SchemeObject bi_mult (SchemeObject args, Machine m)
local integer prod = 1;
local SchemeObject cur;
for (cur = args; cur != [Nil nil]; cur = [cur cdr]) {
if (![[cur car] isKindOfClass: [Number class]]) {
for (cur = args; cur != [Nil nil]; cur = [(Cons) cur cdr]) {
if (![[(Cons) cur car] isKindOfClass: [Number class]]) {
return [Error type: "*"
message: sprintf("non-number argument: %s\n",
[[cur car] printForm])
[[(Cons) cur car] printForm])
by: m];
}
prod *= [(Number) [cur car] intValue];
prod *= [(Number) [(Cons) cur car] intValue];
}
return [Number newFromInt: prod];
@ -126,7 +126,7 @@ SchemeObject bi_div (SchemeObject args, Machine m)
by: m];
}
cur = [args car];
cur = [(Cons) args car];
if (![cur isKindOfClass: [Number class]]) {
return [Error type: "/"
@ -137,18 +137,18 @@ SchemeObject bi_div (SchemeObject args, Machine m)
frac = [(Number) cur intValue];
if ([args cdr] == [Nil nil]) {
if ([(Cons) args cdr] == [Nil nil]) {
return [Number newFromInt: 1/frac];
}
for (cur = [args cdr]; cur != [Nil nil]; cur = [cur cdr]) {
if (![[cur car] isKindOfClass: [Number class]]) {
for (cur = [(Cons) args cdr]; cur != [Nil nil]; cur = [(Cons) cur cdr]) {
if (![[(Cons) cur car] isKindOfClass: [Number class]]) {
return [Error type: "/"
message: sprintf("non-number argument: %s\n",
[[cur car] printForm])
[[(Cons) cur car] printForm])
by: m];
}
frac /= [(Number) [cur car] intValue];
frac /= [(Number) [(Cons) cur car] intValue];
}
return [Number newFromInt: frac];
@ -161,7 +161,7 @@ SchemeObject bi_cons (SchemeObject args, Machine m)
message: "expected 2 arguments"
by: m];
}
[args cdr: [[args cdr] car]];
[(Cons) args cdr: [(Cons) [(Cons) args cdr] car]];
return args;
}
@ -172,7 +172,7 @@ SchemeObject bi_null (SchemeObject args, Machine m)
message: "expected 1 argument"
by: m];
}
return [args car] == [Nil nil]
return [(Cons) args car] == [Nil nil]
?
[Boolean trueConstant] :
[Boolean falseConstant];
@ -185,14 +185,14 @@ SchemeObject bi_car (SchemeObject args, Machine m)
message: "expected 1 argument"
by: m];
}
if (![[args car] isKindOfClass: [Cons class]]) {
if (![[(Cons) args car] isKindOfClass: [Cons class]]) {
return [Error type: "car"
message: sprintf("expected pair, got: %s",
[[args car] printForm])
[[(Cons) args car] printForm])
by: m];
}
return [[args car] car];
return [(Cons) [(Cons) args car] car];
}
SchemeObject bi_cdr (SchemeObject args, Machine m)
@ -202,13 +202,13 @@ SchemeObject bi_cdr (SchemeObject args, Machine m)
message: "expected 1 argument"
by: m];
}
if (![[args car] isKindOfClass: [Cons class]]) {
if (![[(Cons) args car] isKindOfClass: [Cons class]]) {
return [Error type: "cdr"
message: sprintf("expected pair, got: %s",
[[args car] printForm])
[[(Cons) args car] printForm])
by: m];
}
return [[args car] cdr];
return [(Cons) [(Cons) args car] cdr];
}
SchemeObject bi_apply (SchemeObject args, Machine m)
@ -218,26 +218,26 @@ SchemeObject bi_apply (SchemeObject args, Machine m)
return [Error type: "apply"
message: "expected at least 1 argument"
by: m];
} else if (![[args car] isKindOfClass: [Procedure class]]) {
} else if (![[(Cons) args car] isKindOfClass: [Procedure class]]) {
return [Error type: "apply"
message:
sprintf("expected procedure as 1st argument, got: %s",
[[args car] printForm])
[[(Cons) args car] printForm])
by: m];
}
prev = NIL;
for (cur = args; [cur cdr] != [Nil nil]; cur = [cur cdr]) {
for (cur = args; [(Cons) cur cdr] != [Nil nil]; cur = [(Cons) cur cdr]) {
prev = cur;
}
if (prev) {
[prev cdr: [cur car]];
[(Cons) prev cdr: [(Cons) cur car]];
}
[m stack: [args cdr]];
[[args car] invokeOnMachine: m];
[m stack: [(Cons) args cdr]];
[(Procedure) [(Cons) args car] invokeOnMachine: m];
return NIL;
}
@ -247,11 +247,11 @@ SchemeObject bi_callcc (SchemeObject args, Machine m)
return [Error type: "call-with-current-continuation"
message: "expected at least 1 argument"
by: m];
} else if (![[args car] isKindOfClass: [Procedure class]]) {
} else if (![[(Cons) args car] isKindOfClass: [Procedure class]]) {
return [Error type: "call-with-current-continuation"
message:
sprintf("expected procedure as 1st argument, got: %s",
[[args car] printForm])
[[(Cons) args car] printForm])
by: m];
}
if ([m continuation]) {
@ -260,7 +260,7 @@ SchemeObject bi_callcc (SchemeObject args, Machine m)
[m stack: cons([BaseContinuation baseContinuation],
[Nil nil])];
}
[[args car] invokeOnMachine: m];
[(Procedure) [(Cons) args car] invokeOnMachine: m];
return NIL;
}
@ -272,7 +272,7 @@ SchemeObject bi_eq (SchemeObject args, Machine m)
by: m];
}
return
[args car] == [[args cdr] car] ?
[(Cons) args car] == [(Cons) [(Cons) args cdr] car] ?
[Boolean trueConstant] :
[Boolean falseConstant];
}
@ -285,22 +285,22 @@ SchemeObject bi_numeq (SchemeObject args, Machine m)
message: "expected 2 arguments"
by: m];
}
num1 = [args car];
num2 = [[args cdr] car];
num1 = [(Cons) args car];
num2 = [(Cons) [(Cons) args cdr] car];
if (![num1 isKindOfClass: [Number class]]) {
return [Error type: "="
message: sprintf("expected number argument, got: %s",
[num1 printform])
[num1 printForm])
by: m];
} else if (![num2 isKindOfClass: [Number class]]) {
return [Error type: "="
message: sprintf("expected number argument, got: %s",
[num2 printform])
[num2 printForm])
by: m];
}
return
[num1 intValue] == [num2 intValue] ?
[(Number) num1 intValue] == [(Number) num2 intValue] ?
[Boolean trueConstant] :
[Boolean falseConstant];
}
@ -328,7 +328,7 @@ SchemeObject bi_ispair (SchemeObject args, Machine m)
}
return
[[args car] isKindOfClass: [Cons class]] ?
[[(Cons) args car] isKindOfClass: [Cons class]] ?
[Boolean trueConstant] :
[Boolean falseConstant];
}