4 #include "assertions.h"
7 extern SchemeObject sc_nil
;
9 void printActFrm(int p
) {
10 unsigned int fp
,ret
,env
,n
;
18 fprintf( stderr
, "[%d] fp=0x%x\n", p
-1, fp
); fflush(stderr
);
19 fprintf( stderr
, "[%d] ret=0x%x\n", p
-2, ret
); fflush(stderr
);
20 fprintf( stderr
, "[%d] env=0x%x\n", p
-3, env
); fflush(stderr
);
21 fprintf( stderr
, "[%d] n=%d\n", p
-4, n
); fflush(stderr
);
22 for (i
=p
-5; i
>=p
-5-n
+1; i
--) {
23 fprintf( stderr
, "[%d] a[%d]=%s\n",i
, -i
+p
-5, sobToString((SchemeObject
*)(stack
[i
])) );
28 /* Copies the enviroment vector currenv to a new vector of size
29 (currenv_size+1) starting from element #1.
30 Copies the arguments from the stack to element #0 of the new vector.
31 Returns the new env. vector.
33 @param currenv: points to the current enviroment vector
34 @param currenv_size: size of the current enviroment vector
36 int** extendEnviroment(int** currenv
, int currenv_size
)
38 int** newenv
; /* newenv: points to the new envoriment vector */
39 int ndx
; /* ndx: loop index */
41 ASSERT_ALWAYS(currenv_size
>=0,"");
43 /* allocate new enviroment vector */
44 newenv
= autoMalloc( sizeof(int) * (currenv_size
+ 1) );
46 /* copy current enviroment to new enviroment */
49 if (ndx
<=0) goto LendFor1
;
50 newenv
[ndx
] = currenv
[ndx
-1];
54 /* copy arguments from stack to new enviroment vector (extend env.) */
55 if (currenv_size
<=0) goto LendExtend1
; /* no activation frame at all */
56 if (ST_ARG_COUNT()<=0) goto LendExtend1
; /* no args in act. frame */
57 newenv
[0] = autoMalloc( sizeof(int) * ST_ARG_COUNT() );
60 if (ndx
>=ST_ARG_COUNT()) goto LendFor2
;
61 newenv
[0][ndx
] = ST_ARG(ndx
);
70 /* Prepares the stack for a tail-call.
71 Overrides the current activation frame with the new one,
74 void shiftActFrmDown()
76 int low
; /* lowest address of the new activation frame (included) */
77 int high
; /* highest address of the new activation frame (included) */
78 int dest_low
; /* lowest address where to put the new activation frame */
80 int old_fp
= ST_OLDFP(); /* save it as its about to be overwritten */
82 /* Shift activation frame down the stack */
85 dest_low
= ST_FRMEND();
88 stack
[dest_low
] = stack
[low
];
98 /* Shifts the elements in the stack upwards.
100 @param pos: index of the first element to shift
101 @param amount: the number of elements to shift up each element by
103 Shifts up each element between `pos` and sp (inclusive) by `amount`.
105 void shiftStackUp(int pos
, unsigned int amount
)
109 /* shift elements upwards */
110 for (i
=sp
-1; i
>=pos
; --i
) {
111 stack
[i
+amount
] = stack
[i
];
119 /* Shifts the elements in the stack downwards.
121 @param pos: index of the first element to shift
122 @param amount: the number of elements to shift down each element by
124 Shifts down each element between `pos` and sp (inclusive) by `amount`.
126 void shiftStackDown(int pos
, unsigned int amount
)
130 /* shift elements downwards */
131 for (i
=pos
; i
<=sp
-1; ++i
) {
132 stack
[i
-amount
] = stack
[i
];
140 /* Prepares the stack for an application of lambda-optional.
142 @param formalParams: the number of formal parameters the lambda
143 expects, including the optional one.
145 Moves the optional parameters to a list in the heap.
147 void prepareStackForAbsOpt(int formalParams
)
149 int actualParams
= ST_ARG_COUNT();
150 int optionalsUsed
= actualParams
-(formalParams
-1);
152 ASSERT_ALWAYS( optionalsUsed
>=0, "" );
154 if (optionalsUsed
==0) {
155 /* if the optional parameter was not used, initialize it to an
158 /* make room for the optional param */
159 shiftStackUp( ST_FRMEND(), 1 );
161 /* fix actual arguments number (also affects ST_FRMEND)*/
162 ST_ARG_COUNT() = formalParams
;
165 stack
[ ST_FRMEND() ] = (int)&sc_nil
;
168 /* if the optional parameters were used, move them to a list
171 SchemeObject
* opt
; /* the list of optional params */
172 int lastOptional
; /* last opt. param. (lowest index) */
173 int firstOptional
; /* first opt. param. (highest index) */
176 /* copy optional params to a list on the heap */
178 lastOptional
= ST_FRMEND();
179 firstOptional
= lastOptional
+ (optionalsUsed
-1);
181 for (i
=lastOptional
; i
<=firstOptional
; ++i
) {
182 opt
= makeSchemePair( (SchemeObject
*)(stack
[i
]), opt
);
185 /* override all but one optional */
186 shiftStackDown( firstOptional
, optionalsUsed
-1 );
188 /* fix actual arguments number (also affects ST_FRMEND) */
189 ST_ARG_COUNT() = formalParams
;
191 /* the last parameter is a pointer to the new list */
192 stack
[ ST_FRMEND() ] = (int)opt
;
197 /* Reverses a Scheme list (in place)
199 @param list: the list to reverse
200 @return: the reversed list
202 SchemeObject
* reverseSchemeList( SchemeObject
* list
)
211 while ( curr
!=&sc_nil
) {
212 ASSERT_ALWAYS( IS_SOB_PAIR(curr
), MSG_ERR_NOTLIST
);
213 next
= SOB_PAIR_CDR(curr
);
214 SOB_PAIR_CDR(curr
) = prev
;
222 /* Pushes the argument list (and the number of arguments in the list
225 @param list: the arguments list
227 The arguments are pushed backwards.
229 void pushArgsList(SchemeObject
* list
)
233 2. push each argument
234 3. push the number of arguments
241 list
= reverseSchemeList( list
);
245 while (pair
!= &sc_nil
) {
246 push( (int)SOB_PAIR_CAR(pair
) );
247 pair
= SOB_PAIR_CDR(pair
);
252 list
= reverseSchemeList( list
);