← Back to branch summary

~ubuntu-branches/ubuntu/raring/steptalk/raring

« back to all changes in this revision

Viewing changes to Languages/Smalltalk-nobc/STBlock.m

  • Committer: Bazaar Package Importer
  • Author(s): Brent A. Fulgham
  • Date: 2004-12-14 22:06:07 UTC
  • mfrom: (0.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20041214220607-6h02yn3lp1lqy3d1
Tags: 0.8.2-5
Recompile for new gnustep requirements.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Languages/Smalltalk-nobc/STBlock.m
1
 
/**
2
 
    STBlock.m
3
 
    Wrapper for STBlockContext to make it invisible from the user  
4
 
 
5
 
    Copyright (c) 2002 Free Software Foundation
6
 
 
7
 
    This file is part of the StepTalk project.
8
 
 
9
 
    This library is free software; you can redistribute it and/or
10
 
    modify it under the terms of the GNU Lesser General Public
11
 
    License as published by the Free Software Foundation; either
12
 
    version 2 of the License, or (at your option) any later version.
13
 
 
14
 
    This library is distributed in the hope that it will be useful,
15
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
16
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
 
    Lesser General Public License for more details.
18
 
 
19
 
    You should have received a copy of the GNU Lesser General Public
20
 
    License along with this library; if not, write to the Free Software
21
 
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
22
 
 
23
 
 */
24
 
 
25
 
 
26
 
#import "STBlock.h"
27
 
#import "STLiterals.h"
28
 
#import "STBlockContext.h"
29
 
#import "STBytecodeInterpreter.h"
30
 
#import "STStack.h"
31
 
 
32
 
#import <StepTalk/STExterns.h>
33
 
 
34
 
#import <Foundation/NSArray.h>
35
 
#import <Foundation/NSDebug.h>
36
 
#import <Foundation/NSException.h>
37
 
 
38
 
Class STBlockContextClass = nil;
39
 
 
40
 
@implementation STBlock
41
 
+ (void)initialize
42
 
{
43
 
    STBlockContextClass = [STBlockContext class];
44
 
}
45
 
- initWithInterpreter:(STBytecodeInterpreter *)anInterpreter
46
 
          homeContext:(STMethodContext *)context
47
 
            initialIP:(unsigned)ptr
48
 
        argumentCount:(int)count
49
 
            stackSize:(int)size
50
 
{
51
 
    homeContext = context;
52
 
    argCount  = count; 
53
 
    stackSize = size;
54
 
    initialIP = ptr;
55
 
    interpreter = anInterpreter;
56
 
    
57
 
    return [super init];
58
 
}
59
 
 
60
 
- (unsigned)argumentCount
61
 
{
62
 
    return argCount;
63
 
}
64
 
 
65
 
- value
66
 
{
67
 
    if(argCount != 0)
68
 
    {
69
 
        [NSException  raise:STScriptingException
70
 
                     format:@"Block needs %i arguments", argCount];
71
 
        return nil;
72
 
    }
73
 
    return [self valueWithArgs:(id*)0 count:0];
74
 
}
75
 
 
76
 
- valueWith:arg
77
 
{
78
 
    id  args[1] = {arg};
79
 
    id  retval;
80
 
 
81
 
    retval = [self valueWithArgs:args count:1];
82
 
    return retval;
83
 
}
84
 
 
85
 
- valueWith:arg1 with:arg2
86
 
{
87
 
    id  args[2] = {arg1,arg2};
88
 
    id  retval;
89
 
 
90
 
    retval = [self valueWithArgs:args count:2];
91
 
    return retval;
92
 
}
93
 
 
94
 
- valueWith:arg1 with:arg2 with:arg3
95
 
{
96
 
    id  args[3] = {arg1,arg2,arg3};
97
 
    id  retval;
98
 
 
99
 
    retval = [self valueWithArgs:args count:3];
100
 
    return retval;
101
 
}
102
 
 
103
 
- valueWith:arg1 with:arg2 with:arg3 with:arg4
104
 
{
105
 
    id  args[4] = {arg1,arg2,arg3,arg4};
106
 
    id  retval;
107
 
 
108
 
    retval = [self valueWithArgs:args count:4];
109
 
    return retval;
110
 
}
111
 
 
112
 
- valueWithArgs:(id *)args count:(unsigned)count;
113
 
{
114
 
    STExecutionContext *parentContext;
115
 
    STBlockContext     *context;
116
 
    STStack            *stack;
117
 
    unsigned int        i;
118
 
    id                  retval;
119
 
 
120
 
    if(argCount != count)
121
 
    {
122
 
        [NSException raise:STScriptingException
123
 
                    format:@"Invalid block argument count %i, " 
124
 
                           @"wants to be %i", count, argCount];
125
 
        return nil;
126
 
    }
127
 
 
128
 
    if(!usingCachedContext)
129
 
    {
130
 
        /* In case of recursive block nesting */
131
 
        usingCachedContext = YES;
132
 
 
133
 
        if(!cachedContext)
134
 
        {
135
 
            cachedContext = [[STBlockContextClass alloc] 
136
 
                                    initWithInterpreter:interpreter
137
 
                                              initialIP:initialIP
138
 
                                              stackSize:stackSize];
139
 
        }
140
 
 
141
 
        /* Avoid allocation */
142
 
        context = cachedContext;
143
 
        [[context stack] empty];
144
 
        [context resetInstructionPointer];
145
 
    }
146
 
    else
147
 
    {
148
 
        /* Create new context */
149
 
        context = [[STBlockContextClass alloc] initWithInterpreter:interpreter
150
 
                                                         initialIP:initialIP
151
 
                                                         stackSize:stackSize];
152
 
 
153
 
        AUTORELEASE(context);
154
 
    }
155
 
 
156
 
    /* push block arguments to the stack */
157
 
    
158
 
    stack = [context stack];
159
 
    for(i = 0; i<count; i++)
160
 
    {
161
 
        [stack push:args[i]];
162
 
    }
163
 
 
164
 
    [context setHomeContext:homeContext];
165
 
 
166
 
    parentContext = [interpreter context];
167
 
 
168
 
    [interpreter setContext:context];
169
 
    retval = [interpreter interpret];
170
 
    [interpreter setContext:parentContext];
171
 
 
172
 
    /* Release cached context */
173
 
    if(usingCachedContext)
174
 
    {
175
 
        usingCachedContext = NO;
176
 
    }
177
 
 
178
 
    return retval;
179
 
}
180
 
 
181
 
- handler:(STBlock *)handlerBlock
182
 
{
183
 
    STExecutionContext *context;
184
 
    id                  retval;
185
 
 
186
 
    /* save the execution context for the case of exception */
187
 
    context = [interpreter context];
188
 
 
189
 
    NS_DURING
190
 
        retval = [self value];
191
 
    NS_HANDLER
192
 
        retval = [handlerBlock valueWith:localException];
193
 
        /* restore the execution context */
194
 
        [interpreter setContext:context];
195
 
    NS_ENDHANDLER
196
 
 
197
 
    return retval;
198
 
}
199
 
 
200
 
- whileTrue:(STBlock *)doBlock
201
 
{
202
 
    id retval = nil;
203
 
    
204
 
    while([[self value] boolValue])
205
 
    {
206
 
        retval = [doBlock value];
207
 
    }
208
 
    return retval;
209
 
}
210
 
 
211
 
- whileFalse:(STBlock *)doBlock
212
 
{
213
 
    id retval = nil;
214
 
    
215
 
    while(! [[self value] boolValue])
216
 
    {
217
 
        retval = [doBlock value];
218
 
    }
219
 
    return retval;
220
 
}
221
 
@end