2008-08-10 03:01:00 +02:00
|
|
|
// 'for' function
|
2006-09-22 01:54:47 +02:00
|
|
|
|
|
|
|
#include "stdafx.h"
|
|
|
|
#include "defs.h"
|
|
|
|
|
2008-08-10 03:01:00 +02:00
|
|
|
#define A p3
|
|
|
|
#define B p4
|
|
|
|
#define I p5
|
|
|
|
#define X p6
|
|
|
|
|
2006-09-22 01:54:47 +02:00
|
|
|
void
|
|
|
|
eval_for(void)
|
|
|
|
{
|
2008-07-25 23:44:52 +02:00
|
|
|
int i, j, k;
|
2006-10-06 20:28:26 +02:00
|
|
|
|
2008-07-25 23:44:52 +02:00
|
|
|
// 1st arg (quoted)
|
2006-10-06 20:28:26 +02:00
|
|
|
|
2008-08-10 03:01:00 +02:00
|
|
|
X = cadr(p1);
|
2008-08-15 07:34:58 +02:00
|
|
|
if (!issymbol(X))
|
|
|
|
stop("for: 1st arg?");
|
2006-10-06 20:28:26 +02:00
|
|
|
|
2008-07-25 23:44:52 +02:00
|
|
|
// 2nd arg
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2008-07-25 23:44:52 +02:00
|
|
|
push(caddr(p1));
|
|
|
|
eval();
|
|
|
|
j = pop_integer();
|
|
|
|
if (j == (int) 0x80000000)
|
|
|
|
stop("for: 2nd arg?");
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2008-07-25 23:44:52 +02:00
|
|
|
// 3rd arg
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2008-07-25 23:44:52 +02:00
|
|
|
push(cadddr(p1));
|
|
|
|
eval();
|
2006-10-06 20:28:26 +02:00
|
|
|
k = pop_integer();
|
2008-07-25 23:44:52 +02:00
|
|
|
if (k == (int) 0x80000000)
|
|
|
|
stop("for: 3rd arg?");
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2008-08-10 03:01:00 +02:00
|
|
|
// remaining args
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2008-07-25 23:44:52 +02:00
|
|
|
p1 = cddddr(p1);
|
2004-03-03 21:24:06 +01:00
|
|
|
|
2008-08-10 03:01:00 +02:00
|
|
|
B = get_binding(X);
|
|
|
|
A = get_arglist(X);
|
|
|
|
|
2004-03-03 21:24:06 +01:00
|
|
|
for (i = j; i <= k; i++) {
|
2008-08-10 03:01:00 +02:00
|
|
|
push_integer(i);
|
|
|
|
I = pop();
|
|
|
|
set_binding(X, I);
|
2008-07-25 23:44:52 +02:00
|
|
|
p2 = p1;
|
|
|
|
while (iscons(p2)) {
|
|
|
|
push(car(p2));
|
2006-09-22 01:54:47 +02:00
|
|
|
eval();
|
|
|
|
pop();
|
2008-07-25 23:44:52 +02:00
|
|
|
p2 = cdr(p2);
|
2006-09-22 01:54:47 +02:00
|
|
|
}
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
|
|
|
|
2008-08-10 03:01:00 +02:00
|
|
|
set_binding_and_arglist(X, B, A);
|
|
|
|
|
|
|
|
// return value
|
|
|
|
|
|
|
|
push_symbol(NIL);
|
2004-03-03 21:24:06 +01:00
|
|
|
}
|
2008-08-10 03:01:00 +02:00
|
|
|
|