Bug Summary

File:src/fint.c
Warning:line 5510, column 2
Value stored to 'oldStack' is never read

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple x86_64-unknown-linux-gnu -analyze -disable-free -clear-ast-before-backend -disable-llvm-verifier -discard-value-names -main-file-name fint.c -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -mrelocation-model pic -pic-level 2 -pic-is-pie -mframe-pointer=all -fmath-errno -ffp-contract=on -fno-rounding-math -mconstructor-aliases -funwind-tables=2 -target-cpu x86-64 -tune-cpu generic -debugger-tuning=gdb -fdebug-compilation-dir=/home/kfp/aldor/aldor/aldor/src -fcoverage-compilation-dir=/home/kfp/aldor/aldor/aldor/src -resource-dir /usr/local/lib/clang/18 -D PACKAGE_NAME="aldor" -D PACKAGE_TARNAME="aldor" -D PACKAGE_VERSION="1.4.0" -D PACKAGE_STRING="aldor 1.4.0" -D PACKAGE_BUGREPORT="aldor@xinutec.org" -D PACKAGE_URL="" -D PACKAGE="aldor" -D VERSION="1.4.0" -D YYTEXT_POINTER=1 -D HAVE_STDIO_H=1 -D HAVE_STDLIB_H=1 -D HAVE_STRING_H=1 -D HAVE_INTTYPES_H=1 -D HAVE_STDINT_H=1 -D HAVE_STRINGS_H=1 -D HAVE_SYS_STAT_H=1 -D HAVE_SYS_TYPES_H=1 -D HAVE_UNISTD_H=1 -D STDC_HEADERS=1 -D HAVE_LIBREADLINE=1 -D HAVE_READLINE_READLINE_H=1 -D HAVE_READLINE_HISTORY=1 -D HAVE_READLINE_HISTORY_H=1 -D USE_GLOOP_SHELL=1 -D GENERATOR_COROUTINES=0 -D HAVE_DLFCN_H=1 -D LT_OBJDIR=".libs/" -I . -D VCSVERSION="2c53e759f1e00e345f8b172e7139debda72fda13" -internal-isystem /usr/local/lib/clang/18/include -internal-isystem /usr/local/include -internal-isystem /usr/lib/gcc/x86_64-linux-gnu/14/../../../../x86_64-linux-gnu/include -internal-externc-isystem /usr/include/x86_64-linux-gnu -internal-externc-isystem /include -internal-externc-isystem /usr/include -O0 -Wno-empty-body -Wno-enum-compare -Wno-missing-field-initializers -Wno-unused -Wno-unused-parameter -Wno-error=format -Wno-error=type-limits -Wno-error=strict-aliasing -Wno-sign-compare -Wno-error=shift-negative-value -Wno-error=clobbered -std=c99 -ferror-limit 19 -fgnuc-version=4.2.1 -fskip-odr-check-in-gmf -analyzer-output=html -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /tmp/scan-build-2026-01-15-223856-845667-1 -x c fint.c
1/*****************************************************************************
2 *
3 * fint.c: foam interpreter.
4 *
5 * Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org).
6 *
7 ****************************************************************************/
8
9#define _POSIX_SOURCE1 1 /* fileno */
10
11#include "abpretty.h"
12#include "archive.h"
13#include "axlobs.h"
14#include "bigint.h"
15#include "cmdline.h"
16#include "comsg.h"
17#include "debug.h"
18#include "file.h"
19#include "fint.h"
20#include "fluid.h"
21#include "foam_c.h"
22#include "lib.h"
23#include "opsys.h"
24#include "output.h"
25#include "store.h"
26#include "strops.h"
27#include "syme.h"
28#include "syscmd.h"
29#include "timer.h"
30#include "util.h"
31#include "xfloat.h"
32
33
34
35/* #define FiBool FiWord */
36
37int fintMode = FINT_DONT0;
38
39
40/* Exception handling: format of the try-block. */
41static int fintCurrentFormat = emptyFormatSlot4;
42
43
44/* Data Object Representation */
45
46typedef Length FiProgPos; /* position in the buffer */
47
48struct fmt {
49 int type;
50 String id;
51 int protocol;
52 int format;
53 int offset; /* used for lex vars */
54};
55
56typedef struct fmt * Fmt;
57typedef struct fintUnit * FintUnit;
58
59struct progInfo {
60 int progType; /* 0 => normal, 1 => coroutine */
61 FintUnit unit; /* unit in which is contained */
62 String name; /* name of the const that defines prog */
63 FiProgPos fiProgPos; /* pos. of Seq command */
64 int size; /* size */
65 FiProgPos * labels; /* labels */
66 int nLabels;
67 int labelFmt;
68 AInt retType; /* return type */
69 int mValFmt;
70 UByte bMask;
71 Fmt fmtLoc; /* locals */
72 int locsCount;
73 Fmt fmtPar; /* parameters */
74 int parsCount;
75 UByte * dfluid; /* DFluid */
76 UByte dfluidsCount;
77 UByte * denv; /* DEnv */
78 UByte denvsCount;
79
80 FiWord _progInfo; /* $$ REMOVE when interfaced w/h C */
81};
82
83typedef struct progInfo * ProgInfo;
84typedef union dataObj * DataObj;
85typedef struct mFmt * MFmt;
86typedef struct shDataObj* ShDataObj;
87
88union dataObj {
89 FiNil _fiNil; /* (fiNil already defined!) */
90 FiWord fiWord;
91 FiArb fiArb;
92 FiPtr fiPtr;
93 FiBool fiBool;
94 FiByte fiByte;
95 FiHInt fiHInt;
96 FiSInt fiSInt;
97 FiChar fiChar;
98 FiArr fiArr;
99 FiRec fiRec;
100 FiTR fiTR;
101 FiProgPos fiProgPos;
102 FiClos fiClos;
103 FiEnv fiEnv;
104 FiBInt fiBInt;
105 FiSFlo fiSFlo;
106 FiDFlo fiDFlo;
107 FiProg fiProg;
108 FiGener fiGener;
109 FiGenIter fiGenIter;
110 /* -------- for internal use: -------------- */
111 FiFluid fiFluid;
112 DataObj ptr;
113 FiProgPos * labels;
114 ProgInfo progInfo;
115 FintUnit fiUnit;
116 MFmt mFmt;
117
118};
119
120struct mFmt {
121 int fmt;
122 DataObj values;
123
124}; /* for multiple values */
125
126struct shDataObj {
127 int refCounter;
128 union dataObj dataObj;
129};
130
131# define fintDataSizesizeof(union dataObj) sizeof(union dataObj)
132
133typedef DataObj * Ref;
134typedef AInt dataType;
135typedef dataType * DataType;
136typedef AInt FintLabel;
137
138/****************************************************************************
139 *
140 ***************************************************************************/
141
142
143struct lexLevel {
144 Fmt fmtLex;
145 int fmtLexsCount;
146 int fmtSize;
147
148};
149
150typedef struct lexLevel * LexLevels;
151typedef struct lexLevel lexLevel;
152
153struct fintUnit {
154 unsigned unitId; /* Unique for every loaded unit */
155 UByte * tape;
156 Buffer buf;
157 String name;
158
159 Fmt fmtGlobs;
160 ShDataObj * globValues;
161 int globsCount;
162
163 Fmt fmtConsts;
164 DataObj constValues;
165 int constsCount;
166
167 Fmt fmtFluids;
168 int fluidsCount;
169
170 LexLevels lexLevels;
171 int lexLevelsCount;
172
173};
174
175typedef struct fintUnit fintUnit;
176
177/**************************************************************************
178 *
179 * Interface for FintUnit
180 *
181 *************************************************************************/
182
183
184# define fintUnitId(u)((u)->unitId) ((u)->unitId)
185# define fintUnitTape(u)((u)->tape) ((u)->tape)
186# define fintUnitBuffer(u)((u)->buf) ((u)->buf)
187# define fintUnitName(u)((u)->name) ((u)->name)
188
189# define fintUnitGlobs(u)((u)->fmtGlobs) ((u)->fmtGlobs)
190# define fintUnitConsts(u)((u)->fmtConsts) ((u)->fmtConsts)
191# define fintUnitFluids(u)((u)->fmtFluids) ((u)->fmtFluids)
192# define fintUnitLexLevels(u)((u)->lexLevels) ((u)->lexLevels)
193
194# define fintUnitGlobsCount(u)((u)->globsCount) ((u)->globsCount)
195# define fintUnitConstsCount(u)((u)->constsCount) ((u)->constsCount)
196# define fintUnitFluidsCount(u)((u)->fluidsCount) ((u)->fluidsCount)
197# define fintUnitLexLevelsCount(u)((u)->lexLevelsCount) ((u)->lexLevelsCount)
198# define fintUnitLexsCount(u,lev)(((u)->lexLevels[(lev)]).fmtLexsCount) (((u)->lexLevels[(lev)]).fmtLexsCount)
199# define fintUnitFmtSize(u,lev)(((u)->lexLevels[(lev)]).fmtSize) (((u)->lexLevels[(lev)]).fmtSize)
200
201# define fintUnitGlobValues(u)((u)->globValues) ((u)->globValues)
202# define fintUnitConstValues(u)((u)->constValues) ((u)->constValues)
203
204/**************************************************************************
205 *
206 * Basic operation for Format
207 *
208 *************************************************************************/
209
210# define fmtType(f)((f)->type) ((f)->type)
211# define fmtId(f)((f)->id) ((f)->id)
212# define fmtProtocol(f)((f)->protocol) ((f)->protocol)
213# define fmtFormat(f)((f)->format) ((f)->format)
214# define fmtOffset(f)((f)->offset) ((f)->offset)
215
216/**************************************************************************
217 *
218 * Basic operation for globals
219 *
220 *************************************************************************/
221
222# define globType(n)((((unit)->fmtGlobs)[(n)]).type) ((fintUnitGlobs(unit)((unit)->fmtGlobs)[(n)]).type)
223# define globId(n)((((unit)->fmtGlobs)[(n)]).id) ((fintUnitGlobs(unit)((unit)->fmtGlobs)[(n)]).id)
224# define globProtocol(n)((((unit)->fmtGlobs)[(n)]).protocol) ((fintUnitGlobs(unit)((unit)->fmtGlobs)[(n)]).protocol)
225# define globValue(n)(((unit)->globValues[(n)])->dataObj) (((unit)->globValues[(n)])->dataObj)
226
227/**************************************************************************
228 *
229 * Basic operation for constants
230 *
231 *************************************************************************/
232
233# define constType(n)((((unit)->fmtConsts)[(n)]).type) ((fintUnitConsts(unit)((unit)->fmtConsts)[(n)]).type)
234# define constId(n)((((unit)->fmtConsts)[(n)]).id) ((fintUnitConsts(unit)((unit)->fmtConsts)[(n)]).id)
235# define constValue(n)((unit)->constValues[(n)]) ((unit)->constValues[(n)])
236
237/**************************************************************************
238 *
239 * Basic operation for locals
240 *
241 *************************************************************************/
242
243# define locType(n)(((prog)->fmtLoc)[(n)].type) (progInfoFmtLoc(prog)((prog)->fmtLoc)[(n)].type)
244# define locId(n)(((prog)->fmtLoc)[(n)].id) (progInfoFmtLoc(prog)((prog)->fmtLoc)[(n)].id)
245# define locValue(n)(locValues[(n)]) (locValues[(n)])
246
247/**************************************************************************
248 *
249 * Basic operation for fluids
250 *
251 *************************************************************************/
252
253# define fluidType(n)(((unit)->fmtFluids)[(n)].type) (fintUnitFluids(unit)((unit)->fmtFluids)[(n)].type)
254# define fluidId(n)(((unit)->fmtFluids)[(n)].id) (fintUnitFluids(unit)((unit)->fmtFluids)[(n)].id)
255# define fluidValue(n)(fluidValues[(n)].fiFluid) (fluidValues[(n)].fiFluid)
256
257/**************************************************************************
258 *
259 * Basic operation for parameters
260 *
261 *************************************************************************/
262
263# define parType(n)(((prog)->fmtPar)[(n)].type) (progInfoFmtPar(prog)((prog)->fmtPar)[(n)].type)
264# define parId(n)(((prog)->fmtPar)[(n)].id) (progInfoFmtPar(prog)((prog)->fmtPar)[(n)].id)
265# define parValue(n)(bp[(n)+10]) (bp[(n)+PAR_OFFSET10])
266
267/**************************************************************************
268 *
269 * Basic operation for lexicals
270 *
271 *************************************************************************/
272
273# define lexType(l,n)(((unit)->lexLevels)[(prog->denv[(l)])].fmtLex[(n)].type
)
(fintUnitLexLevels(unit)((unit)->lexLevels)[(prog->denv[(l)])].fmtLex[(n)].type)
274# define fmtType0(f,n)(((unit)->lexLevels)[(f)].fmtLex[(n)].type) (fintUnitLexLevels(unit)((unit)->lexLevels)[(f)].fmtLex[(n)].type)
275# define lexFormat(f,n)(((unit)->lexLevels)[(f)].fmtLex[(n)].format) (fintUnitLexLevels(unit)((unit)->lexLevels)[(f)].fmtLex[(n)].format)
276
277/**************************************************************************
278 *
279 * Basic operation for progInfo
280 *
281 *************************************************************************/
282
283# define progInfoUnit(p)((p)->unit) ((p)->unit)
284# define progInfoName(p)((p)->name) ((p)->name)
285# define progInfoTape(p)((p)->tape) ((p)->tape)
286# define progInfoSeq(p)((p)->fiProgPos) ((p)->fiProgPos)
287# define progInfoSize(p)((p)->size) ((p)->size)
288# define progInfoLabels(p)((p)->labels) ((p)->labels)
289# define progInfoNLabels(p)((p)->nLabels) ((p)->nLabels)
290# define progInfoLabelFmt(p)((p)->labelFmt) ((p)->labelFmt)
291# define progInfoFmtLoc(p)((p)->fmtLoc) ((p)->fmtLoc)
292# define progInfoRetType(p)((p)->retType) ((p)->retType)
293# define progInfoMValFmt(p)((p)->mValFmt) ((p)->mValFmt)
294# define progInfoBMask(p)((p)->bMask) ((p)->bMask)
295# define progInfoLocsCount(p)((p)->locsCount) ((p)->locsCount)
296# define progInfoFmtPar(p)((p)->fmtPar) ((p)->fmtPar)
297# define progInfoParsCount(p)((p)->parsCount) ((p)->parsCount)
298# define progInfoDFluid(p)((p)->dfluid) ((p)->dfluid)
299# define progInfoDFluidsCount(p)((p)->dfluidsCount) ((p)->dfluidsCount)
300# define progInfoDEnv(p)((p)->denv) ((p)->denv)
301# define progInfoDEnvsCount(p)((p)->denvsCount) ((p)->denvsCount)
302
303/* -------------------------------------------------------------- */
304
305/* type is FOAM_Bool, FOAM_Char, etc.
306 * ref is a pointer to a dataObj union
307 * expr is a dataObj union
308 */
309# define fintSet(type, ref, expr){ do { if (!(ref != ((void*)0))) _do_assert(("ref != NULL"),"fint.c"
,309); } while (0); switch ((int)type) { case FOAM_Char: *(FiChar
*)(ref) = (expr).fiChar; break; case FOAM_Bool: (ref)->fiBool
= (expr).fiBool; break; case FOAM_Byte: (ref)->fiByte = (
expr).fiByte; break; case FOAM_HInt: (ref)->fiHInt = (expr
).fiHInt; break; case FOAM_SInt: (ref)->fiSInt = (expr).fiSInt
; break; case FOAM_SFlo: (ref)->fiSFlo = (expr).fiSFlo; break
; case FOAM_DFlo: (ref)->fiDFlo = (expr).fiDFlo; break; case
FOAM_Word: (ref)->fiWord = (expr).fiWord; break; case FOAM_Arb
: (ref)->fiArb = (expr).fiArb; break; case FOAM_Ptr: (ref)
->fiPtr = (expr).fiPtr; break; case FOAM_Rec: (ref)->fiRec
= (expr).fiRec; break; case FOAM_Arr: (ref)->fiArr = (expr
).fiArr; break; case FOAM_TR: (ref)->fiTR = (expr).fiTR; break
; case FOAM_Prog: (ref)->fiProgPos=(expr).fiProgPos; break
; case FOAM_Clos: (ref)->fiClos = (expr).fiClos; break; case
FOAM_Gener: (ref)->fiGener = (expr).fiGener; break; case FOAM_GenIter
: (ref)->fiGenIter = (expr).fiGenIter; break; case FOAM_Env
: (ref)->fiEnv = (expr).fiEnv; break; case FOAM_NOp: fintSetMFmt
((ref), &(expr)); break; case FOAM_Nil: (ref)->_fiNil =
(expr)._fiNil; break; case FOAM_BInt: (ref)->fiBInt = (Ptr
) (bintCopy((BInt) (expr).fiBInt)); break; default: fintWhere
(((int) 0));bug("fintSet: type %d unimplemented.", (int)type)
; } }
{ \
310 assert(ref != NULL)do { if (!(ref != ((void*)0))) _do_assert(("ref != NULL"),"fint.c"
,310); } while (0)
; \
311 switch ((int)type) { \
312 case FOAM_Char: *(FiChar *)(ref) = (expr).fiChar; break; \
313 case FOAM_Bool: (ref)->fiBool = (expr).fiBool; break; \
314 case FOAM_Byte: (ref)->fiByte = (expr).fiByte; break; \
315 case FOAM_HInt: (ref)->fiHInt = (expr).fiHInt; break; \
316 case FOAM_SInt: (ref)->fiSInt = (expr).fiSInt; break; \
317 case FOAM_SFlo: (ref)->fiSFlo = (expr).fiSFlo; break; \
318 case FOAM_DFlo: (ref)->fiDFlo = (expr).fiDFlo; break; \
319 case FOAM_Word: (ref)->fiWord = (expr).fiWord; break; \
320 case FOAM_Arb: (ref)->fiArb = (expr).fiArb; break; \
321 case FOAM_Ptr: (ref)->fiPtr = (expr).fiPtr; break; \
322 case FOAM_Rec: (ref)->fiRec = (expr).fiRec; break; \
323 case FOAM_Arr: (ref)->fiArr = (expr).fiArr; break; \
324 case FOAM_TR: (ref)->fiTR = (expr).fiTR; break; \
325 case FOAM_Prog: (ref)->fiProgPos=(expr).fiProgPos; break;\
326 case FOAM_Clos: (ref)->fiClos = (expr).fiClos; break;\
327 case FOAM_Gener: (ref)->fiGener = (expr).fiGener; break;\
328 case FOAM_GenIter: (ref)->fiGenIter = (expr).fiGenIter; break;\
329 case FOAM_Env: (ref)->fiEnv = (expr).fiEnv; break;\
330 case FOAM_NOp: fintSetMFmt((ref), &(expr)); break; \
331 case FOAM_Nil: (ref)->_fiNil = (expr)._fiNil; break;\
332 case FOAM_BInt: (ref)->fiBInt = (Ptr) (bintCopy((BInt) (expr).fiBInt)); break;\
333 default: fintWhere(int0((int) 0));bug("fintSet: type %d unimplemented.", (int)type); \
334 } \
335 }
336
337# define fintASetElem(type, ref, n, expr){ switch ((int)type) { case FOAM_Char: ((FiChar *)((ref)->
fiArr))[(n)] = (expr).fiChar; break; case FOAM_Bool: ((FiBool
*)((ref)->fiArr))[(n)] = (expr).fiBool; break; case FOAM_Byte
: ((FiByte *)((ref)->fiArr))[(n)] = (expr).fiByte; break; case
FOAM_HInt: ((FiHInt *)((ref)->fiArr))[(n)] = (expr).fiHInt
; break; case FOAM_SInt: ((FiSInt *)((ref)->fiArr))[(n)] =
(expr).fiSInt; break; case FOAM_SFlo: ((FiSFlo *)((ref)->
fiArr))[(n)] = (expr).fiSFlo; break; case FOAM_DFlo: ((FiDFlo
*)((ref)->fiArr))[(n)] = (expr).fiDFlo; break; case FOAM_Word
: ((FiWord *)((ref)->fiArr))[(n)] = (expr).fiWord; break; case
FOAM_BInt: ((FiBInt *)((ref)->fiArr))[(n)] = (expr).fiBint
; break; default: fintWhere(((int) 0));bug("fintASetElem: type %d unimplemented."
, (int)type); } }
{ \
338 switch ((int)type) { \
339 case FOAM_Char: ((FiChar *)((ref)->fiArr))[(n)] = (expr).fiChar; break; \
340 case FOAM_Bool: ((FiBool *)((ref)->fiArr))[(n)] = (expr).fiBool; break; \
341 case FOAM_Byte: ((FiByte *)((ref)->fiArr))[(n)] = (expr).fiByte; break; \
342 case FOAM_HInt: ((FiHInt *)((ref)->fiArr))[(n)] = (expr).fiHInt; break; \
343 case FOAM_SInt: ((FiSInt *)((ref)->fiArr))[(n)] = (expr).fiSInt; break; \
344 case FOAM_SFlo: ((FiSFlo *)((ref)->fiArr))[(n)] = (expr).fiSFlo; break; \
345 case FOAM_DFlo: ((FiDFlo *)((ref)->fiArr))[(n)] = (expr).fiDFlo; break; \
346 case FOAM_Word: ((FiWord *)((ref)->fiArr))[(n)] = (expr).fiWord; break; \
347 case FOAM_BInt: ((FiBInt *)((ref)->fiArr))[(n)] = (expr).fiBint; break; \
348 default: fintWhere(int0((int) 0));bug("fintASetElem: type %d unimplemented.", (int)type); \
349 } \
350}
351
352# define fintAGetElem(type, pdata, ref, n){ switch ((int)type) { case FOAM_Char: (pdata)->fiChar = (
(FiChar *)((ref)->fiArr))[(n)]; break; case FOAM_Bool: (pdata
)->fiBool = ((FiBool *)((ref)->fiArr))[(n)]; break; case
FOAM_Byte: (pdata)->fiByte = ((FiByte *)((ref)->fiArr)
)[(n)]; break; case FOAM_HInt: (pdata)->fiHInt = ((FiHInt *
)((ref)->fiArr))[(n)]; break; case FOAM_SInt: (pdata)->
fiSInt = ((FiSInt *)((ref)->fiArr))[(n)]; break; case FOAM_SFlo
: (pdata)->fiSFlo = ((FiSFlo *)((ref)->fiArr))[(n)]; break
; case FOAM_DFlo: (pdata)->fiDFlo = ((FiDFlo *)((ref)->
fiArr))[(n)]; break; case FOAM_Word: (pdata)->fiWord = ((FiWord
*)((ref)->fiArr))[(n)]; break; case FOAM_BInt: (pdata)->
fiBInt = ((FiBInt *)((ref)->fiArr))[(n)]; break; default: fintWhere
(((int) 0));bug("fintAGetElem: type %d unimplemented.", (int)
type); } }
{ \
353 switch ((int)type) { \
354 case FOAM_Char: (pdata)->fiChar = ((FiChar *)((ref)->fiArr))[(n)]; break; \
355 case FOAM_Bool: (pdata)->fiBool = ((FiBool *)((ref)->fiArr))[(n)]; break; \
356 case FOAM_Byte: (pdata)->fiByte = ((FiByte *)((ref)->fiArr))[(n)]; break; \
357 case FOAM_HInt: (pdata)->fiHInt = ((FiHInt *)((ref)->fiArr))[(n)]; break; \
358 case FOAM_SInt: (pdata)->fiSInt = ((FiSInt *)((ref)->fiArr))[(n)]; break; \
359 case FOAM_SFlo: (pdata)->fiSFlo = ((FiSFlo *)((ref)->fiArr))[(n)]; break; \
360 case FOAM_DFlo: (pdata)->fiDFlo = ((FiDFlo *)((ref)->fiArr))[(n)]; break; \
361 case FOAM_Word: (pdata)->fiWord = ((FiWord *)((ref)->fiArr))[(n)]; break; \
362 case FOAM_BInt: (pdata)->fiBInt = ((FiBInt *)((ref)->fiArr))[(n)]; break; \
363 default: fintWhere(int0((int) 0));bug("fintAGetElem: type %d unimplemented.", (int)type); \
364 } \
365}
366
367# define fintAGetElemRef(type, pdata, ref, n){ switch ((int)type) { case FOAM_Char:(pdata)=(DataObj)(((FiChar
*)((ref)->fiArr)) + (n)); break; case FOAM_Bool:(pdata)=(
DataObj)(((FiBool *)((ref)->fiArr)) + (n)); break; case FOAM_Byte
:(pdata)=(DataObj)(((FiByte *)((ref)->fiArr)) + (n)); break
; case FOAM_HInt:(pdata)=(DataObj)(((FiHInt *)((ref)->fiArr
)) + (n)); break; case FOAM_SInt:(pdata)=(DataObj)(((FiSInt *
)((ref)->fiArr)) + (n)); break; case FOAM_SFlo:(pdata)=(DataObj
)(((FiSFlo *)((ref)->fiArr)) + (n)); break; case FOAM_DFlo
:(pdata)=(DataObj)(((FiDFlo *)((ref)->fiArr)) + (n)); break
; case FOAM_Word:(pdata)=(DataObj)(((FiWord *)((ref)->fiArr
)) + (n)); break; case FOAM_BInt:(pdata)=(DataObj)(((FiBInt *
)((ref)->fiArr)) + (n)); break; default: fintWhere(((int) 0
));bug("fintAGetElemRef: type %d unimplemented.", (int)type);
} }
{ \
368 switch ((int)type) { \
369 case FOAM_Char:(pdata)=(DataObj)(((FiChar *)((ref)->fiArr)) + (n)); break;\
370 case FOAM_Bool:(pdata)=(DataObj)(((FiBool *)((ref)->fiArr)) + (n)); break;\
371 case FOAM_Byte:(pdata)=(DataObj)(((FiByte *)((ref)->fiArr)) + (n)); break;\
372 case FOAM_HInt:(pdata)=(DataObj)(((FiHInt *)((ref)->fiArr)) + (n)); break;\
373 case FOAM_SInt:(pdata)=(DataObj)(((FiSInt *)((ref)->fiArr)) + (n)); break;\
374 case FOAM_SFlo:(pdata)=(DataObj)(((FiSFlo *)((ref)->fiArr)) + (n)); break;\
375 case FOAM_DFlo:(pdata)=(DataObj)(((FiDFlo *)((ref)->fiArr)) + (n)); break;\
376 case FOAM_Word:(pdata)=(DataObj)(((FiWord *)((ref)->fiArr)) + (n)); break;\
377 case FOAM_BInt:(pdata)=(DataObj)(((FiBInt *)((ref)->fiArr)) + (n)); break;\
378 default: fintWhere(int0((int) 0));bug("fintAGetElemRef: type %d unimplemented.", (int)type); \
379 } \
380}
381
382# define fintGetTypeSize(x, type){ switch ((int)type) { case FOAM_Char: (x) = sizeof(FiChar); break
; case FOAM_Bool: (x) = sizeof(FiBool); break; case FOAM_Byte
: (x) = sizeof(FiByte); break; case FOAM_HInt: (x) = sizeof(FiHInt
); break; case FOAM_SInt: (x) = sizeof(FiSInt); break; case FOAM_BInt
: (x) = sizeof(FiBInt); break; case FOAM_SFlo: (x) = sizeof(FiSFlo
); break; case FOAM_DFlo: (x) = sizeof(FiDFlo); break; case FOAM_Arr
: (x) = sizeof(FiArr); break; case FOAM_Rec: (x) = sizeof(FiRec
); break; case FOAM_TR: (x) = sizeof(FiTR); break; case FOAM_Env
: (x) = sizeof(FiEnv); break; case FOAM_Prog: (x) = sizeof(FiProg
); break; case FOAM_Clos: (x) = sizeof(FiClos); break; case FOAM_Gener
: (x) = sizeof(FiGener); break; case FOAM_GenIter: (x) = sizeof
(FiGenIter); break; case FOAM_Ptr: (x) = sizeof(FiPtr); break
; case FOAM_Word: (x) = sizeof(FiWord); break; case FOAM_Arb:
(x) = sizeof(FiArb); break; case FOAM_Nil: (x) = sizeof(FiNil
); break; default: fintWhere(((int) 0));bug("fintGetTypeSize: type %d unimplemented."
, (int)type); }}
{ \
383 switch ((int)type) { \
384 case FOAM_Char: (x) = sizeof(FiChar); break; \
385 case FOAM_Bool: (x) = sizeof(FiBool); break; \
386 case FOAM_Byte: (x) = sizeof(FiByte); break; \
387 case FOAM_HInt: (x) = sizeof(FiHInt); break; \
388 case FOAM_SInt: (x) = sizeof(FiSInt); break; \
389 case FOAM_BInt: (x) = sizeof(FiBInt); break; \
390 case FOAM_SFlo: (x) = sizeof(FiSFlo); break; \
391 case FOAM_DFlo: (x) = sizeof(FiDFlo); break; \
392 case FOAM_Arr: (x) = sizeof(FiArr); break; \
393 case FOAM_Rec: (x) = sizeof(FiRec); break; \
394 case FOAM_TR: (x) = sizeof(FiTR); break; \
395 case FOAM_Env: (x) = sizeof(FiEnv); break; \
396 case FOAM_Prog: (x) = sizeof(FiProg); break; \
397 case FOAM_Clos: (x) = sizeof(FiClos); break; \
398 case FOAM_Gener: (x) = sizeof(FiGener); break; \
399 case FOAM_GenIter: (x) = sizeof(FiGenIter); break; \
400 case FOAM_Ptr: (x) = sizeof(FiPtr); break; \
401 case FOAM_Word: (x) = sizeof(FiWord); break; \
402 case FOAM_Arb: (x) = sizeof(FiArb); break; \
403 case FOAM_Nil: (x) = sizeof(FiNil); break; \
404 default: fintWhere(int0((int) 0));bug("fintGetTypeSize: type %d unimplemented.", (int)type); \
405 }}
406
407/* $$!! ----- From foam.c; This should be moved in foam.h ----- */
408#define STD_FORMS2 2 /* Number of standard formats.
409 * I.e. all 4 or 1 bytes.
410 * Cannot be changed */
411
412#define FFO_ORIGIN(FOAM_VECTOR_START) (FOAM_VECTOR_START)
413#define FFO_SPAN(FOAM_LIMIT - (FOAM_VECTOR_START)) (FOAM_LIMIT - FFO_ORIGIN(FOAM_VECTOR_START))
414
415/**************************************************************************
416 *
417 * Tape management
418 *
419 *************************************************************************/
420
421#define fintGetByte(b)((b) = tape[ip++]) ((b) = tape[ip++])
422#define fintUngetByte()(ip--) (ip--)
423#define fintGetHInt(i){ String _s = fintGetn(2); (i) = ((((ULong) _s[0])&((1<<
8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<8)); }
{ \
424 String _s = fintGetn(HINT_BYTES2); \
425 (i) = UNBYTE2(_s[0],_s[1])((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1])&
((1<<8)-1))<<8))
; \
426}
427
428#define fintGetSInt(i){ String _s = fintGetn(4); (i) = (int) (((((ULong) _s[0])&
((1<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8))|(((((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[
3])&((1<<8)-1))<<8))<<(2*8))); }
{ \
429 String _s = fintGetn(SINT_BYTES4); \
430 (i) = (int) UNBYTE4(_s[0],_s[1],_s[2],_s[3])(((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1])&
((1<<8)-1))<<8))|(((((ULong) _s[2])&((1<<
8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<8))<<
(2*8)))
; \
431}
432
433#define fintGetChars(s, cc)strncpy(s, fintGetn(cc), cc) \
434 strncpy(s, fintGetn(cc), cc)
435
436#define FOAM_NARY(-1) (-1)
437#define FOAM_FORMAT_GET(tag)((tag)<(FOAM_VECTOR_START)? 0:(((tag)-(FOAM_VECTOR_START))
/(FOAM_LIMIT - (FOAM_VECTOR_START))))
((tag)<FFO_ORIGIN(FOAM_VECTOR_START)? 0:FOAM_FORMAT_GET_X(tag)(((tag)-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))
)
438#define FOAM_FORMAT_GET_X(tag)(((tag)-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))
(((tag)-FFO_ORIGIN(FOAM_VECTOR_START))/FFO_SPAN(FOAM_LIMIT - (FOAM_VECTOR_START)))
439#define FOAM_FORMAT_REMOVE(tag,fmt)((tag) - (fmt)*(FOAM_LIMIT - (FOAM_VECTOR_START))) ((tag) - (fmt)*FFO_SPAN(FOAM_LIMIT - (FOAM_VECTOR_START)))
440#define FOAM_FORMAT_FOR(n)((long)(n) <= ((1<<(1*8))-1) ? 1 : 0) \
441 ((long)(n) <= MAX_BYTE((1<<(1*8))-1) ? 1 : 0)
442
443#define fintGetInt(format, i){ switch (format) { case 0: { String _s = fintGetn(4); (i) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((i) = tape[ip++]); break
; default: (i) = (format) - 2; break; } }
{ \
444 switch (format) { \
445 case 0: fintGetSInt(i){ String _s = fintGetn(4); (i) = (int) (((((ULong) _s[0])&
((1<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8))|(((((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[
3])&((1<<8)-1))<<8))<<(2*8))); }
; break; \
446 case 1: fintGetByte(i)((i) = tape[ip++]); break; \
447 default: (i) = (format) - STD_FORMS2; break; \
448 } \
449}
450
451# define fintGetTagFmt(tag, fmt){ ((tag) = tape[ip++]); fmt = ((tag)<(FOAM_VECTOR_START)? 0
:(((tag)-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); tag = (((tag)) - ((fmt))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); }
{ fintGetByte(tag)((tag) = tape[ip++]); \
452 fmt = FOAM_FORMAT_GET(tag)((tag)<(FOAM_VECTOR_START)? 0:(((tag)-(FOAM_VECTOR_START))
/(FOAM_LIMIT - (FOAM_VECTOR_START))))
; \
453 tag = FOAM_FORMAT_REMOVE((tag),(fmt))(((tag)) - ((fmt))*(FOAM_LIMIT - (FOAM_VECTOR_START))); \
454 }
455
456# define fintGetTagFmtArgc(tag,fmt0,argc0){ { (((tag)) = tape[ip++]); (fmt0) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt0)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt0) { case 0: { String _s = fintGetn(4); (
argc0) = (int) (((((ULong) _s[0])&((1<<8)-1)) | (((
(ULong) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s
[2])&((1<<8)-1)) | ((((ULong) _s[3])&((1<<
8)-1))<<8))<<(2*8))); }; break; case 1: ((argc0) =
tape[ip++]); break; default: (argc0) = (fmt0) - 2; break; } }
else (argc0) = (foamInfoTable [(int)(tag)-(int)FOAM_START]).
argc; }
{ \
457 fintGetTagFmt((tag),(fmt0)){ (((tag)) = tape[ip++]); (fmt0) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt0)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); }
\
458 if (foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).argc == FOAM_NARY(-1)) \
459 fintGetInt(fmt0, argc0){ switch (fmt0) { case 0: { String _s = fintGetn(4); (argc0) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc0) = tape[ip++]);
break; default: (argc0) = (fmt0) - 2; break; } }
\
460 else \
461 (argc0) = foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).argc; }
462
463
464/**************************************************************************
465 *
466 * Stack management
467 *
468 * * Main globals for the stack management are:
469 * - bp: points to the base of the current stack frame
470 * - sp: points to the top of the current stack frame
471 * - stack: points to the current stack (see Stack Chaining)
472 *
473 * * A procedure stack frame consists in:
474 * - header (starting at bp, see below)
475 * - parameters, if any (starting at bp + PAR_OFFSET)
476 * - locals, if any (locValues points to (Loc 0))
477 * - fluids, if any (fluidValues points to (Fluid 0))
478 *
479 * * Stack Chaining
480 * In order to provide a virtually infinite stack, the interpreter stack is
481 * organized as a list of stack. Every element has size STACK_SIZE. The
482 * starting stack is <headStack>. If a stackFrameAlloc or stackAlloc operation
483 * needs X bytes and such amount is not available in the current stack, then
484 * a new stack of size STACK_SIZE is dynamically allocated and is chained to
485 * the previous stack.
486 *************************************************************************/
487
488# define PAR_OFFSET10 10
489/* stack[bp + PAR_OFFSET] is the first parameter */
490
491
492# define STACK_SIZE3000 3000
493
494/* Description of a procedure stack frame header: */
495
496# define stackFrameBp(b)((b)[0].ptr) ((b)[0].ptr)
497# define stackFrameIp(b)((b)[1].fiProgPos) ((b)[1].fiProgPos)
498# define stackFrameLabels(b)((b)[2].labels) ((b)[2].labels)
499# define stackFrameLabelFmt(b)((b)[3].fiChar) ((b)[3].fiChar)
500# define stackFrameLocals(b)((b)[4].ptr) ((b)[4].ptr)
501# define stackFrameLexEnv(b)((b)[5].fiEnv) ((b)[5].fiEnv)
502# define stackFrameProg(b)((b)[6].progInfo) ((b)[6].progInfo)
503# define stackFrameUnit(b)((b)[7].unit) ((b)[7].unit)
504# define stackFrameFluids(b)((b)[8].ptr) ((b)[8].ptr)
505# define stackFrameCurrIter(b)((b)[9].fiGenIter) ((b)[9].fiGenIter)
506
507# define stackAlloc(ptr0,num){ if (sp + num >= stack + 3000 - 11) stackChain(num); (ptr0
) = sp; sp += (num); }
{ \
508 if (sp + num >= stack + STACK_SIZE3000 - 11) stackChain(num); \
509 (ptr0) = sp; sp += (num); \
510 }
511
512# define stackFrameAlloc(nParam){ if (sp + 10 + nParam >= stack + 3000 - 11) stackChain(nParam
+10); sp->ptr = bp; bp = sp; sp += 2; (sp++)->labels = labels
; (sp++)->fiChar = (char) labelFmt; (sp++)->ptr = locValues
; (sp++)->fiEnv = lexEnv; (sp++)->progInfo = prog; (sp++
)->fiUnit = unit; (sp++)->ptr = fluidValues; (sp++)->
fiGenIter = currGenIter; sp += nParam + 1; }
{ \
513 if (sp + PAR_OFFSET10 + nParam >= stack + STACK_SIZE3000 - 11) stackChain(nParam+PAR_OFFSET10); \
514 sp->ptr = bp; \
515 bp = sp; \
516 sp += 2; \
517 (sp++)->labels = labels; \
518 (sp++)->fiChar = (char) labelFmt; \
519 (sp++)->ptr = locValues;\
520 (sp++)->fiEnv = lexEnv; \
521 (sp++)->progInfo = prog; \
522 (sp++)->fiUnit = unit; \
523 (sp++)->ptr = fluidValues; \
524 (sp++)->fiGenIter = currGenIter; \
525 sp += nParam + 1; }
526
527# define stackFrameFree(){ ip = bp[1].fiProgPos; labels = bp[2].labels; labelFmt = (int
) bp[3].fiChar; locValues = bp[4].ptr; lexEnv = bp[5].fiEnv; prog
= bp[6].progInfo; unit = bp[7].fiUnit; fluidValues = bp[8].ptr
; currGenIter = bp[9].fiGenIter; tape = ((unit)->tape); if
(bp < stack || bp >= stack + 3000) { sp = stack[1].ptr
; stack = stack[0].ptr; } else sp = bp; bp = bp->ptr; lev0
= (DataObj) lexEnv->level; }
{ \
528 ip = bp[1].fiProgPos; \
529 labels = bp[2].labels; \
530 labelFmt = (int) bp[3].fiChar; \
531 locValues = bp[4].ptr; \
532 lexEnv = bp[5].fiEnv; \
533 prog = bp[6].progInfo; \
534 unit = bp[7].fiUnit; \
535 fluidValues = bp[8].ptr; \
536 currGenIter = bp[9].fiGenIter; \
537 tape = fintUnitTape(unit)((unit)->tape); \
538 if (bp < stack || bp >= stack + STACK_SIZE3000) { sp = stack[1].ptr; stack = stack[0].ptr; }\
539 else sp = bp; \
540 bp = bp->ptr; \
541 lev0= (DataObj) lexEnv->level; }
542
543/*
544!! NO GOOD with stackChaining
545# define stackPush(type, data) {fintSet((type),sp,(data)); sp++;}
546# define stackPop() (sp--, *sp)
547*/
548/* NOTE: Usage for stackPop(): x = stackPop().fiSInt, etc. */
549
550
551# define fintEnvPush(lxEnv, lv, en){ lxEnv = (FiEnv) ((DataObj) memset(stoAlloc(0, sizeof(struct
_FiEnv) * (1)), 0, sizeof(struct _FiEnv) * (1))); lxEnv->
level = (Ptr) lv; lxEnv->next = (en); lxEnv->info = (FiWord
) ((void*)0); }
{ \
552 lxEnv = (FiEnv) fintAlloc(struct _FiEnv, 1)((DataObj) memset(stoAlloc(0, sizeof(struct _FiEnv) * (1)), 0
, sizeof(struct _FiEnv) * (1)))
; \
553 lxEnv->level = (Ptr) lv; lxEnv->next = (en); \
554 lxEnv->info = (FiWord) NULL((void*)0); }
555
556# define fintClosMake(cl,en,pr){ (cl) = (FiClos) ((DataObj) memset(stoAlloc(0, sizeof(struct
_FiClos) * (1)), 0, sizeof(struct _FiClos) * (1))); (cl)->
prog = (FiProg) (pr).fiProgPos; (cl)->env = (en).fiEnv;}
{ \
557 (cl) = (FiClos) fintAlloc(struct _FiClos,1)((DataObj) memset(stoAlloc(0, sizeof(struct _FiClos) * (1)), 0
, sizeof(struct _FiClos) * (1)))
; \
558 (cl)->prog = (FiProg) (pr).fiProgPos; \
559 (cl)->env = (en).fiEnv;}
560
561# define fintGenerMake(gg,en,pr, ssz){ (gg) = (FiGener) ((DataObj) memset(stoAlloc(0, sizeof(struct
_FiGener) * (1)), 0, sizeof(struct _FiGener) * (1))); (gg)->
prog = (FiProg) (pr).fiProgPos; (gg)->stateSize = ssz; (gg
)->env = (en).fiEnv;}
{ \
562 (gg) = (FiGener) fintAlloc(struct _FiGener,1)((DataObj) memset(stoAlloc(0, sizeof(struct _FiGener) * (1)),
0, sizeof(struct _FiGener) * (1)))
; \
563 (gg)->prog = (FiProg) (pr).fiProgPos; \
564 (gg)->stateSize = ssz; \
565 (gg)->env = (en).fiEnv;}
566
567/*
568 * This value is the number of stack frames printed before executing an
569 * halt instr.
570 */
571#define FINT_BACKTRACE_CUTOFF23 23
572
573/**************************************************************************
574 *
575 * Heap management
576 *
577 *************************************************************************/
578# define fintAlloc(type,n)((DataObj) memset(stoAlloc(0, sizeof(type) * (n)), 0, sizeof(
type) * (n)))
((DataObj) memset(stoAlloc(OB_Other0, sizeof(type) * (n)), 0, sizeof(type) * (n)))
579# define fintFree(p)stoFree((p)) stoFree((p))
580# define fintFree0(p)if (p) stoFree(p) if (p) stoFree(p)
581
582
583/**************************************************************************
584 *************************************************************************/
585
586
587#define POS_LEX_FMT4 4
588
589#define DECL_INIT_SIZE15 15
590
591#define fiTrue((FiBool) 1) ((FiBool) 1)
592#define fiFalse((FiBool) 0) ((FiBool) 0)
593
594/* This macro is used to cast FOAM_Bool to FOAM_Word. This is usefull because
595 * in a foam program sometime an expr of type Word/SInt is used as an expr. of
596 * type Bool.
597 */
598#define fintForceBoolToWord(expr, t)if (t == FOAM_Bool) expr.fiWord = (FiWord) expr.fiBool if (t == FOAM_Bool) expr.fiWord = (FiWord) expr.fiBool
599
600/******************************************************************************
601 *
602 * :: Jmp Buffer (Halt Recovery)
603 *
604 *****************************************************************************/
605
606static JmpBuf fintJmpBuf;
607
608/*
609 * Whenever a block of statements are protected by
610 * fiBlock() or fiVoidBlock(), the fintCurrentFormat
611 * global MUST be saved and restored. It must also
612 * be saved when using fiProtect() but that never
613 * seems to be used in the interpreter.
614 */
615#define fintBlock(ok, val, exn, expr){ int __fmt = fintCurrentFormat; { FiStateBox frobnitz; FiState
state = &frobnitz;; if (!(fiSaveState0(state), _setjmp (
state->machineState))) { val = expr; fiRestoreState0(state
); ok = 1; } else { fiRestoreState0(state); if (state->target
!= (FiWord) state) { fiUnwind(state->target, state->value
); } exn = state->value; ok = 0; } }; fintCurrentFormat = __fmt
; }
\
616{ \
617 int __fmt = fintCurrentFormat; \
618 fiBlock(ok, val, exn, expr){ FiStateBox frobnitz; FiState state = &frobnitz;; if (!(
fiSaveState0(state), _setjmp (state->machineState))) { val
= expr; fiRestoreState0(state); ok = 1; } else { fiRestoreState0
(state); if (state->target != (FiWord) state) { fiUnwind(state
->target, state->value); } exn = state->value; ok = 0
; } }
; \
619 fintCurrentFormat = __fmt; \
620}
621
622#define fintVoidBlock(ok, exn, expr){ int __fmt = fintCurrentFormat; { FiStateBox frobnitz; FiState
state = &frobnitz;; if (!(fiSaveState0(state), _setjmp (
state->machineState))) { expr; fiRestoreState0(state); ok =
1; } else { fiRestoreState0(state); if (state->target != (
FiWord) state) { fiUnwind(state->target, state->value);
} exn = state->value; ok = 0; } }; fintCurrentFormat = __fmt
; }
\
623{ \
624 int __fmt = fintCurrentFormat; \
625 fiVoidBlock(ok, exn, expr){ FiStateBox frobnitz; FiState state = &frobnitz;; if (!(
fiSaveState0(state), _setjmp (state->machineState))) { expr
; fiRestoreState0(state); ok = 1; } else { fiRestoreState0(state
); if (state->target != (FiWord) state) { fiUnwind(state->
target, state->value); } exn = state->value; ok = 0; } }
; \
626 fintCurrentFormat = __fmt; \
627}
628
629
630/******************************************************************************
631 *
632 * :: Debug Stuff
633 *
634 *****************************************************************************/
635#ifdef NDEBUG
636
637#undef assert
638#define assert(x)do { if (!(x)) _do_assert(("x"),"fint.c",638); } while (0)
639#define softAssert(x)do { if (fintSoftAssertIsOn && !(x)) fintSoftAssert("x"
, "fint.c", 639); } while (0)
640#define hardAssert(x)do { if (!(x)) fintHardAssert("x", "fint.c", 640); } while (0
)
641
642#define fintTypedEval(pExpr,t){ dataType type = fintEval(pExpr); do { if (!(type == t || type
== FOAM_Word || type == FOAM_Nil)) _do_assert(("type == t || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",642); } while (0); }
fintEval(pExpr)
643#define fintGetTypedReference(pExpr,t){ dataType type = fintGetReference(pExpr); do { if (!(type ==
t)) _do_assert(("type == t"),"fint.c",643); } while (0); }
fintGetReference(pExpr)
644#else /* !NDEBUG */
645
646localstatic Bool fintSoftAssertIsOn = false((int) 0);
647localstatic long instrBreak = -1;
648
649#define softAssert(x)do { if (fintSoftAssertIsOn && !(x)) fintSoftAssert("x"
, "fint.c", 649); } while (0)
\
650 do { \
651 if (fintSoftAssertIsOn && !(x)) \
652 fintSoftAssert(#x, __FILE__"fint.c", __LINE__652); \
653 } while (0)
654#define hardAssert(x)do { if (!(x)) fintHardAssert("x", "fint.c", 654); } while (0
)
\
655 do { \
656 if (!(x)) \
657 fintHardAssert(#x, __FILE__"fint.c", __LINE__657); \
658 } while (0)
659
660#define fintTypedEval(pExpr,t){ dataType type = fintEval(pExpr); do { if (!(type == t || type
== FOAM_Word || type == FOAM_Nil)) _do_assert(("type == t || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",660); } while (0); }
{ \
661 dataType type = fintEval(pExpr); \
662 assert(type == t || type == FOAM_Word || type == FOAM_Nil)do { if (!(type == t || type == FOAM_Word || type == FOAM_Nil
)) _do_assert(("type == t || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",662); } while (0)
; \
663}
664
665#define fintGetTypedReference(pExpr,t){ dataType type = fintGetReference(pExpr); do { if (!(type ==
t)) _do_assert(("type == t"),"fint.c",665); } while (0); }
{ \
666 dataType type = fintGetReference(pExpr); \
667 assert(type == t)do { if (!(type == t)) _do_assert(("type == t"),"fint.c",667)
; } while (0)
; \
668}
669#endif /* NDEBUG */
670
671#define fintDEBUGif (!fintDebug) { } else afprintf DEBUG_IF(fint)if (!fintDebug) { } else afprintf
672#define fintLinkDEBUGif (!fintLinkDebug) { } else afprintf DEBUG_IF(fintLink)if (!fintLinkDebug) { } else afprintf
673#define fintStoDEBUGif (!fintStoDebug) { } else afprintf DEBUG_IF(fintSto)if (!fintStoDebug) { } else afprintf
674
675/**************************************************************************
676 * Foreign function data structures
677 *************************************************************************/
678
679
680enum fintForeignTag {
681 FINT_FOREIGN_fputs,
682 FINT_FOREIGN_fputss,
683 FINT_FOREIGN_fgetss,
684 FINT_FOREIGN_isatty,
685 FINT_FOREIGN_fileno,
686 FINT_FOREIGN_stdinFile,
687 FINT_FOREIGN_stdoutFile,
688 FINT_FOREIGN_stderrFile,
689 FINT_FOREIGN_formatSInt,
690 FINT_FOREIGN_formatBInt,
691 FINT_FOREIGN_formatSFloat,
692 FINT_FOREIGN_formatDFloat,
693 FINT_FOREIGN_fiSetDebugVar,
694 FINT_FOREIGN_fiGetDebugVar,
695 FINT_FOREIGN_fiSetDebugger,
696 FINT_FOREIGN_fiGetDebugger,
697 FINT_FOREIGN_fputc,
698 FINT_FOREIGN_sqrt,
699 FINT_FOREIGN_pow,
700 FINT_FOREIGN_log,
701 FINT_FOREIGN_log10,
702 FINT_FOREIGN_exp,
703 FINT_FOREIGN_sin,
704 FINT_FOREIGN_cos,
705 FINT_FOREIGN_tan,
706 FINT_FOREIGN_sinh,
707 FINT_FOREIGN_cosh,
708 FINT_FOREIGN_tanh,
709 FINT_FOREIGN_asin,
710 FINT_FOREIGN_acos,
711 FINT_FOREIGN_atan,
712 FINT_FOREIGN_atan2,
713 FINT_FOREIGN_fopen,
714 FINT_FOREIGN_fclose,
715 FINT_FOREIGN_fflush,
716 FINT_FOREIGN_fgetc,
717 FINT_FOREIGN_lfputc,
718 FINT_FOREIGN_fseek,
719 FINT_FOREIGN_fseekset,
720 FINT_FOREIGN_ftell,
721 FINT_FOREIGN_mainArgc,
722 FINT_FOREIGN_mainArgv,
723 FINT_FOREIGN_strLength,
724 FINT_FOREIGN_fiStrHash,
725 /* recent stuff 1.1.9d */
726 FINT_FOREIGN_fiDoubleHexPrintToString,
727 FINT_FOREIGN_fiInitialiseFpu,
728 FINT_FOREIGN_fiIeeeGetRoundingMode,
729 FINT_FOREIGN_fiIeeeSetRoundingMode,
730 FINT_FOREIGN_fiIeeeGetEnabledExceptions,
731 FINT_FOREIGN_fiIeeeSetEnabledExceptions,
732 FINT_FOREIGN_fiIeeeGetExceptionStatus,
733 FINT_FOREIGN_fiIeeeSetExceptionStatus,
734
735 FINT_FOREIGN_fiDFloMantissa,
736 FINT_FOREIGN_fiDFloExponent,
737 FINT_FOREIGN_fiSFloMantissa,
738 FINT_FOREIGN_fiSFloExponent,
739
740 /* Operating System Interface */
741 FINT_FOREIGN_osRun,
742 FINT_FOREIGN_osRunConcurrent,
743 FINT_FOREIGN_osRunQuoteArg,
744 FINT_FOREIGN_osCpuTime,
745 FINT_FOREIGN_osDate,
746 FINT_FOREIGN_osGetEnv,
747 FINT_FOREIGN_osPutEnv,
748 FINT_FOREIGN_osPutEnvIsKept,
749 FINT_FOREIGN_osIoRdMode,
750 FINT_FOREIGN_osIoWrMode,
751 FINT_FOREIGN_osIoApMode,
752 FINT_FOREIGN_osIoRbMode,
753 FINT_FOREIGN_osIoWbMode,
754 FINT_FOREIGN_osIoAbMode,
755 FINT_FOREIGN_osIoRubMode,
756 FINT_FOREIGN_osIoWubMode,
757 FINT_FOREIGN_osIoAubMode,
758 FINT_FOREIGN_osObjectFileType,
759 FINT_FOREIGN_osExecFileType,
760 FINT_FOREIGN_osCurDirName,
761 FINT_FOREIGN_osTmpDirName,
762 FINT_FOREIGN_osFnameDirEqual,
763 FINT_FOREIGN_osSubdir,
764 FINT_FOREIGN_osSubdirLength,
765 FINT_FOREIGN_osFnameNParts,
766 FINT_FOREIGN_osFnameParse,
767 FINT_FOREIGN_osFnameParseSize,
768 FINT_FOREIGN_osFnameUnparse,
769 FINT_FOREIGN_osFnameUnparseSize,
770 FINT_FOREIGN_osFnameTempSeed,
771 FINT_FOREIGN_osFnameTempDir,
772 FINT_FOREIGN_osIsInteractive,
773 FINT_FOREIGN_osFileRemove,
774 FINT_FOREIGN_osFileRename,
775 FINT_FOREIGN_osFileIsThere,
776 FINT_FOREIGN_osFileHash,
777 FINT_FOREIGN_osFileSize,
778 FINT_FOREIGN_osDirIsThere,
779 FINT_FOREIGN_osDirSwap,
780 FINT_FOREIGN_osIncludePath,
781 FINT_FOREIGN_osLibraryPath,
782 FINT_FOREIGN_osExecutePath,
783 FINT_FOREIGN_osPathLength,
784 FINT_FOREIGN_osPathParse,
785
786 FINT_FOREIGN_gcTimer,
787 FINT_FOREIGN_fiRaiseException,
788 FINT_FOREIGN_osAllocShow,
789 FINT_FOREIGN_osAlloc,
790 FINT_FOREIGN_osFree,
791 FINT_FOREIGN_osMemMap,
792 FINT_FOREIGN_randomSeed,
793
794 FINT_FOREIGN_fiNewExportTable,
795 FINT_FOREIGN_fiAddToExportTable,
796 FINT_FOREIGN_fiFreeExportTable,
797
798 FINT_FOREIGN_END
799};
800
801typedef struct {
802 String string;
803 enum fintForeignTag funct;
804 Bool isConst;
805} fintForeign;
806
807#define DECL_FOREIGN(x){ "x", FINT_FOREIGN_x, ((int) 0) } { #x, FINT_FOREIGN_##x, false((int) 0) }
808#define DECL_FOREIGN_CONST(x){ "x", FINT_FOREIGN_x, 1 } { #x, FINT_FOREIGN_##x, true1 }
809
810
811DECLARE_LIST(FintUnit)typedef struct FintUnitListCons { FintUnit first; struct FintUnitListCons
*rest; } *FintUnitList; struct FintUnit_listOpsStruct { FintUnitList
(*Cons) (FintUnit, FintUnitList); FintUnitList (*Singleton) (
FintUnit); FintUnitList (*List) (int n, ...); FintUnitList (*
Listv) (va_list argp); FintUnitList (*ListNull) (FintUnit, ...
); Bool (*Equal) (FintUnitList, FintUnitList, Bool (*f) (FintUnit
, FintUnit)); FintUnit (*Find) (FintUnitList, FintUnit, Bool(
*eq)(FintUnit,FintUnit) , int *); FintUnit (*Match) (FintUnitList
, void *, Bool(*match)(FintUnit, void *), int *); FintUnitList
(*MatchAll) (FintUnitList, void *, Bool(*match)(FintUnit, void
*)); FintUnitList (*FreeCons) (FintUnitList); void (*Free) (
FintUnitList); FintUnitList (*FreeTo) (FintUnitList, FintUnitList
); void (*FreeDeeply) (FintUnitList, void (*f)(FintUnit)); FintUnitList
(*FreeDeeplyTo) (FintUnitList, FintUnitList, void (*f) (FintUnit
) ); FintUnitList (*FreeIfSat) (FintUnitList, void (*f)(FintUnit
), Bool (*s)(FintUnit)); FintUnit (*Elt) (FintUnitList, Length
); FintUnitList (*Drop) (FintUnitList, Length); FintUnitList (
*LastCons) (FintUnitList); Length (*_Length) (FintUnitList); Bool
(*IsLength) (FintUnitList, Length); Bool (*IsShorter) (FintUnitList
, Length); Bool (*IsLonger) (FintUnitList, Length); FintUnitList
(*Copy) (FintUnitList); FintUnitList (*CopyTo) (FintUnitList
, FintUnitList); FintUnitList (*CopyDeeply) (FintUnitList, FintUnit
(*)(FintUnit)); FintUnitList (*CopyDeeplyTo) (FintUnitList, FintUnitList
, FintUnit (*)(FintUnit)); FintUnitList (*Map) (FintUnit (*f)
(FintUnit), FintUnitList); FintUnitList (*NMap) (FintUnit (*f
)(FintUnit), FintUnitList); FintUnitList (*Reverse) (FintUnitList
); FintUnitList (*NReverse) (FintUnitList); FintUnitList (*Concat
) (FintUnitList, FintUnitList); FintUnitList (*NConcat) (FintUnitList
, FintUnitList); Bool (*Memq) (FintUnitList, FintUnit); Bool (
*Member) (FintUnitList, FintUnit, Bool(*eq)(FintUnit,FintUnit
) ); Bool (*ContainsAllq) (FintUnitList, FintUnitList); Bool (
*ContainsAnyq) (FintUnitList, FintUnitList); Bool (*ContainsAll
) (FintUnitList, FintUnitList, Bool (*eq)(FintUnit, FintUnit)
); Bool (*ContainsAny) (FintUnitList, FintUnitList, Bool (*eq
)(FintUnit, FintUnit)); int (*Posq) (FintUnitList, FintUnit);
int (*Position) (FintUnitList, FintUnit, Bool(*eq)(FintUnit,
FintUnit) ); FintUnitList (*NRemove) (FintUnitList, FintUnit,
Bool(*eq)(FintUnit,FintUnit) ); void (*FillVector) (FintUnit
*, FintUnitList); int (*Print) (FILE *, FintUnitList, int (*
pr)(FILE *, FintUnit) ); int (*GPrint) (FILE *, FintUnitList,
int (*pr)(FILE *, FintUnit), char *l,char *m,char *r); int (
*Format) (OStream, CString, FintUnitList); }; extern struct FintUnit_listOpsStruct
const *FintUnit_listPointer
;
812CREATE_LIST(FintUnit)struct FintUnit_listOpsStruct const *FintUnit_listPointer = (
struct FintUnit_listOpsStruct const *) &ptrlistOps
;
813
814extern TForm typeInferAs(Stab, AbSyn, TForm);
815
816/**************************************************************************
817 *
818 * Globals
819 *
820 *************************************************************************/
821
822localstatic FintUnitList fintUnitList;
823localstatic Bool fintInitialized = false((int) 0);
824localstatic unsigned unitId; /* id number, unique for each unit. */
825localstatic FintUnit unit; /* current unit */
826localstatic FintUnit mainUnit;
827
828struct mainInfo {
829 int globsSize;
830 int constsSize;
831 int fluidsSize;
832 int lexLevelsSize;
833
834} mainInfo;
835
836localstatic Buffer evalBuf;
837
838localstatic UByte * tape; /* interpreted string */
839localstatic FiProgPos ip;
840localstatic DataObj headStack; /* first stack allocated */
841localstatic DataObj stack; /* current stack */
842localstatic DataObj sp; /* First free cell on the top of the stack. */
843localstatic DataObj bp; /* Bottom of the current frame; refers to a
844 * dataObj containing the old bp.
845 */
846localstatic FiGenIter currGenIter; /* Current coroutine */
847localstatic DataObj locValues; /* local values in the current stack frame */
848localstatic DataObj fluidValues; /* fluid values in the current stack frame */
849localstatic FiEnv lexEnv; /* current lexical environment */
850localstatic DataObj lev0; /* lexEnv->level, used to speed up lex(0,n) */
851localstatic ProgInfo prog; /* progInfo for the current program */
852localstatic FiProgPos * labels;
853localstatic DataObj stackBase;
854localstatic int labelFmt;
855
856fintForeign fintForeignTable [] = {
857 DECL_FOREIGN(fputs){ "fputs", FINT_FOREIGN_fputs, ((int) 0) },
858 DECL_FOREIGN(fputss){ "fputss", FINT_FOREIGN_fputss, ((int) 0) },
859 DECL_FOREIGN(fgetss){ "fgetss", FINT_FOREIGN_fgetss, ((int) 0) },
860 DECL_FOREIGN(isatty){ "isatty", FINT_FOREIGN_isatty, ((int) 0) },
861 DECL_FOREIGN(fileno){ "fileno", FINT_FOREIGN_fileno, ((int) 0) },
862 DECL_FOREIGN(stdinFile){ "stdinFile", FINT_FOREIGN_stdinFile, ((int) 0) },
863 DECL_FOREIGN(stdoutFile){ "stdoutFile", FINT_FOREIGN_stdoutFile, ((int) 0) },
864 DECL_FOREIGN(stderrFile){ "stderrFile", FINT_FOREIGN_stderrFile, ((int) 0) },
865 DECL_FOREIGN(formatSInt){ "formatSInt", FINT_FOREIGN_formatSInt, ((int) 0) },
866 DECL_FOREIGN(formatBInt){ "formatBInt", FINT_FOREIGN_formatBInt, ((int) 0) },
867 DECL_FOREIGN(formatSFloat){ "formatSFloat", FINT_FOREIGN_formatSFloat, ((int) 0) },
868 DECL_FOREIGN(formatDFloat){ "formatDFloat", FINT_FOREIGN_formatDFloat, ((int) 0) },
869 DECL_FOREIGN(fiGetDebugVar){ "fiGetDebugVar", FINT_FOREIGN_fiGetDebugVar, ((int) 0) },
870 DECL_FOREIGN(fiSetDebugVar){ "fiSetDebugVar", FINT_FOREIGN_fiSetDebugVar, ((int) 0) },
871 DECL_FOREIGN(fiGetDebugger){ "fiGetDebugger", FINT_FOREIGN_fiGetDebugger, ((int) 0) },
872 DECL_FOREIGN(fiSetDebugger){ "fiSetDebugger", FINT_FOREIGN_fiSetDebugger, ((int) 0) },
873
874 DECL_FOREIGN(fputc){ "fputc", FINT_FOREIGN_fputc, ((int) 0) },
875 DECL_FOREIGN(sqrt){ "sqrt", FINT_FOREIGN_sqrt, ((int) 0) },
876 DECL_FOREIGN(pow){ "pow", FINT_FOREIGN_pow, ((int) 0) },
877 DECL_FOREIGN(log){ "log", FINT_FOREIGN_log, ((int) 0) },
878 DECL_FOREIGN(log10){ "log10", FINT_FOREIGN_log10, ((int) 0) },
879 DECL_FOREIGN(exp){ "exp", FINT_FOREIGN_exp, ((int) 0) },
880 DECL_FOREIGN(sin){ "sin", FINT_FOREIGN_sin, ((int) 0) },
881 DECL_FOREIGN(cos){ "cos", FINT_FOREIGN_cos, ((int) 0) },
882 DECL_FOREIGN(tan){ "tan", FINT_FOREIGN_tan, ((int) 0) },
883 DECL_FOREIGN(sinh){ "sinh", FINT_FOREIGN_sinh, ((int) 0) },
884 DECL_FOREIGN(cosh){ "cosh", FINT_FOREIGN_cosh, ((int) 0) },
885 DECL_FOREIGN(tanh){ "tanh", FINT_FOREIGN_tanh, ((int) 0) },
886 DECL_FOREIGN(asin){ "asin", FINT_FOREIGN_asin, ((int) 0) },
887 DECL_FOREIGN(acos){ "acos", FINT_FOREIGN_acos, ((int) 0) },
888 DECL_FOREIGN(atan){ "atan", FINT_FOREIGN_atan, ((int) 0) },
889 DECL_FOREIGN(atan2){ "atan2", FINT_FOREIGN_atan2, ((int) 0) },
890 DECL_FOREIGN(fopen){ "fopen", FINT_FOREIGN_fopen, ((int) 0) },
891 DECL_FOREIGN(fclose){ "fclose", FINT_FOREIGN_fclose, ((int) 0) },
892 DECL_FOREIGN(fflush){ "fflush", FINT_FOREIGN_fflush, ((int) 0) },
893 DECL_FOREIGN(fgetc){ "fgetc", FINT_FOREIGN_fgetc, ((int) 0) },
894 DECL_FOREIGN(lfputc){ "lfputc", FINT_FOREIGN_lfputc, ((int) 0) },
895 DECL_FOREIGN(fseek){ "fseek", FINT_FOREIGN_fseek, ((int) 0) },
896 DECL_FOREIGN(fseekset){ "fseekset", FINT_FOREIGN_fseekset, ((int) 0) },
897 DECL_FOREIGN(ftell){ "ftell", FINT_FOREIGN_ftell, ((int) 0) },
898 DECL_FOREIGN(mainArgc){ "mainArgc", FINT_FOREIGN_mainArgc, ((int) 0) },
899 DECL_FOREIGN(mainArgv){ "mainArgv", FINT_FOREIGN_mainArgv, ((int) 0) },
900 DECL_FOREIGN(strLength){ "strLength", FINT_FOREIGN_strLength, ((int) 0) },
901 DECL_FOREIGN(fiStrHash){ "fiStrHash", FINT_FOREIGN_fiStrHash, ((int) 0) },
902 /* recent stuff 1.1.9d */
903 DECL_FOREIGN(fiDoubleHexPrintToString){ "fiDoubleHexPrintToString", FINT_FOREIGN_fiDoubleHexPrintToString
, ((int) 0) }
,
904 DECL_FOREIGN(fiInitialiseFpu){ "fiInitialiseFpu", FINT_FOREIGN_fiInitialiseFpu, ((int) 0) },
905 DECL_FOREIGN(fiIeeeGetRoundingMode){ "fiIeeeGetRoundingMode", FINT_FOREIGN_fiIeeeGetRoundingMode
, ((int) 0) }
,
906 DECL_FOREIGN(fiIeeeSetRoundingMode){ "fiIeeeSetRoundingMode", FINT_FOREIGN_fiIeeeSetRoundingMode
, ((int) 0) }
,
907 DECL_FOREIGN(fiIeeeGetEnabledExceptions){ "fiIeeeGetEnabledExceptions", FINT_FOREIGN_fiIeeeGetEnabledExceptions
, ((int) 0) }
,
908 DECL_FOREIGN(fiIeeeSetEnabledExceptions){ "fiIeeeSetEnabledExceptions", FINT_FOREIGN_fiIeeeSetEnabledExceptions
, ((int) 0) }
,
909 DECL_FOREIGN(fiIeeeGetExceptionStatus){ "fiIeeeGetExceptionStatus", FINT_FOREIGN_fiIeeeGetExceptionStatus
, ((int) 0) }
,
910 DECL_FOREIGN(fiIeeeSetExceptionStatus){ "fiIeeeSetExceptionStatus", FINT_FOREIGN_fiIeeeSetExceptionStatus
, ((int) 0) }
,
911
912 DECL_FOREIGN(fiDFloMantissa){ "fiDFloMantissa", FINT_FOREIGN_fiDFloMantissa, ((int) 0) },
913 DECL_FOREIGN(fiDFloExponent){ "fiDFloExponent", FINT_FOREIGN_fiDFloExponent, ((int) 0) },
914 DECL_FOREIGN(fiSFloMantissa){ "fiSFloMantissa", FINT_FOREIGN_fiSFloMantissa, ((int) 0) },
915 DECL_FOREIGN(fiSFloExponent){ "fiSFloExponent", FINT_FOREIGN_fiSFloExponent, ((int) 0) },
916 /* Operating System Interface */
917 DECL_FOREIGN(osRun){ "osRun", FINT_FOREIGN_osRun, ((int) 0) },
918 DECL_FOREIGN(osRunConcurrent){ "osRunConcurrent", FINT_FOREIGN_osRunConcurrent, ((int) 0) },
919 DECL_FOREIGN(osRunQuoteArg){ "osRunQuoteArg", FINT_FOREIGN_osRunQuoteArg, ((int) 0) },
920 DECL_FOREIGN(osCpuTime){ "osCpuTime", FINT_FOREIGN_osCpuTime, ((int) 0) },
921 DECL_FOREIGN(osDate){ "osDate", FINT_FOREIGN_osDate, ((int) 0) },
922 DECL_FOREIGN(osGetEnv){ "osGetEnv", FINT_FOREIGN_osGetEnv, ((int) 0) },
923 DECL_FOREIGN(osPutEnv){ "osPutEnv", FINT_FOREIGN_osPutEnv, ((int) 0) },
924 DECL_FOREIGN(osPutEnvIsKept){ "osPutEnvIsKept", FINT_FOREIGN_osPutEnvIsKept, ((int) 0) },
925 DECL_FOREIGN_CONST(osIoRdMode){ "osIoRdMode", FINT_FOREIGN_osIoRdMode, 1 },
926 DECL_FOREIGN_CONST(osIoWrMode){ "osIoWrMode", FINT_FOREIGN_osIoWrMode, 1 },
927 DECL_FOREIGN_CONST(osIoApMode){ "osIoApMode", FINT_FOREIGN_osIoApMode, 1 },
928 DECL_FOREIGN_CONST(osIoRbMode){ "osIoRbMode", FINT_FOREIGN_osIoRbMode, 1 },
929 DECL_FOREIGN_CONST(osIoWbMode){ "osIoWbMode", FINT_FOREIGN_osIoWbMode, 1 },
930 DECL_FOREIGN_CONST(osIoAbMode){ "osIoAbMode", FINT_FOREIGN_osIoAbMode, 1 },
931 DECL_FOREIGN_CONST(osIoRubMode){ "osIoRubMode", FINT_FOREIGN_osIoRubMode, 1 },
932 DECL_FOREIGN_CONST(osIoWubMode){ "osIoWubMode", FINT_FOREIGN_osIoWubMode, 1 },
933 DECL_FOREIGN_CONST(osIoAubMode){ "osIoAubMode", FINT_FOREIGN_osIoAubMode, 1 },
934 DECL_FOREIGN_CONST(osObjectFileType){ "osObjectFileType", FINT_FOREIGN_osObjectFileType, 1 },
935 DECL_FOREIGN_CONST(osExecFileType){ "osExecFileType", FINT_FOREIGN_osExecFileType, 1 },
936 DECL_FOREIGN(osCurDirName){ "osCurDirName", FINT_FOREIGN_osCurDirName, ((int) 0) },
937 DECL_FOREIGN(osTmpDirName){ "osTmpDirName", FINT_FOREIGN_osTmpDirName, ((int) 0) },
938 DECL_FOREIGN(osFnameDirEqual){ "osFnameDirEqual", FINT_FOREIGN_osFnameDirEqual, ((int) 0) },
939 DECL_FOREIGN(osSubdir){ "osSubdir", FINT_FOREIGN_osSubdir, ((int) 0) },
940 DECL_FOREIGN(osSubdirLength){ "osSubdirLength", FINT_FOREIGN_osSubdirLength, ((int) 0) },
941 DECL_FOREIGN_CONST(osFnameNParts){ "osFnameNParts", FINT_FOREIGN_osFnameNParts, 1 },
942 DECL_FOREIGN(osFnameParse){ "osFnameParse", FINT_FOREIGN_osFnameParse, ((int) 0) },
943 DECL_FOREIGN(osFnameParseSize){ "osFnameParseSize", FINT_FOREIGN_osFnameParseSize, ((int) 0
) }
,
944 DECL_FOREIGN(osFnameUnparse){ "osFnameUnparse", FINT_FOREIGN_osFnameUnparse, ((int) 0) },
945 DECL_FOREIGN(osFnameUnparseSize){ "osFnameUnparseSize", FINT_FOREIGN_osFnameUnparseSize, ((int
) 0) }
,
946 DECL_FOREIGN(osFnameTempSeed){ "osFnameTempSeed", FINT_FOREIGN_osFnameTempSeed, ((int) 0) },
947 DECL_FOREIGN(osFnameTempDir){ "osFnameTempDir", FINT_FOREIGN_osFnameTempDir, ((int) 0) },
948 DECL_FOREIGN(osIsInteractive){ "osIsInteractive", FINT_FOREIGN_osIsInteractive, ((int) 0) },
949 DECL_FOREIGN(osFileRemove){ "osFileRemove", FINT_FOREIGN_osFileRemove, ((int) 0) },
950 DECL_FOREIGN(osFileRename){ "osFileRename", FINT_FOREIGN_osFileRename, ((int) 0) },
951 DECL_FOREIGN(osFileIsThere){ "osFileIsThere", FINT_FOREIGN_osFileIsThere, ((int) 0) },
952 DECL_FOREIGN(osFileHash){ "osFileHash", FINT_FOREIGN_osFileHash, ((int) 0) },
953 DECL_FOREIGN(osFileSize){ "osFileSize", FINT_FOREIGN_osFileSize, ((int) 0) },
954 DECL_FOREIGN(osDirIsThere){ "osDirIsThere", FINT_FOREIGN_osDirIsThere, ((int) 0) },
955 DECL_FOREIGN(osDirSwap){ "osDirSwap", FINT_FOREIGN_osDirSwap, ((int) 0) },
956 DECL_FOREIGN(osIncludePath){ "osIncludePath", FINT_FOREIGN_osIncludePath, ((int) 0) },
957 DECL_FOREIGN(osLibraryPath){ "osLibraryPath", FINT_FOREIGN_osLibraryPath, ((int) 0) },
958 DECL_FOREIGN(osExecutePath){ "osExecutePath", FINT_FOREIGN_osExecutePath, ((int) 0) },
959 DECL_FOREIGN(osPathLength){ "osPathLength", FINT_FOREIGN_osPathLength, ((int) 0) },
960 DECL_FOREIGN(osPathParse){ "osPathParse", FINT_FOREIGN_osPathParse, ((int) 0) },
961 /* Gc timer */
962 DECL_FOREIGN(gcTimer){ "gcTimer", FINT_FOREIGN_gcTimer, ((int) 0) },
963 DECL_FOREIGN(fiRaiseException){ "fiRaiseException", FINT_FOREIGN_fiRaiseException, ((int) 0
) }
,
964 DECL_FOREIGN(osAllocShow){ "osAllocShow", FINT_FOREIGN_osAllocShow, ((int) 0) },
965 DECL_FOREIGN(osAlloc){ "osAlloc", FINT_FOREIGN_osAlloc, ((int) 0) },
966 DECL_FOREIGN(osFree){ "osFree", FINT_FOREIGN_osFree, ((int) 0) },
967 DECL_FOREIGN(osMemMap){ "osMemMap", FINT_FOREIGN_osMemMap, ((int) 0) },
968 DECL_FOREIGN(randomSeed){ "randomSeed", FINT_FOREIGN_randomSeed, ((int) 0) },
969
970 /* Runtime hashcode checks */
971 DECL_FOREIGN(fiNewExportTable){ "fiNewExportTable", FINT_FOREIGN_fiNewExportTable, ((int) 0
) }
,
972 DECL_FOREIGN(fiAddToExportTable){ "fiAddToExportTable", FINT_FOREIGN_fiAddToExportTable, ((int
) 0) }
,
973 DECL_FOREIGN(fiFreeExportTable){ "fiFreeExportTable", FINT_FOREIGN_fiFreeExportTable, ((int)
0) }
,
974
975 {NULL((void*)0), FINT_FOREIGN_END} /* TERMINATE TABLE */
976};
977
978/**************************************************************************
979 * Debugging globals
980 *************************************************************************/
981
982Bool fintDebug = false((int) 0);
983Bool fintLinkDebug = false((int) 0);
984Bool fintStoDebug = false((int) 0);
985Bool fintExceptDebug = false((int) 0);
986
987localstatic long instrCounter = 0;
988
989/**************************************************************************
990 * Globals shared with Aldor
991 *************************************************************************/
992
993Bool fintVerbose = true1; /* Valid only with interactive Aldor */
994Bool fintHistory = false((int) 0); /* Valid only with interactive Aldor */
995
996UShort intStepNo = 0; /* current step in the interpreter */
997
998/**************************************************************************
999 *
1000 *************************************************************************/
1001
1002Bool fintConfirm = true1;
1003Bool fintTimings = true1; /* Display timings in loop mode? */
1004long fintMsgLimit = ABPP_UNCLIPPED(200000L); /* Default no msg limit */
1005long fintExntraceMode = 0; /* Default: no trace */
1006
1007/**************************************************************************
1008 *
1009 * Local functions prototype
1010 *
1011 *************************************************************************/
1012
1013localstatic void loadUnitFrLib (Lib);
1014localstatic Bool loadOtherUnits (void);
1015localstatic void unloadOtherUnits (void);
1016localstatic Bool loadMainUnit (Foam);
1017localstatic void loadUnit (String, Buffer);
1018
1019localstatic void readDefs (FintUnit);
1020localstatic void readDef (FintUnit);
1021
1022localstatic void unitFree (FintUnit);
1023localstatic Fmt fmtAlloc (int);
1024localstatic void fmtFree (Fmt);
1025localstatic void fmtGlobalsFree (FintUnit);
1026localstatic void fmtConstantsFree (FintUnit);
1027localstatic void fmtFluidsFree (FintUnit);
1028localstatic void lexLevelsFree (FintUnit);
1029localstatic void fintLoadLexLevels (FintUnit, int);
1030localstatic ShDataObj shDataObjAdd (AInt, String, int, int, FintUnit);
1031localstatic ShDataObj shDataObjFind (AInt, String, int);
1032localstatic void shDataObjFree (ShDataObj);
1033localstatic void stackChain (int);
1034
1035
1036localstatic dataType fintStmt (DataObj);
1037localstatic dataType fintEval (DataObj);
1038localstatic dataType fintGetReference (Ref);
1039localstatic void fintSetMFmt (DataObj, DataObj);
1040
1041localstatic int fintReadFmt (Fmt *);
1042localstatic void fintLoadGlobalsFmt (FintUnit);
1043localstatic void fintLoadConstantsFmt (FintUnit);
1044localstatic void fintLoadFluidsFmt (FintUnit);
1045localstatic void fintLoadLexLevels (FintUnit, int);
1046
1047localstatic void skipProg (FiProgPos *, int *);
1048localstatic SFloat fintRdSFloat (void);
1049localstatic DFloat fintRdDFloat (void);
1050localstatic String fintRdChars (int cc);
1051localstatic String fintGetn (Length n);
1052localstatic void fintPushFluids (int);
1053
1054extern void fintSoftAssert (char *, char *, int);
1055extern void fintHardAssert (char *, char *, int);
1056
1057localstatic int fintExecMainUnit (void);
1058
1059localstatic void fintGetInitInterpTime (void);
1060localstatic void fintGetEndInterpTime (void);
1061
1062localstatic dataType fintDoCall0 (DataObj clos, DataObj);
1063localstatic dataType fintDoCall1 (DataObj clos, DataObj, DataObj);
1064localstatic dataType fintDoCall (DataObj clos, DataObj, int, ...);
1065localstatic dataType fintDoCallN (DataObj clos, DataObj, int, DataObj *);
1066
1067 void fintWhere(int level);
1068 void fintCheckCallStack(void);
1069localstatic void * fintSaveState(void);
1070localstatic void fintRestoreState(void *);
1071
1072localstatic Bool fintGenerStep(FiGenIter);
1073localstatic DataObj fintGenerLocsAlloc(int sz);
1074localstatic void fintGenerLocsFree(DataObj);
1075
1076/**************************************************************************
1077 * :: fintInit()
1078 * :: fintFini()
1079 *************************************************************************/
1080
1081/* Initializes data structures.
1082 * Must be called before using any other fint function
1083 */
1084void
1085fintInit(void)
1086{
1087 if (!fintInitialized) {
1088 extern void (*fiExceptionHandler)(char *,void *);
1089 fiRegisterStateFns(fintSaveState, fintRestoreState);
1090 fiExceptionHandler = &fintRaiseException;
1091 fiInitialiseFpu();
1092 }
1093 fintInitialized = true1;
1094 fintUnitList = listNil(FintUnit)((FintUnitList) 0);
1095
1096 headStack = fintAlloc(union dataObj, STACK_SIZE + 1)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (3000 +
1)), 0, sizeof(union dataObj) * (3000 + 1)))
;
1097 headStack[STACK_SIZE3000].ptr = 0;
1098
1099 stack = headStack;
1100 bp = headStack;
1101 sp = headStack + 1;
1102 ip = 0;
1103 headStack[0].ptr = (DataObj) NULL((void*)0);
1104
1105 /* create a progInfo so that it can process (Clos (Env 0) ...) when
1106 * reads defs
1107 */
1108 prog = (ProgInfo) fintAlloc(struct progInfo, 1)((DataObj) memset(stoAlloc(0, sizeof(struct progInfo) * (1)),
0, sizeof(struct progInfo) * (1)))
;
1109 progInfoDEnv(prog)((prog)->denv) = (UByte *) fintAlloc(UByte, 1)((DataObj) memset(stoAlloc(0, sizeof(UByte) * (1)), 0, sizeof
(UByte) * (1)))
;
1110 *progInfoDEnv(prog)((prog)->denv) = POS_LEX_FMT4; /* null format */
1111
1112 evalBuf = bufNew();
1113
1114 /* *********** mainUnit *********** */
1115
1116 mainUnit = (FintUnit) fintAlloc(fintUnit,1)((DataObj) memset(stoAlloc(0, sizeof(fintUnit) * (1)), 0, sizeof
(fintUnit) * (1)))
;
1117
1118 fintUnitId(mainUnit)((mainUnit)->unitId) = unitId++;
1119 fintUnitTape(mainUnit)((mainUnit)->tape) = bufData(evalBuf);
1120 fintUnitName(mainUnit)((mainUnit)->name) = "main";
1121 fintUnitBuffer(mainUnit)((mainUnit)->buf) = evalBuf;
1122}
1123
1124/* Frees all the allocated data structures.
1125 * Must be called after the last fint() call
1126 */
1127void
1128fintFini(void)
1129{
1130 FintUnitList ul = fintUnitList;
1131 FintUnit u;
1132
1133 /* fintFree(progInfoDEnv(prog));
1134 fintFree(prog);
1135 */
1136
1137 for (; ul; ul = cdr(ul)((ul)->rest)) {
1138 u = car(ul)((ul)->first);
1139 unitFree(u);
1140 }
1141
1142 bufFree(evalBuf);
1143 unloadOtherUnits();
1144}
1145
1146localstatic void
1147fintChainedStackFree(DataObj st)
1148{
1149 if (!st) return;
1150
1151 fintChainedStackFree(st[STACK_SIZE3000].ptr);
1152 fintFree(st)stoFree((st));
1153}
1154
1155/* Called before running the garbage collector.
1156 * Cleans the stack to improve the effectiveness of the garbage coll.
1157 * Also deletes all the added supplementary stacks
1158 */
1159void
1160fintFreeJunk(void)
1161{
1162 DataObj p = headStack;
1163
1164 while (p < headStack + STACK_SIZE3000) {
1165 p->fiWord = (FiWord) 0;
1166 p = (DataObj) (((FiWord *) p) + 1);
1167 }
1168
1169 fintChainedStackFree(headStack[STACK_SIZE3000].ptr);
1170 headStack[STACK_SIZE3000].ptr = 0; /* unchain added stacks */
1171
1172 return;
1173}
1174
1175/*****************************************************************************
1176 *
1177 * :: Units loading
1178 *
1179 ****************************************************************************/
1180
1181
1182localstatic LibList libUsedList = 0;
1183localstatic LibList libDoneList = 0;
1184
1185/* Check if a the library corresponding to "name" has been already loaded.
1186 * If not, push this library in libUsedList, i.e. the list of libraries that
1187 * must be loaded.
1188 * NOTE that "name" come from globals with protocol `FOAM_Proto_Init'.
1189 * NOTE that a library must be loaded exactly once.
1190 */
1191localstatic void
1192lazyLibGet(String name)
1193{
1194 Lib lib;
1195 char aoFile[80];
1196
1197 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut,"LazyGet of %s...\n", name);
1198
1199 if (name[0] == '-' && name[1] == 0) return;
1200
1201 if (strEqual(name, "runtime")) {
1202 Archive ar = arFrString("libfoam.al");
1203 lib = ar ? symeLibrary(car(arGetLibrarySymes(ar)))((Lib) (SYFI_Library < (8 * sizeof(int)) && !(((((
((arGetLibrarySymes(ar))->first))->kind == SYME_Trigger
? libGetAllSymes((((arGetLibrarySymes(ar))->first))->lib
) : ((void*)0)), (((arGetLibrarySymes(ar))->first)))->hasmask
) & (1 << (SYFI_Library))) ? (symeFieldInfo[SYFI_Library
].def) : (((((((arGetLibrarySymes(ar))->first))->kind ==
SYME_Trigger ? libGetAllSymes((((arGetLibrarySymes(ar))->
first))->lib) : ((void*)0)), (((arGetLibrarySymes(ar))->
first)))->locmask) & (1 << (SYFI_Library))) ? ((
((((((arGetLibrarySymes(ar))->first))->kind == SYME_Trigger
? libGetAllSymes((((arGetLibrarySymes(ar))->first))->lib
) : ((void*)0)), (((arGetLibrarySymes(ar))->first)))->locmask
) & (1 << (SYFI_Library))) ? ((((arGetLibrarySymes(
ar))->first))->fieldv)[symeIndex(((arGetLibrarySymes(ar
))->first),SYFI_Library)] : (symeFieldInfo[SYFI_Library].def
)) : symeGetFieldFn(((arGetLibrarySymes(ar))->first),SYFI_Library
)))
: NULL((void*)0);
1204 }
1205 else {
1206 (void)sprintf(aoFile, "%s.ao", name);
1207 lib = libFrString(aoFile);
1208 }
1209
1210 if (lib == NULL((void*)0))
1211 LongJmp(fintJmpBuf, 1){ fluidUnwind((fintJmpBuf).fluidLevel, 1); longjmp((fintJmpBuf
).buf, 1);; }
;
1212
1213 if (!lib->intLoaded) {
1214 libUsedList = listCons(Lib)(Lib_listPointer->Cons)(lib, libUsedList);
1215 lib->intLoaded = true1;
1216 }
1217}
1218
1219/*****************************************************************************
1220 *
1221 ****************************************************************************/
1222
1223
1224/* Read recursively all the library used */
1225localstatic Bool
1226loadOtherUnits(void)
1227{
1228 Lib lib0;
1229
1230 while (libUsedList) {
1231 lib0 = car(libUsedList)((libUsedList)->first);
1232 libUsedList = listFreeCons(Lib)(Lib_listPointer->FreeCons)(libUsedList);
1233 libDoneList = listCons(Lib)(Lib_listPointer->Cons)(lib0, libDoneList);
1234 loadUnitFrLib(lib0);
1235 }
1236
1237 return false((int) 0);
1238}
1239
1240localstatic void
1241unloadOtherUnits(void)
1242{
1243 Lib lib0;
1244
1245 while (libDoneList) {
1246 lib0 = car(libDoneList)((libDoneList)->first);
1247 libDoneList = listFreeCons(Lib)(Lib_listPointer->FreeCons)(libDoneList);
1248 libClose(lib0);
1249 }
1250}
1251
1252/*
1253 Called for each call of fint.
1254 */
1255localstatic Bool
1256loadMainUnit(Foam foam)
1257{
1258 int tag, fmt, argc, i, j, n;
1259 Buffer buf;
1260 FintUnit progUnit;
1261 FiProgPos constPos;
1262
1263 progUnit = (FintUnit) fintAlloc(fintUnit, 1)((DataObj) memset(stoAlloc(0, sizeof(fintUnit) * (1)), 0, sizeof
(fintUnit) * (1)))
;
1264 fintUnitBuffer(progUnit)((progUnit)->buf) = bufNew();
1265 fintUnitId(progUnit)((progUnit)->unitId) = unitId++;
1266 fintUnitName(progUnit)((progUnit)->name) = "top-level";
1267
1268 unit = progUnit;
1269
1270 fintUnitList = listCons(FintUnit)(FintUnit_listPointer->Cons)(progUnit, fintUnitList);
1271
1272 bufStart(evalBuf);
1273
1274 (void)foamToBuffer(evalBuf, foamUnitFormats(foam)((foam)->foamUnit.formats)); /* Reads ddecl */
1275
1276 tape = bufData(evalBuf);
1277 ip = 0;
1278
1279 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
1280 hardAssert(tag == FOAM_DFmt)do { if (!(tag == FOAM_DFmt)) fintHardAssert("tag == FOAM_DFmt"
, "fint.c", 1280); } while (0)
;
1281
1282 fintLoadGlobalsFmt(mainUnit);
1283 fintLoadConstantsFmt(mainUnit);
1284 fintLoadFluidsFmt(mainUnit);
1285 fintLoadLexLevels(mainUnit, argc);
1286
1287 /* Copy shared structures in progUnit */
1288
1289 fintUnitGlobs(progUnit)((progUnit)->fmtGlobs) = fintUnitGlobs(mainUnit)((mainUnit)->fmtGlobs);
1290 fintUnitConsts(progUnit)((progUnit)->fmtConsts) = fintUnitConsts(mainUnit)((mainUnit)->fmtConsts);
1291 fintUnitFluids(progUnit)((progUnit)->fmtFluids) = fintUnitFluids(mainUnit)((mainUnit)->fmtFluids);
1292 fintUnitLexLevels(progUnit)((progUnit)->lexLevels) = fintUnitLexLevels(mainUnit)((mainUnit)->lexLevels);
1293
1294 fintUnitGlobsCount(progUnit)((progUnit)->globsCount) = fintUnitGlobsCount(mainUnit)((mainUnit)->globsCount);
1295 fintUnitConstsCount(progUnit)((progUnit)->constsCount) = fintUnitConstsCount(mainUnit)((mainUnit)->constsCount);
1296 fintUnitFluidsCount(progUnit)((progUnit)->fluidsCount) = fintUnitFluidsCount(mainUnit)((mainUnit)->fluidsCount);
1297 fintUnitLexLevelsCount(progUnit)((progUnit)->lexLevelsCount) = fintUnitLexLevelsCount(mainUnit)((mainUnit)->lexLevelsCount);
1298
1299 fintUnitGlobValues(progUnit)((progUnit)->globValues) = fintUnitGlobValues(mainUnit)((mainUnit)->globValues);
1300 fintUnitConstValues(progUnit)((progUnit)->constValues) = fintUnitConstValues(mainUnit)((mainUnit)->constValues);
1301
1302 /******** Reads (Const 0) in mainUnit *********/
1303
1304 bufStart(evalBuf);
1305
1306 (void)foamToBuffer(evalBuf, foamArgv(foam->foamUnit.defs)((foam->foamUnit.defs)->foamGen.argv)[0].code);
1307
1308 tape = bufData(evalBuf);
1309 ip = 0;
1310
1311 readDef(mainUnit);
1312
1313 /******** Reads (Const 1..n) in progUnit *********/
1314
1315 n = fintUnitConstsCount(mainUnit)((mainUnit)->constsCount);
1316 buf = fintUnitBuffer(progUnit)((progUnit)->buf);
1317 constPos = 0;
1318 j = 1;
1319
1320 for (i = 1; j < n; i++) {
1321 Foam foam0 = foamArgv(foam->foamUnit.defs)((foam->foamUnit.defs)->foamGen.argv)[i].code;
1322 if (foamTag(foam0->foamGen.argv[0].code)((foam0->foamGen.argv[0].code)->hdr.tag) != FOAM_Const)
1323 continue;
1324 (void)foamToBuffer(buf, foam0);
1325 j++;
1326
1327 tape = bufData(buf); /* here, because may change */
1328 ip = constPos;
1329 constPos = bufPosition(buf);
1330 readDef(progUnit);
1331 }
1332
1333 fintUnitTape(mainUnit)((mainUnit)->tape) = bufData(evalBuf);
1334 fintUnitTape(progUnit)((progUnit)->tape) = bufData(fintUnitBuffer(progUnit)((progUnit)->buf));
1335
1336 return false((int) 0);
1337}
1338
1339
1340localstatic void
1341loadUnitFrLib(Lib lib)
1342{
1343 String name;
1344 Buffer buf;
1345
1346 name = libToStringShort(lib)(((lib)->name)->partv[1]);
1347
1348 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut, "----------------- Loading unit %s -----------------\n", name);
1349
1350 hardAssert(lib)do { if (!(lib)) fintHardAssert("lib", "fint.c", 1350); } while
(0)
;
1351
1352 libGetUnitBuffer(lib);
1353 buf = lib->unitb;
1354
1355 tape = bufData(buf);
1356 ip = 0;
1357
1358 loadUnit(name, buf);
1359}
1360
1361
1362/* Load a new unit from tape
1363 */
1364localstatic void
1365loadUnit(String name, Buffer buf)
1366{
1367 int tag, fmt, argc;
1368
1369 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
1370
1371 hardAssert(tag == FOAM_Unit)do { if (!(tag == FOAM_Unit)) fintHardAssert("tag == FOAM_Unit"
, "fint.c", 1371); } while (0)
;
1372 hardAssert(argc == 2)do { if (!(argc == 2)) fintHardAssert("argc == 2", "fint.c", 1372
); } while (0)
;
1373
1374 /* allocates fintUnit */
1375 unit = (FintUnit) fintAlloc(fintUnit,1)((DataObj) memset(stoAlloc(0, sizeof(fintUnit) * (1)), 0, sizeof
(fintUnit) * (1)))
;
1376 fintUnitList = listCons(FintUnit)(FintUnit_listPointer->Cons)(unit, fintUnitList);
1377
1378 fintUnitId(unit)((unit)->unitId) = unitId++;
1379 fintUnitTape(unit)((unit)->tape) = tape;
1380 fintUnitBuffer(unit)((unit)->buf) = buf;
1381 fintUnitName(unit)((unit)->name) = strCopy(name);
1382
1383 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
1384 hardAssert(tag == FOAM_DFmt)do { if (!(tag == FOAM_DFmt)) fintHardAssert("tag == FOAM_DFmt"
, "fint.c", 1384); } while (0)
;
1385
1386 fintLoadGlobalsFmt(unit);
1387 fintLoadConstantsFmt(unit);
1388 fintLoadFluidsFmt(unit);
1389 fintLoadLexLevels(unit, argc);
1390
1391 readDefs(unit);
1392}
1393
1394
1395localstatic void
1396readDefs(FintUnit unit)
1397{
1398 int tag, fmt, argc;
1399 int j;
1400
1401 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
1402 hardAssert(tag == FOAM_DDef)do { if (!(tag == FOAM_DDef)) fintHardAssert("tag == FOAM_DDef"
, "fint.c", 1402); } while (0)
;
1403
1404 for (j = 0; j < argc; j++)
1405 readDef(unit);
1406}
1407
1408localstatic void
1409readDef(FintUnit unit)
1410{
1411 int tag, fmt, argc, num = 0;
1412 DataObj ref;
1413 union dataObj expr;
1414 dataType type;
1415 FiProgPos oldIp;
1416
1417 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
1418 hardAssert(tag == FOAM_Def)do { if (!(tag == FOAM_Def)) fintHardAssert("tag == FOAM_Def"
, "fint.c", 1418); } while (0)
;
1419 hardAssert(argc == 2)do { if (!(argc == 2)) fintHardAssert("argc == 2", "fint.c", 1419
); } while (0)
;
1420
1421 oldIp = ip;
1422
1423 fintGetTagFmt(tag, fmt){ ((tag) = tape[ip++]); fmt = ((tag)<(FOAM_VECTOR_START)? 0
:(((tag)-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); tag = (((tag)) - ((fmt))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); }
;
1424
1425 if (tag == FOAM_Const) {
1426 fintGetInt(fmt, num){ switch (fmt) { case 0: { String _s = fintGetn(4); (num) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((num) = tape[ip++]); break
; default: (num) = (fmt) - 2; break; } }
;
1427 hardAssert(num < fintUnitConstsCount(unit))do { if (!(num < ((unit)->constsCount))) fintHardAssert
("num < fintUnitConstsCount(unit)", "fint.c", 1427); } while
(0)
;
1428 }
1429
1430 if (tag == FOAM_Const && constType(num)((((unit)->fmtConsts)[(num)]).type) == FOAM_Prog) {
1431 int nLabels, labelsCount, n;
1432 ProgInfo p;
1433 FiProgPos * pLabels;
1434
1435 p = (ProgInfo) stoAlloc(OB_Other0, sizeof(struct progInfo));
1436 progInfoName(p)((p)->name) = constId(num)((((unit)->fmtConsts)[(num)]).id);
1437 constValue(num)((unit)->constValues[(num)]).progInfo = p;
1438 progInfoUnit(p)((p)->unit) = unit;
1439
1440 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
1441 hardAssert(tag == FOAM_Prog)do { if (!(tag == FOAM_Prog)) fintHardAssert("tag == FOAM_Prog"
, "fint.c", 1441); } while (0)
;
1442
1443 fintGetInt(int0, progInfoSize(p)){ switch (((int) 0)) { case 0: { String _s = fintGetn(4); (((
p)->size)) = (int) (((((ULong) _s[0])&((1<<8)-1)
) | ((((ULong) _s[1])&((1<<8)-1))<<8))|(((((ULong
) _s[2])&((1<<8)-1)) | ((((ULong) _s[3])&((1<<
8)-1))<<8))<<(2*8))); }; break; case 1: ((((p)->
size)) = tape[ip++]); break; default: (((p)->size)) = (((int
) 0)) - 2; break; } }
; /* prog size */
1444 fintGetInt(int0 , progInfoNLabels(p)){ switch (((int) 0)) { case 0: { String _s = fintGetn(4); (((
p)->nLabels)) = (int) (((((ULong) _s[0])&((1<<8)
-1)) | ((((ULong) _s[1])&((1<<8)-1))<<8))|(((
((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[3])&
((1<<8)-1))<<8))<<(2*8))); }; break; case 1
: ((((p)->nLabels)) = tape[ip++]); break; default: (((p)->
nLabels)) = (((int) 0)) - 2; break; } }
; /* max label */
1445 nLabels = progInfoNLabels(p)((p)->nLabels);
1446
1447 labelFmt = FOAM_FORMAT_FOR(nLabels)((long)(nLabels) <= ((1<<(1*8))-1) ? 1 : 0);
1448 progInfoLabelFmt(p)((p)->labelFmt) = labelFmt;
1449 p->_progInfo = 0;
1450
1451 if (nLabels)
1452 progInfoLabels(p)((p)->labels) = (FiProgPos *)
1453 stoAlloc(OB_Other0,sizeof(FiProgPos) * nLabels);
1454 else
1455 progInfoLabels(p)((p)->labels) = (FiProgPos *) NULL((void*)0);
1456
1457 fintGetByte(progInfoRetType(p))((((p)->retType)) = tape[ip++]); /* return type */
1458 fintGetSInt(progInfoMValFmt(p)){ String _s = fintGetn(4); (((p)->mValFmt)) = (int) (((((ULong
) _s[0])&((1<<8)-1)) | ((((ULong) _s[1])&((1<<
8)-1))<<8))|(((((ULong) _s[2])&((1<<8)-1)) | (
(((ULong) _s[3])&((1<<8)-1))<<8))<<(2*8
))); }
;
1459
1460 fintGetSInt(progInfoBMask(p)){ String _s = fintGetn(4); (((p)->bMask)) = (int) (((((ULong
) _s[0])&((1<<8)-1)) | ((((ULong) _s[1])&((1<<
8)-1))<<8))|(((((ULong) _s[2])&((1<<8)-1)) | (
(((ULong) _s[3])&((1<<8)-1))<<8))<<(2*8
))); }
; /* bit mask */
1461 fintGetSInt(n){ String _s = fintGetn(4); (n) = (int) (((((ULong) _s[0])&
((1<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8))|(((((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[
3])&((1<<8)-1))<<8))<<(2*8))); }
; /* skip size */
1462 fintGetSInt(n){ String _s = fintGetn(4); (n) = (int) (((((ULong) _s[0])&
((1<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8))|(((((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[
3])&((1<<8)-1))<<8))<<(2*8))); }
; /* skip time */
1463 fintGetSInt(n){ String _s = fintGetn(4); (n) = (int) (((((ULong) _s[0])&
((1<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8))|(((((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[
3])&((1<<8)-1))<<8))<<(2*8))); }
; /* skip auxbits */
1464
1465 /* reads par. fmt */
1466 progInfoParsCount(p)((p)->parsCount) = fintReadFmt(&progInfoFmtPar(p)((p)->fmtPar));
1467
1468 /* reads locs. fmt */
1469 progInfoLocsCount(p)((p)->locsCount) = fintReadFmt(&progInfoFmtLoc(p)((p)->fmtLoc));
1470
1471 /* DFluid */
1472
1473 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
1474 hardAssert(tag == FOAM_DFluid)do { if (!(tag == FOAM_DFluid)) fintHardAssert("tag == FOAM_DFluid"
, "fint.c", 1474); } while (0)
;
1475
1476 if (argc) {
1477 UByte * b;
1478
1479 b = (UByte *) fintAlloc(UByte, argc)((DataObj) memset(stoAlloc(0, sizeof(UByte) * (argc)), 0, sizeof
(UByte) * (argc)))
;
1480 for (n = 0; n < argc; n++)
1481 fintGetInt(fmt, b[n]){ switch (fmt) { case 0: { String _s = fintGetn(4); (b[n]) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((b[n]) = tape[ip++]); break
; default: (b[n]) = (fmt) - 2; break; } }
;
1482
1483 progInfoDFluid(p)((p)->dfluid) = b;
1484 }
1485 else
1486 progInfoDFluid(p)((p)->dfluid) = NULL((void*)0);
1487
1488 progInfoDFluidsCount(p)((p)->dfluidsCount) = (UByte) argc;
1489
1490 /* DEnv */
1491
1492 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
1493 hardAssert(tag == FOAM_DEnv)do { if (!(tag == FOAM_DEnv)) fintHardAssert("tag == FOAM_DEnv"
, "fint.c", 1493); } while (0)
;
1494
1495 if (argc) {
1496 UByte * b;
1497
1498 b = (UByte *) fintAlloc(UByte, argc)((DataObj) memset(stoAlloc(0, sizeof(UByte) * (argc)), 0, sizeof
(UByte) * (argc)))
;
1499 for (n = 0; n < argc; n++)
1500 fintGetInt(fmt, b[n]){ switch (fmt) { case 0: { String _s = fintGetn(4); (b[n]) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((b[n]) = tape[ip++]); break
; default: (b[n]) = (fmt) - 2; break; } }
;
1501
1502 progInfoDEnv(p)((p)->denv) = b;
1503 }
1504 else
1505 progInfoDEnv(p)((p)->denv) = NULL((void*)0);
1506
1507 progInfoDEnvsCount(p)((p)->denvsCount) = (UByte) argc;
1508
1509 pLabels = progInfoLabels(p)((p)->labels);
1510 labelsCount = 0;
1511
1512 progInfoSeq(p)((p)->fiProgPos) = ip;
1513 skipProg(pLabels, &labelsCount);
1514
1515 hardAssert(labelsCount <= nLabels)do { if (!(labelsCount <= nLabels)) fintHardAssert("labelsCount <= nLabels"
, "fint.c", 1515); } while (0)
;
1516 }
1517 else {
1518 ip = oldIp;
1519 type = fintGetReference(&ref);
1520 fintTypedEval(&expr, type){ dataType type = fintEval(&expr); do { if (!(type == type
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == type || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",1520); } while (0); }
;
1521 fintSet(type, ref, expr){ do { if (!(ref != ((void*)0))) _do_assert(("ref != NULL"),"fint.c"
,1521); } while (0); switch ((int)type) { case FOAM_Char: *(FiChar
*)(ref) = (expr).fiChar; break; case FOAM_Bool: (ref)->fiBool
= (expr).fiBool; break; case FOAM_Byte: (ref)->fiByte = (
expr).fiByte; break; case FOAM_HInt: (ref)->fiHInt = (expr
).fiHInt; break; case FOAM_SInt: (ref)->fiSInt = (expr).fiSInt
; break; case FOAM_SFlo: (ref)->fiSFlo = (expr).fiSFlo; break
; case FOAM_DFlo: (ref)->fiDFlo = (expr).fiDFlo; break; case
FOAM_Word: (ref)->fiWord = (expr).fiWord; break; case FOAM_Arb
: (ref)->fiArb = (expr).fiArb; break; case FOAM_Ptr: (ref)
->fiPtr = (expr).fiPtr; break; case FOAM_Rec: (ref)->fiRec
= (expr).fiRec; break; case FOAM_Arr: (ref)->fiArr = (expr
).fiArr; break; case FOAM_TR: (ref)->fiTR = (expr).fiTR; break
; case FOAM_Prog: (ref)->fiProgPos=(expr).fiProgPos; break
; case FOAM_Clos: (ref)->fiClos = (expr).fiClos; break; case
FOAM_Gener: (ref)->fiGener = (expr).fiGener; break; case FOAM_GenIter
: (ref)->fiGenIter = (expr).fiGenIter; break; case FOAM_Env
: (ref)->fiEnv = (expr).fiEnv; break; case FOAM_NOp: fintSetMFmt
((ref), &(expr)); break; case FOAM_Nil: (ref)->_fiNil =
(expr)._fiNil; break; case FOAM_BInt: (ref)->fiBInt = (Ptr
) (bintCopy((BInt) (expr).fiBInt)); break; default: fintWhere
(((int) 0));bug("fintSet: type %d unimplemented.", (int)type)
; } }
;
1522 }
1523}
1524
1525/*****************************************************************************
1526 *
1527 * :: Foam Interpretation procedure
1528 *
1529 ****************************************************************************/
1530
1531/* Execute a statement. Returns true iff a return stmt has been found */
1532
1533localstatic dataType
1534fintStmt(DataObj retDataObj)
1535{
1536 int fmt, tag, argc;
1537 int n;
1538 union dataObj expr;
1539 FiProgPos stmtPos;
1540 dataType myType;
1541 readEvalLoop:
1542
1543 if (DEBUG(fintSto)fintStoDebug) {stoAudit();}
1544#ifndef NDEBUG
1545 if (instrCounter++ == instrBreak) {
1546 /* stoAudit()*/; /* SET BREAKPOINT HERE */
1547 fintDebug = true1;
1548 }
1549#endif
1550
1551 stmtPos = ip;
1552
1553 fintGetTagFmt(tag, fmt){ ((tag) = tape[ip++]); fmt = ((tag)<(FOAM_VECTOR_START)? 0
:(((tag)-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); tag = (((tag)) - ((fmt))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); }
;
1554
1555 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, ">> %s (<%s> in [%s])\n",
1556 foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).str, prog->name, prog->unit->name);
1557
1558 switch (tag) {
1559 case FOAM_Def:
1560 case FOAM_Set: {
1561 DataObj ref;
1562 dataType type;
1563
1564
1565 type = fintGetReference(&ref);
1566 (void)fintEval(&expr);
1567
1568 fintSet(type, ref, expr){ do { if (!(ref != ((void*)0))) _do_assert(("ref != NULL"),"fint.c"
,1568); } while (0); switch ((int)type) { case FOAM_Char: *(FiChar
*)(ref) = (expr).fiChar; break; case FOAM_Bool: (ref)->fiBool
= (expr).fiBool; break; case FOAM_Byte: (ref)->fiByte = (
expr).fiByte; break; case FOAM_HInt: (ref)->fiHInt = (expr
).fiHInt; break; case FOAM_SInt: (ref)->fiSInt = (expr).fiSInt
; break; case FOAM_SFlo: (ref)->fiSFlo = (expr).fiSFlo; break
; case FOAM_DFlo: (ref)->fiDFlo = (expr).fiDFlo; break; case
FOAM_Word: (ref)->fiWord = (expr).fiWord; break; case FOAM_Arb
: (ref)->fiArb = (expr).fiArb; break; case FOAM_Ptr: (ref)
->fiPtr = (expr).fiPtr; break; case FOAM_Rec: (ref)->fiRec
= (expr).fiRec; break; case FOAM_Arr: (ref)->fiArr = (expr
).fiArr; break; case FOAM_TR: (ref)->fiTR = (expr).fiTR; break
; case FOAM_Prog: (ref)->fiProgPos=(expr).fiProgPos; break
; case FOAM_Clos: (ref)->fiClos = (expr).fiClos; break; case
FOAM_Gener: (ref)->fiGener = (expr).fiGener; break; case FOAM_GenIter
: (ref)->fiGenIter = (expr).fiGenIter; break; case FOAM_Env
: (ref)->fiEnv = (expr).fiEnv; break; case FOAM_NOp: fintSetMFmt
((ref), &(expr)); break; case FOAM_Nil: (ref)->_fiNil =
(expr)._fiNil; break; case FOAM_BInt: (ref)->fiBInt = (Ptr
) (bintCopy((BInt) (expr).fiBInt)); break; default: fintWhere
(((int) 0));bug("fintSet: type %d unimplemented.", (int)type)
; } }
;
1569 break;
1570 }
1571 case FOAM_Loose: {
1572 /* Neutralise a pointer */
1573 DataObj loc;
1574 dataType type;
1575
1576 type = fintGetReference(&loc);
1577 switch ((int)type) {
1578 case FOAM_SFlo : expr.fiSFlo = 0.0;break;
1579 case FOAM_DFlo : expr.fiDFlo = 0.0;break;
1580 default : expr.fiSInt = 0;break;
1581 }
1582
1583 fintSet(type, loc, expr){ do { if (!(loc != ((void*)0))) _do_assert(("loc != NULL"),"fint.c"
,1583); } while (0); switch ((int)type) { case FOAM_Char: *(FiChar
*)(loc) = (expr).fiChar; break; case FOAM_Bool: (loc)->fiBool
= (expr).fiBool; break; case FOAM_Byte: (loc)->fiByte = (
expr).fiByte; break; case FOAM_HInt: (loc)->fiHInt = (expr
).fiHInt; break; case FOAM_SInt: (loc)->fiSInt = (expr).fiSInt
; break; case FOAM_SFlo: (loc)->fiSFlo = (expr).fiSFlo; break
; case FOAM_DFlo: (loc)->fiDFlo = (expr).fiDFlo; break; case
FOAM_Word: (loc)->fiWord = (expr).fiWord; break; case FOAM_Arb
: (loc)->fiArb = (expr).fiArb; break; case FOAM_Ptr: (loc)
->fiPtr = (expr).fiPtr; break; case FOAM_Rec: (loc)->fiRec
= (expr).fiRec; break; case FOAM_Arr: (loc)->fiArr = (expr
).fiArr; break; case FOAM_TR: (loc)->fiTR = (expr).fiTR; break
; case FOAM_Prog: (loc)->fiProgPos=(expr).fiProgPos; break
; case FOAM_Clos: (loc)->fiClos = (expr).fiClos; break; case
FOAM_Gener: (loc)->fiGener = (expr).fiGener; break; case FOAM_GenIter
: (loc)->fiGenIter = (expr).fiGenIter; break; case FOAM_Env
: (loc)->fiEnv = (expr).fiEnv; break; case FOAM_NOp: fintSetMFmt
((loc), &(expr)); break; case FOAM_Nil: (loc)->_fiNil =
(expr)._fiNil; break; case FOAM_BInt: (loc)->fiBInt = (Ptr
) (bintCopy((BInt) (expr).fiBInt)); break; default: fintWhere
(((int) 0));bug("fintSet: type %d unimplemented.", (int)type)
; } }
;
1584 break;
1585 }
1586 /* fall through */
1587 case FOAM_Free:
1588 (void)fintEval(&expr);
1589 fintFree0(expr.fiPtr)if (expr.fiPtr) stoFree(expr.fiPtr);
1590 break;
1591
1592 case FOAM_Goto:
1593 fintGetInt(labelFmt, n){ switch (labelFmt) { case 0: { String _s = fintGetn(4); (n) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (labelFmt) - 2; break; } }
;
1594 ip = labels[n];
1595 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "(Goto %d)\n", n);
1596 break;
1597
1598 case FOAM_If: {
1599 dataType type;
1600 type = fintEval(&expr);
1601 hardAssert(type == FOAM_Word || type == FOAM_Bool)do { if (!(type == FOAM_Word || type == FOAM_Bool)) fintHardAssert
("type == FOAM_Word || type == FOAM_Bool", "fint.c", 1601); }
while (0)
;
1602 fintGetInt(labelFmt, n){ switch (labelFmt) { case 0: { String _s = fintGetn(4); (n) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (labelFmt) - 2; break; } }
;
1603
1604 if ((type == FOAM_Word ? expr.fiWord : expr.fiBool)) {
1605 ip = labels[n];
1606 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "(if causes jump to label %d)\n", n);
1607 }
1608 break;
1609 }
1610 case FOAM_Return:
1611 myType = fintEval(retDataObj);
1612 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "returning from %s in %s\n",
1613 prog->name, prog->unit->name);
1614 return myType; /* Unique exit for a stmt sequence (also: see yield) */
1615
1616 case FOAM_Seq: /* Ignore... */
1617 fintGetInt(fmt,argc){ switch (fmt) { case 0: { String _s = fintGetn(4); (argc) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } }
;
1618 break;
1619
1620 case FOAM_Select: {
1621 int i;
1622
1623 fintGetInt(fmt,argc){ switch (fmt) { case 0: { String _s = fintGetn(4); (argc) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } }
; /* Get the arity */
1624 fintTypedEval(&expr, FOAM_SInt){ dataType type = fintEval(&expr); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",1624); } while (0); }
;
1625
1626 fintGetInt(labelFmt, n){ switch (labelFmt) { case 0: { String _s = fintGetn(4); (n) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (labelFmt) - 2; break; } }
;
1627
1628 /*
1629 * Bug? What happens if expr.fiSInt >= argc? It looks
1630 * as though we keep reading the tape interpreting the
1631 * bytes as labels even if we run out of labels.
1632 */
1633 for (i = 0; i < expr.fiSInt; i++)
1634 fintGetInt(labelFmt, n){ switch (labelFmt) { case 0: { String _s = fintGetn(4); (n) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (labelFmt) - 2; break; } }
;
1635
1636 if (DEBUG(fint)fintDebug) {
1637 if (i >= argc)
1638 (void)fprintf(dbOut, "Select: read too many labels\n");
1639 }
1640 ip = labels[n];
1641
1642 break;
1643 }
1644 case FOAM_Throw: {
1645 union dataObj expr;
1646 (void)fintEval(&expr); /* Tag: Ignore */
1647 fintTypedEval(&expr, FOAM_Word){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",1647); } while (0); }
;
1648
1649 if (fintExntraceMode == 2) {
1650 /* Stack trace sent to stderr */
1651 FILE *oldDbOut = dbOut;
1652 dbOut = osStderr;
1653 fprintf(dbOut, "Aldor interpreter: exception raised (may be caught), backtrace:\n");
1654 fintWhere(FINT_BACKTRACE_CUTOFF23);
1655 fprintf(dbOut, "\n");
1656 dbOut = oldDbOut;
1657 };
1658
1659 fiUnwind(int0((int) 0), expr.fiWord);
1660 bug("unwind returned");
1661 break;
1662 }
1663 case FOAM_GenerStep: {
1664 union dataObj loc;
1665 Bool done;
1666 fintGetInt(labelFmt, n){ switch (labelFmt) { case 0: { String _s = fintGetn(4); (n) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (labelFmt) - 2; break; } }
;
1667 fintTypedEval(&loc, FOAM_GenIter){ dataType type = fintEval(&loc); do { if (!(type == FOAM_GenIter
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_GenIter || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",1667); } while (0); }
;
1668 done = fintGenerStep(loc.fiGenIter);
1669 if (done) {
1670 ip = labels[n];
1671 }
1672 break;
1673 }
1674 case FOAM_Yield: {
1675 FiGenIter iter = currGenIter;
1676 fintTypedEval(&expr, FOAM_Word){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",1676); } while (0); }
;
1677 fiGenerStepIndex(iter)((iter)->step) = ip;
1678 fiGenerValue(iter)((iter)->value) = expr.fiWord;
1679 return FOAM_Word;
1680 }
1681 case FOAM_GenerValue:
1682 case FOAM_GenIter:
1683 case FOAM_CCall:
1684 case FOAM_BCall:
1685 case FOAM_OCall:
1686 case FOAM_PCall:
1687 case FOAM_BVal:
1688 case FOAM_Cast:
1689 case FOAM_ANew:
1690 case FOAM_RNew:
1691 case FOAM_RRNew:
1692 case FOAM_TRNew:
1693 case FOAM_MFmt:
1694 case FOAM_Values:
1695 case FOAM_Catch:
1696 case FOAM_EEnsure:
1697 ip = stmtPos;
1698 (void)fintEval(&expr); /* we ignore the ret value */
1699 break;
1700 case FOAM_Label:
1701 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
1702 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "(Label %d)\n", n);
1703 break;
1704 case FOAM_Nil:
1705 case FOAM_Lex: /* we get things like that when we -q0 (deadvar
1706 is effective in killing them */
1707 case FOAM_NOp:
1708 break;
1709 default:
1710 fintWhere(int0((int) 0));
1711 bug("fintStmt: %s (<%s> in [%s]) unimplemented...\n",
1712 foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).str, prog->name, prog->unit->name);
1713 }
1714
1715 goto readEvalLoop;
1716 return -1;
1717}
1718
1719localstatic dataType
1720fintEvalBCall(DataObj retDataObj)
1721{
1722 int call;
1723 union dataObj expr1, expr2, expr3, expr4, expr5, expr6;
1724 dataType type, myType;
1725
1726#if SMALL_BVAL_TAGS
1727 fintGetByte(call)((call) = tape[ip++]);
1728#else
1729 fintGetHInt(call){ String _s = fintGetn(2); (call) = ((((ULong) _s[0])&((1
<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8)); }
;
1730#endif
1731 call += FOAM_BVAL_START;
1732
1733 fintDEBUGif (!fintDebug) { } else afprintf(dbOut,
1734 "fintBCall: %s\n", foamBValInfo(call)(foamBValInfoTable[(int)(call)-(int)FOAM_BVAL_START]).str);
1735
1736 switch (call) {
1737
1738 /* -------------------- Operations on BOOLEAN ------------- */
1739
1740 case FOAM_BVal_BoolFalse:
1741 retDataObj->fiBool = fiFalse((FiBool) 0);
1742 myType = FOAM_Bool;
1743 break;
1744 case FOAM_BVal_BoolTrue:
1745 retDataObj->fiBool = fiTrue((FiBool) 1);
1746 myType = FOAM_Bool;
1747 break;
1748
1749 case FOAM_BVal_BoolNot:
1750 type = fintEval(&expr1);
1751
1752 fintForceBoolToWord(expr1, type)if (type == FOAM_Bool) expr1.fiWord = (FiWord) expr1.fiBool;
1753
1754 retDataObj->fiBool = ((expr1.fiWord) ? (fiFalse((FiBool) 0)) : (fiTrue((FiBool) 1)));
1755
1756 myType = FOAM_Bool;
1757 break;
1758
1759 case FOAM_BVal_BoolAnd:
1760
1761 type = fintEval(&expr1);
1762 fintForceBoolToWord(expr1, type)if (type == FOAM_Bool) expr1.fiWord = (FiWord) expr1.fiBool;
1763
1764 type = fintEval(&expr2);
1765 fintForceBoolToWord(expr2, type)if (type == FOAM_Bool) expr2.fiWord = (FiWord) expr2.fiBool;
1766
1767 retDataObj->fiBool = ((expr1.fiWord && expr2.fiWord) ?
1768 fiTrue((FiBool) 1) :
1769 fiFalse((FiBool) 0));
1770
1771 myType = FOAM_Bool;
1772 break;
1773
1774 case FOAM_BVal_BoolOr:
1775 type = fintEval(&expr1);
1776 fintForceBoolToWord(expr1, type)if (type == FOAM_Bool) expr1.fiWord = (FiWord) expr1.fiBool;
1777
1778 type = fintEval(&expr2);
1779 fintForceBoolToWord(expr2, type)if (type == FOAM_Bool) expr2.fiWord = (FiWord) expr2.fiBool;
1780
1781
1782 retDataObj->fiBool = ((expr1.fiWord || expr2.fiWord) ?
1783 fiTrue((FiBool) 1) :
1784 fiFalse((FiBool) 0));
1785
1786 myType = FOAM_Bool;
1787 break;
1788
1789 case FOAM_BVal_BoolEQ:
1790 type = fintEval(&expr1);
1791 fintForceBoolToWord(expr1, type)if (type == FOAM_Bool) expr1.fiWord = (FiWord) expr1.fiBool;
1792
1793 type = fintEval(&expr2);
1794 fintForceBoolToWord(expr2, type)if (type == FOAM_Bool) expr2.fiWord = (FiWord) expr2.fiBool;
1795
1796
1797 retDataObj->fiBool = ((expr1.fiWord == expr2.fiWord) ?
1798 fiTrue((FiBool) 1) :
1799 fiFalse((FiBool) 0));
1800
1801 myType = FOAM_Bool;
1802 break;
1803
1804 case FOAM_BVal_BoolNE:
1805 type = fintEval(&expr1);
1806 fintForceBoolToWord(expr1, type)if (type == FOAM_Bool) expr1.fiWord = (FiWord) expr1.fiBool;
1807
1808 type = fintEval(&expr2);
1809 fintForceBoolToWord(expr2, type)if (type == FOAM_Bool) expr2.fiWord = (FiWord) expr2.fiBool;
1810
1811
1812 retDataObj->fiBool = ((expr1.fiWord != expr2.fiWord) ?
1813 fiTrue((FiBool) 1) :
1814 fiFalse((FiBool) 0));
1815
1816 myType = FOAM_Bool;
1817 break;
1818
1819 /* -------------------- Operations on CHAR ------------- */
1820 case FOAM_BVal_CharSpace:
1821 retDataObj->fiChar = ' ';
1822 myType = FOAM_Char;
1823 break;
1824
1825 case FOAM_BVal_CharNewline:
1826 retDataObj->fiChar = '\n';
1827 myType = FOAM_Char;
1828 break;
1829
1830
1831 case FOAM_BVal_CharTab:
1832 retDataObj->fiChar = '\t';
1833 myType = FOAM_Char;
1834 break;
1835
1836 case FOAM_BVal_CharMax:
1837 retDataObj->fiChar = fiCharMax();
1838 myType = FOAM_Char;
1839 break;
1840
1841 case FOAM_BVal_CharMin:
1842 retDataObj->fiChar = fiCharMin();
1843 myType = FOAM_Char;
1844 break;
1845
1846 case FOAM_BVal_CharIsDigit:
1847 (void)fintEval(&expr1);
1848 retDataObj->fiBool = (FiBool) isdigit(expr1.fiChar)((*__ctype_b_loc ())[(int) ((expr1.fiChar))] & (unsigned short
int) _ISdigit)
;
1849 myType = FOAM_Bool;
1850 break;
1851
1852 case FOAM_BVal_CharIsLetter:
1853 (void)fintEval(&expr1);
1854 retDataObj->fiBool = (FiBool) isalpha(expr1.fiChar)((*__ctype_b_loc ())[(int) ((expr1.fiChar))] & (unsigned short
int) _ISalpha)
;
1855 myType = FOAM_Bool;
1856 break;
1857
1858 case FOAM_BVal_CharEQ:
1859 (void)fintEval(&expr1);
1860 (void)fintEval(&expr2);
1861 retDataObj->fiBool = (expr1.fiChar == expr2.fiChar);
1862 myType = FOAM_Bool;
1863 break;
1864
1865 case FOAM_BVal_CharNE:
1866 (void)fintEval(&expr1);
1867 (void)fintEval(&expr2);
1868 retDataObj->fiBool = (expr1.fiChar != expr2.fiChar);
1869 myType = FOAM_Bool;
1870 break;
1871
1872 case FOAM_BVal_CharLT:
1873 (void)fintEval(&expr1);
1874 (void)fintEval(&expr2);
1875 retDataObj->fiBool = (expr1.fiChar < expr2.fiChar);
1876 myType = FOAM_Bool;
1877 break;
1878
1879 case FOAM_BVal_CharLE:
1880 (void)fintEval(&expr1);
1881 (void)fintEval(&expr2);
1882 retDataObj->fiBool = (expr1.fiChar <= expr2.fiChar);
1883 myType = FOAM_Bool;
1884 break;
1885
1886 case FOAM_BVal_CharLower:
1887 (void)fintEval(&expr1);
1888 retDataObj->fiChar = fiCharLower(expr1.fiChar);
1889 myType = FOAM_Char;
1890 break;
1891
1892 case FOAM_BVal_CharUpper:
1893 (void)fintEval(&expr1);
1894 retDataObj->fiChar = fiCharUpper(expr1.fiChar);
1895 myType = FOAM_Char;
1896 break;
1897
1898 case FOAM_BVal_CharOrd:
1899 (void)fintEval(&expr1);
1900 retDataObj->fiSInt = (FiSInt) (expr1.fiChar);
1901 myType = FOAM_SInt;
1902 break;
1903
1904 case FOAM_BVal_CharNum:
1905 (void)fintEval(&expr1);
1906 retDataObj->fiChar = (FiChar) (expr1.fiSInt);
1907 myType = FOAM_Char;
1908 break;
1909
1910 /* -------------------- Rounding Values ------------- */
1911
1912 case FOAM_BVal_RoundNearest:
1913 retDataObj->fiSInt = fiRoundNearest()1;
1914 myType = FOAM_SInt;
1915 break;
1916
1917 case FOAM_BVal_RoundZero:
1918 retDataObj->fiSInt = fiRoundZero()0;
1919 myType = FOAM_SInt;
1920 break;
1921
1922 case FOAM_BVal_RoundUp:
1923 retDataObj->fiSInt = fiRoundUp()2;
1924 myType = FOAM_SInt;
1925 break;
1926
1927 case FOAM_BVal_RoundDown:
1928 retDataObj->fiSInt = fiRoundDown()3;
1929 myType = FOAM_SInt;
1930 break;
1931
1932 case FOAM_BVal_RoundDontCare:
1933 retDataObj->fiSInt = fiRoundDontCare()4;
1934 myType = FOAM_SInt;
1935 break;
1936
1937 /* -------------------- Operations on SFLO ------------- */
1938
1939 case FOAM_BVal_SFlo0:
1940 retDataObj->fiSFlo = (FiSFlo) 0;
1941 myType = FOAM_SFlo;
1942 break;
1943
1944 case FOAM_BVal_SFlo1:
1945 retDataObj->fiSFlo = (FiSFlo) 1;
1946 myType = FOAM_SFlo;
1947 break;
1948
1949 case FOAM_BVal_SFloMax:
1950 retDataObj->fiSFlo = fiSFloMax();
1951 myType = FOAM_SFlo;
1952 break;
1953
1954 case FOAM_BVal_SFloMin:
1955 retDataObj->fiSFlo = fiSFloMin();
1956 myType = FOAM_SFlo;
1957 break;
1958
1959 case FOAM_BVal_SFloEpsilon:
1960 retDataObj->fiSFlo = fiSFloEpsilon();
1961 myType = FOAM_SFlo;
1962 break;
1963
1964 case FOAM_BVal_SFloIsZero:
1965 (void)fintEval(&expr1);
1966 retDataObj->fiBool = (expr1.fiSFlo ? fiFalse((FiBool) 0) : fiTrue((FiBool) 1));
1967 myType = FOAM_Bool;
1968 break;
1969
1970 case FOAM_BVal_SFloIsNeg:
1971 (void)fintEval(&expr1);
1972 retDataObj->fiBool = (expr1.fiSFlo < 0 ? fiTrue((FiBool) 1) : fiFalse((FiBool) 0));
1973 myType = FOAM_Bool;
1974 break;
1975
1976 case FOAM_BVal_SFloIsPos:
1977 (void)fintEval(&expr1);
1978 retDataObj->fiBool = (expr1.fiSFlo > 0 ? fiTrue((FiBool) 1) : fiFalse((FiBool) 0));
1979 myType = FOAM_Bool;
1980 break;
1981
1982 case FOAM_BVal_SFloEQ:
1983 (void)fintEval(&expr1);
1984 (void)fintEval(&expr2);
1985 retDataObj->fiBool = (expr1.fiSFlo == expr2.fiSFlo);
1986 myType = FOAM_Bool;
1987 break;
1988
1989 case FOAM_BVal_SFloNE:
1990 (void)fintEval(&expr1);
1991 (void)fintEval(&expr2);
1992 retDataObj->fiBool = (expr1.fiSFlo != expr2.fiSFlo);
1993 myType = FOAM_Bool;
1994 break;
1995
1996 case FOAM_BVal_SFloLT:
1997 (void)fintEval(&expr1);
1998 (void)fintEval(&expr2);
1999 retDataObj->fiBool = (expr1.fiSFlo < expr2.fiSFlo);
2000 myType = FOAM_Bool;
2001 break;
2002
2003 case FOAM_BVal_SFloLE:
2004 (void)fintEval(&expr1);
2005 (void)fintEval(&expr2);
2006 retDataObj->fiBool = (expr1.fiSFlo <= expr2.fiSFlo);
2007 myType = FOAM_Bool;
2008 break;
2009
2010 case FOAM_BVal_SFloNegate:
2011 (void)fintEval(&expr1);
2012 retDataObj->fiSFlo = -expr1.fiSFlo;
2013 myType = FOAM_SFlo;
2014 break;
2015
2016 case FOAM_BVal_SFloPrev:
2017 (void)fintEval(&expr1);
2018 retDataObj->fiSFlo = fiSFloPrev(expr1.fiSFlo);
2019 myType = FOAM_SFlo;
2020 break;
2021
2022 case FOAM_BVal_SFloNext:
2023 (void)fintEval(&expr1);
2024 retDataObj->fiSFlo = fiSFloNext(expr1.fiSFlo);
2025 myType = FOAM_SFlo;
2026 break;
2027
2028 case FOAM_BVal_SFloPlus:
2029 (void)fintEval(&expr1);
2030 (void)fintEval(&expr2);
2031 retDataObj->fiSFlo = (expr1.fiSFlo + expr2.fiSFlo);
2032 myType = FOAM_SFlo;
2033 break;
2034
2035 case FOAM_BVal_SFloMinus:
2036 (void)fintEval(&expr1);
2037 (void)fintEval(&expr2);
2038 retDataObj->fiSFlo = (expr1.fiSFlo - expr2.fiSFlo);
2039 myType = FOAM_SFlo;
2040 break;
2041
2042 case FOAM_BVal_SFloTimes:
2043 (void)fintEval(&expr1);
2044 (void)fintEval(&expr2);
2045 retDataObj->fiSFlo = (expr1.fiSFlo * expr2.fiSFlo);
2046 myType = FOAM_SFlo;
2047 break;
2048
2049 case FOAM_BVal_SFloTimesPlus:
2050 (void)fintEval(&expr1);
2051 (void)fintEval(&expr2);
2052 (void)fintEval(&expr3);
2053 retDataObj->fiSFlo = fiSFloTimesPlus(expr1.fiSFlo,((expr1.fiSFlo)*(expr2.fiSFlo)+(expr3.fiSFlo))
2054 expr2.fiSFlo,((expr1.fiSFlo)*(expr2.fiSFlo)+(expr3.fiSFlo))
2055 expr3.fiSFlo)((expr1.fiSFlo)*(expr2.fiSFlo)+(expr3.fiSFlo));
2056 myType = FOAM_SFlo;
2057 break;
2058
2059 case FOAM_BVal_SFloDivide:
2060 (void)fintEval(&expr1);
2061 (void)fintEval(&expr2);
2062 retDataObj->fiSFlo = (expr1.fiSFlo / expr2.fiSFlo);
2063 myType = FOAM_SFlo;
2064 break;
2065
2066 case FOAM_BVal_SFloTruncate:
2067 (void)fintEval(&expr1);
2068 retDataObj->fiBInt = fiSFloTruncate(expr1.fiSFlo);
2069 myType = FOAM_BInt;
2070 break;
2071
2072 case FOAM_BVal_SFloFraction:
2073 (void)fintEval(&expr1);
2074 retDataObj->fiSFlo = fiSFloFraction(expr1.fiSFlo);
2075 myType = FOAM_SFlo;
2076 break;
2077
2078 case FOAM_BVal_SFloRound:
2079 (void)fintEval(&expr1);
2080 (void)fintEval(&expr2);
2081 retDataObj->fiBInt = fiSFloRound(expr1.fiSFlo, expr2.fiSInt);
2082 myType = FOAM_BInt;
2083 break;
2084
2085 case FOAM_BVal_SFloRPlus:
2086 (void)fintEval(&expr1);
2087 (void)fintEval(&expr2);
2088 (void)fintEval(&expr3);
2089
2090 retDataObj->fiSFlo = fiSFloRPlus(expr1.fiSFlo,expr2.fiSFlo,
2091 expr3.fiSInt);
2092 myType = FOAM_SFlo;
2093 break;
2094
2095 case FOAM_BVal_SFloRMinus:
2096 (void)fintEval(&expr1);
2097 (void)fintEval(&expr2);
2098 (void)fintEval(&expr3);
2099
2100 retDataObj->fiSFlo = fiSFloRMinus(expr1.fiSFlo,expr2.fiSFlo,
2101 expr3.fiSInt);
2102 myType = FOAM_SFlo;
2103 break;
2104
2105 case FOAM_BVal_SFloRTimes:
2106 (void)fintEval(&expr1);
2107 (void)fintEval(&expr2);
2108 (void)fintEval(&expr3);
2109
2110 retDataObj->fiSFlo = fiSFloRTimes(expr1.fiSFlo,expr2.fiSFlo,
2111 expr3.fiSInt);
2112 myType = FOAM_SFlo;
2113 break;
2114
2115 case FOAM_BVal_SFloRTimesPlus:
2116 (void)fintEval(&expr1);
2117 (void)fintEval(&expr2);
2118 (void)fintEval(&expr3);
2119 (void)fintEval(&expr4);
2120
2121 retDataObj->fiSFlo = fiSFloRTimesPlus(expr1.fiSFlo,
2122 expr2.fiSFlo,
2123 expr3.fiSFlo,
2124 expr4.fiSInt);
2125 myType = FOAM_SFlo;
2126 break;
2127
2128 case FOAM_BVal_SFloRDivide:
2129 (void)fintEval(&expr1);
2130 (void)fintEval(&expr2);
2131 (void)fintEval(&expr3);
2132
2133 retDataObj->fiSFlo = fiSFloRDivide(expr1.fiSFlo,expr2.fiSFlo,
2134 expr3.fiSInt);
2135 myType = FOAM_SFlo;
2136 break;
2137
2138 case FOAM_BVal_SFloDissemble:
2139
2140 retDataObj->ptr = fintAlloc(union dataObj, 3)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (3)), 0
, sizeof(union dataObj) * (3)))
;
2141
2142 (void)fintEval(&expr1);
2143
2144 fiSFloDissemble((FiSFlo)expr1.fiSFlo,
2145 (FiBool *) & (retDataObj->ptr[0].fiBool),
2146 (FiSInt *) & (retDataObj->ptr[1].fiSInt),
2147 (FiWord *) & (retDataObj->ptr[2].fiWord));
2148
2149 myType = FOAM_NOp;
2150 break;
2151
2152 case FOAM_BVal_SFloAssemble:
2153
2154 (void)fintEval(&expr1);
2155 (void)fintEval(&expr2);
2156 (void)fintEval(&expr3);
2157
2158 retDataObj->fiSFlo = fiSFloAssemble((FiBool)expr1.fiBool,
2159 expr2.fiSInt,
2160 expr3.fiWord);
2161
2162 myType = FOAM_SFlo;
2163 break;
2164
2165 /* -------------------- Operations on DFLO ------------- */
2166
2167 case FOAM_BVal_DFlo0:
2168 retDataObj->fiDFlo = (FiDFlo) 0;
2169 myType = FOAM_DFlo;
2170 break;
2171
2172 case FOAM_BVal_DFlo1:
2173 retDataObj->fiDFlo = (FiDFlo) 1;
2174 myType = FOAM_DFlo;
2175 break;
2176
2177
2178 case FOAM_BVal_DFloMax:
2179 retDataObj->fiDFlo = fiDFloMax();
2180 myType = FOAM_DFlo;
2181 break;
2182
2183 case FOAM_BVal_DFloMin:
2184 retDataObj->fiDFlo = fiDFloMin();
2185 myType = FOAM_DFlo;
2186 break;
2187
2188 case FOAM_BVal_DFloEpsilon:
2189 retDataObj->fiDFlo = fiDFloEpsilon();
2190 myType = FOAM_DFlo;
2191 break;
2192
2193 case FOAM_BVal_DFloIsZero:
2194 (void)fintEval(&expr1);
2195 retDataObj->fiBool = (expr1.fiDFlo ? fiFalse((FiBool) 0) : fiTrue((FiBool) 1));
2196 myType = FOAM_Bool;
2197 break;
2198
2199 case FOAM_BVal_DFloIsNeg:
2200 (void)fintEval(&expr1);
2201 retDataObj->fiBool = (expr1.fiDFlo < 0 ? fiTrue((FiBool) 1) : fiFalse((FiBool) 0));
2202 myType = FOAM_Bool;
2203 break;
2204
2205 case FOAM_BVal_DFloIsPos:
2206 (void)fintEval(&expr1);
2207 retDataObj->fiBool = (expr1.fiDFlo > 0 ? fiTrue((FiBool) 1) : fiFalse((FiBool) 0));
2208 myType = FOAM_Bool;
2209 break;
2210
2211 case FOAM_BVal_DFloEQ:
2212 (void)fintEval(&expr1);
2213 (void)fintEval(&expr2);
2214 retDataObj->fiBool = (expr1.fiDFlo == expr2.fiDFlo);
2215 myType = FOAM_Bool;
2216 break;
2217
2218 case FOAM_BVal_DFloNE:
2219 (void)fintEval(&expr1);
2220 (void)fintEval(&expr2);
2221 retDataObj->fiBool = (expr1.fiDFlo != expr2.fiDFlo);
2222 myType = FOAM_Bool;
2223 break;
2224
2225 case FOAM_BVal_DFloLT:
2226 (void)fintEval(&expr1);
2227 (void)fintEval(&expr2);
2228 retDataObj->fiBool = (expr1.fiDFlo < expr2.fiDFlo);
2229 myType = FOAM_Bool;
2230 break;
2231
2232 case FOAM_BVal_DFloLE:
2233 (void)fintEval(&expr1);
2234 (void)fintEval(&expr2);
2235 retDataObj->fiBool = (expr1.fiDFlo <= expr2.fiDFlo);
2236 myType = FOAM_Bool;
2237 break;
2238
2239 case FOAM_BVal_DFloNegate:
2240 (void)fintEval(&expr1);
2241 retDataObj->fiDFlo = -expr1.fiDFlo;
2242 myType = FOAM_DFlo;
2243 break;
2244
2245 case FOAM_BVal_DFloPrev:
2246 (void)fintEval(&expr1);
2247 retDataObj->fiDFlo = fiDFloPrev(expr1.fiDFlo);
2248 myType = FOAM_DFlo;
2249 break;
2250
2251 case FOAM_BVal_DFloNext:
2252 (void)fintEval(&expr1);
2253 retDataObj->fiDFlo = fiDFloNext(expr1.fiDFlo);
2254 myType = FOAM_DFlo;
2255 break;
2256
2257 case FOAM_BVal_DFloPlus:
2258 (void)fintEval(&expr1);
2259 (void)fintEval(&expr2);
2260 retDataObj->fiDFlo = (expr1.fiDFlo + expr2.fiDFlo);
2261 myType = FOAM_DFlo;
2262 break;
2263
2264 case FOAM_BVal_DFloMinus:
2265 (void)fintEval(&expr1);
2266 (void)fintEval(&expr2);
2267 retDataObj->fiDFlo = (expr1.fiDFlo - expr2.fiDFlo);
2268 myType = FOAM_DFlo;
2269 break;
2270
2271 case FOAM_BVal_DFloTimes:
2272 (void)fintEval(&expr1);
2273 (void)fintEval(&expr2);
2274 retDataObj->fiDFlo = (expr1.fiDFlo * expr2.fiDFlo);
2275 myType = FOAM_DFlo;
2276 break;
2277
2278 case FOAM_BVal_DFloTimesPlus:
2279 (void)fintEval(&expr1);
2280 (void)fintEval(&expr2);
2281 (void)fintEval(&expr3);
2282 retDataObj->fiDFlo = fiDFloTimesPlus(expr1.fiDFlo,((expr1.fiDFlo)*(expr2.fiDFlo)+(expr3.fiDFlo))
2283 expr2.fiDFlo,((expr1.fiDFlo)*(expr2.fiDFlo)+(expr3.fiDFlo))
2284 expr3.fiDFlo)((expr1.fiDFlo)*(expr2.fiDFlo)+(expr3.fiDFlo));
2285 myType = FOAM_DFlo;
2286 break;
2287
2288 case FOAM_BVal_DFloDivide:
2289 (void)fintEval(&expr1);
2290 (void)fintEval(&expr2);
2291 retDataObj->fiDFlo = (expr1.fiDFlo / expr2.fiDFlo);
2292 myType = FOAM_DFlo;
2293 break;
2294
2295 case FOAM_BVal_DFloTruncate:
2296 (void)fintEval(&expr1);
2297 retDataObj->fiBInt = fiDFloTruncate(expr1.fiDFlo);
2298 myType = FOAM_BInt;
2299 break;
2300
2301 case FOAM_BVal_DFloFraction:
2302 (void)fintEval(&expr1);
2303 retDataObj->fiDFlo = fiDFloFraction(expr1.fiDFlo);
2304 myType = FOAM_DFlo;
2305 break;
2306
2307 case FOAM_BVal_DFloRound:
2308 (void)fintEval(&expr1);
2309 (void)fintEval(&expr2);
2310 retDataObj->fiBInt = fiDFloRound(expr1.fiDFlo, expr2.fiSInt);
2311 myType = FOAM_BInt;
2312 break;
2313
2314 case FOAM_BVal_DFloRPlus:
2315 (void)fintEval(&expr1);
2316 (void)fintEval(&expr2);
2317 (void)fintEval(&expr3);
2318
2319 retDataObj->fiDFlo = fiDFloRPlus(expr1.fiDFlo,expr2.fiDFlo,
2320 expr3.fiSInt);
2321 myType = FOAM_DFlo;
2322 break;
2323
2324 case FOAM_BVal_DFloRMinus:
2325 (void)fintEval(&expr1);
2326 (void)fintEval(&expr2);
2327 (void)fintEval(&expr3);
2328
2329 retDataObj->fiDFlo = fiDFloRMinus(expr1.fiDFlo,expr2.fiDFlo,
2330 expr3.fiSInt);
2331 myType = FOAM_DFlo;
2332 break;
2333
2334 case FOAM_BVal_DFloRTimes:
2335 (void)fintEval(&expr1);
2336 (void)fintEval(&expr2);
2337 (void)fintEval(&expr3);
2338
2339 retDataObj->fiDFlo = fiDFloRTimes(expr1.fiDFlo,expr2.fiDFlo,
2340 expr3.fiSInt);
2341 myType = FOAM_DFlo;
2342 break;
2343
2344 case FOAM_BVal_DFloRDivide:
2345 (void)fintEval(&expr1);
2346 (void)fintEval(&expr2);
2347 (void)fintEval(&expr3);
2348
2349 retDataObj->fiDFlo = fiDFloRDivide(expr1.fiDFlo,expr2.fiDFlo,
2350 expr3.fiSInt);
2351 myType = FOAM_DFlo;
2352 break;
2353
2354 case FOAM_BVal_DFloRTimesPlus:
2355 (void)fintEval(&expr1);
2356 (void)fintEval(&expr2);
2357 (void)fintEval(&expr3);
2358 (void)fintEval(&expr4);
2359
2360 retDataObj->fiDFlo = fiDFloRTimesPlus(expr1.fiDFlo,
2361 expr2.fiDFlo,
2362 expr3.fiDFlo,
2363 expr4.fiSInt);
2364 myType = FOAM_DFlo;
2365 break;
2366
2367 case FOAM_BVal_DFloDissemble:
2368
2369 retDataObj->ptr = fintAlloc(union dataObj, 4)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (4)), 0
, sizeof(union dataObj) * (4)))
;
2370
2371 (void)fintEval(&expr1);
2372
2373 fiDFloDissemble((FiDFlo)expr1.fiDFlo,
2374 (FiBool *) & (retDataObj->ptr[0].fiBool),
2375 (FiSInt *) & (retDataObj->ptr[1].fiSInt),
2376 (FiWord *) & (retDataObj->ptr[2].fiWord),
2377 (FiWord *) & (retDataObj->ptr[3].fiWord));
2378
2379 myType = FOAM_NOp;
2380 break;
2381
2382 case FOAM_BVal_DFloAssemble:
2383 (void)fintEval(&expr1);
2384 (void)fintEval(&expr2);
2385 (void)fintEval(&expr3);
2386 (void)fintEval(&expr4);
2387
2388 retDataObj->fiDFlo = fiDFloAssemble((FiBool)expr1.fiBool,
2389 expr2.fiSInt,
2390 expr3.fiWord,
2391 expr4.fiWord);
2392 myType = FOAM_DFlo;
2393 break;
2394
2395 /* -------------------- Operations on BYTE ------------- */
2396
2397 case FOAM_BVal_Byte0:
2398 retDataObj->fiByte = (FiByte) 0;
2399 myType = FOAM_Byte;
2400 break;
2401
2402 case FOAM_BVal_Byte1:
2403 retDataObj->fiByte = (FiByte) 1;
2404 myType = FOAM_Byte;
2405 break;
2406
2407 case FOAM_BVal_ByteMax:
2408 retDataObj->fiByte = fiByteMax();
2409 myType = FOAM_Byte;
2410 break;
2411
2412 case FOAM_BVal_ByteMin:
2413 retDataObj->fiByte = fiByteMin();
2414 myType = FOAM_Byte;
2415 break;
2416
2417 /* -------------------- Operations on WORD ------------- */
2418
2419 case FOAM_BVal_WordTimesDouble:
2420 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
2421
2422 (void)fintEval(&expr1);
2423 (void)fintEval(&expr2);
2424
2425 fiWordTimesDouble(expr1.fiWord, expr2.fiWord,
2426 &expr3.fiWord,&expr4.fiWord);
2427
2428 retDataObj->ptr[0].fiWord = expr3.fiWord;
2429 retDataObj->ptr[1].fiWord = expr4.fiWord;
2430
2431 myType = FOAM_NOp;
2432 break;
2433
2434 case FOAM_BVal_WordDivideDouble:
2435 retDataObj->ptr = fintAlloc(union dataObj, 3)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (3)), 0
, sizeof(union dataObj) * (3)))
;
2436
2437 (void)fintEval(&expr1);
2438 (void)fintEval(&expr2);
2439 (void)fintEval(&expr3);
2440
2441 fiWordDivideDouble(expr1.fiWord, expr2.fiWord, expr3.fiWord,
2442 &expr4.fiWord,&expr5.fiWord,&expr6.fiWord);
2443
2444 retDataObj->ptr[0].fiWord = expr4.fiWord;
2445 retDataObj->ptr[1].fiWord = expr5.fiWord;
2446 retDataObj->ptr[2].fiWord = expr6.fiWord;
2447
2448 myType = FOAM_NOp;
2449 break;
2450
2451 case FOAM_BVal_WordPlusStep:
2452 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
2453
2454 (void)fintEval(&expr1);
2455 (void)fintEval(&expr2);
2456 (void)fintEval(&expr3);
2457
2458 fiWordPlusStep(expr1.fiWord, expr2.fiWord, expr3.fiWord,
2459 &expr4.fiWord,&expr5.fiWord);
2460
2461 retDataObj->ptr[0].fiWord = expr4.fiWord;
2462 retDataObj->ptr[1].fiWord = expr5.fiWord;
2463
2464 myType = FOAM_NOp;
2465 break;
2466
2467 case FOAM_BVal_WordTimesStep:
2468 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
2469
2470 (void)fintEval(&expr1);
2471 (void)fintEval(&expr2);
2472 (void)fintEval(&expr3);
2473 (void)fintEval(&expr4);
2474
2475 fiWordTimesStep(expr1.fiWord, expr2.fiWord, expr3.fiWord,
2476 expr4.fiWord,&expr5.fiWord,&expr6.fiWord);
2477
2478 retDataObj->ptr[0].fiWord = expr5.fiWord;
2479 retDataObj->ptr[1].fiWord = expr6.fiWord;
2480
2481 myType = FOAM_NOp;
2482 break;
2483
2484 /* -------------------- Operations on HINT ------------- */
2485
2486 case FOAM_BVal_HInt0:
2487 retDataObj->fiHInt = (FiHInt) 0;
2488 myType = FOAM_HInt;
2489 break;
2490
2491 case FOAM_BVal_HInt1:
2492 retDataObj->fiHInt = (FiHInt) 1;
2493 myType = FOAM_HInt;
2494 break;
2495
2496 case FOAM_BVal_HIntMax:
2497 retDataObj->fiHInt = fiHIntMax();
2498 myType = FOAM_HInt;
2499 break;
2500
2501 case FOAM_BVal_HIntMin:
2502 retDataObj->fiHInt = fiHIntMin();
2503 myType = FOAM_HInt;
2504 break;
2505
2506 /* -------------------- Operations on SINT ------------- */
2507
2508 case FOAM_BVal_SInt0:
2509 retDataObj->fiSInt = (FiSInt) 0;
2510 myType = FOAM_SInt;
2511 break;
2512
2513 case FOAM_BVal_SInt1:
2514 retDataObj->fiSInt = (FiSInt) 1;
2515 myType = FOAM_SInt;
2516 break;
2517
2518 case FOAM_BVal_SIntMax:
2519 retDataObj->fiSInt = fiSIntMax();
2520 myType = FOAM_SInt;
2521 break;
2522
2523 case FOAM_BVal_SIntMin:
2524 retDataObj->fiSInt = fiSIntMin();
2525 myType = FOAM_SInt;
2526 break;
2527
2528 case FOAM_BVal_SIntIsZero:
2529 (void)fintEval(&expr1);
2530 retDataObj->fiBool = (expr1.fiSInt ? fiFalse((FiBool) 0) : fiTrue((FiBool) 1));
2531 myType = FOAM_Bool;
2532 break;
2533
2534 case FOAM_BVal_SIntIsNeg:
2535 (void)fintEval(&expr1);
2536 retDataObj->fiBool = (expr1.fiSInt < 0 ? fiTrue((FiBool) 1) : fiFalse((FiBool) 0));
2537 myType = FOAM_Bool;
2538 break;
2539
2540 case FOAM_BVal_SIntIsPos:
2541 (void)fintEval(&expr1);
2542 retDataObj->fiBool = (expr1.fiSInt > 0 ? fiTrue((FiBool) 1) : fiFalse((FiBool) 0));
2543 myType = FOAM_Bool;
2544 break;
2545
2546 case FOAM_BVal_SIntIsEven:
2547 (void)fintEval(&expr1);
2548 retDataObj->fiBool = (expr1.fiSInt & 1 ? fiFalse((FiBool) 0) : fiTrue((FiBool) 1));
2549 myType = FOAM_Bool;
2550 break;
2551
2552 case FOAM_BVal_SIntIsOdd:
2553 (void)fintEval(&expr1);
2554 retDataObj->fiBool = (expr1.fiSInt & 1 ? fiTrue((FiBool) 1) : fiFalse((FiBool) 0));
2555 myType = FOAM_Bool;
2556 break;
2557
2558 case FOAM_BVal_SIntEQ:
2559 (void)fintEval(&expr1);
2560 (void)fintEval(&expr2);
2561 retDataObj->fiBool = (expr1.fiSInt == expr2.fiSInt);
2562 myType = FOAM_Bool;
2563 break;
2564
2565 case FOAM_BVal_SIntNE:
2566 (void)fintEval(&expr1);
2567 (void)fintEval(&expr2);
2568 retDataObj->fiBool = (expr1.fiSInt != expr2.fiSInt);
2569 myType = FOAM_Bool;
2570 break;
2571
2572 case FOAM_BVal_SIntLT:
2573 (void)fintEval(&expr1);
2574 (void)fintEval(&expr2);
2575 retDataObj->fiBool = (expr1.fiSInt < expr2.fiSInt);
2576 myType = FOAM_Bool;
2577 break;
2578
2579 case FOAM_BVal_SIntLE:
2580 (void)fintEval(&expr1);
2581 (void)fintEval(&expr2);
2582 retDataObj->fiBool = (expr1.fiSInt <= expr2.fiSInt);
2583 myType = FOAM_Bool;
2584 break;
2585
2586 case FOAM_BVal_SIntNegate:
2587 (void)fintEval(&expr1);
2588 retDataObj->fiSInt = -(expr1.fiSInt);
2589 myType = FOAM_SInt;
2590 break;
2591
2592 case FOAM_BVal_SIntPrev:
2593 (void)fintEval(&expr1);
2594 retDataObj->fiSInt = (expr1.fiSInt - 1);
2595 myType = FOAM_SInt;
2596 break;
2597
2598 case FOAM_BVal_SIntNext:
2599 (void)fintEval(&expr1);
2600 retDataObj->fiSInt = (expr1.fiSInt + 1);
2601 myType = FOAM_SInt;
2602 break;
2603
2604 case FOAM_BVal_SIntPlus:
2605 (void)fintEval(&expr1);
2606 (void)fintEval(&expr2);
2607 retDataObj->fiSInt = (expr1.fiSInt + expr2.fiSInt);
2608 myType = FOAM_SInt;
2609 break;
2610
2611 case FOAM_BVal_SIntMinus:
2612 (void)fintEval(&expr1);
2613 (void)fintEval(&expr2);
2614 retDataObj->fiSInt = (expr1.fiSInt - expr2.fiSInt);
2615 myType = FOAM_SInt;
2616 break;
2617
2618 case FOAM_BVal_SIntTimes:
2619 (void)fintEval(&expr1);
2620 (void)fintEval(&expr2);
2621 retDataObj->fiSInt = (expr1.fiSInt * expr2.fiSInt);
2622 myType = FOAM_SInt;
2623 break;
2624
2625 case FOAM_BVal_SIntTimesPlus:
2626 (void)fintEval(&expr1);
2627 (void)fintEval(&expr2);
2628 (void)fintEval(&expr3);
2629 retDataObj->fiSInt = (expr1.fiSInt * expr2.fiSInt + expr3.fiSInt);
2630 myType = FOAM_SInt;
2631 break;
2632
2633 case FOAM_BVal_SIntMod:
2634 (void)fintEval(&expr1);
2635 (void)fintEval(&expr2);
2636 retDataObj->fiSInt = (expr1.fiSInt % expr2.fiSInt);
2637 myType = FOAM_SInt;
2638 break;
2639
2640 case FOAM_BVal_SIntQuo:
2641 (void)fintEval(&expr1);
2642 (void)fintEval(&expr2);
2643 retDataObj->fiSInt = fiSIntQuo(expr1.fiSInt, expr2.fiSInt)((expr1.fiSInt)/(expr2.fiSInt));
2644 myType = FOAM_SInt;
2645 break;
2646
2647 case FOAM_BVal_SIntRem:
2648 (void)fintEval(&expr1);
2649 (void)fintEval(&expr2);
2650 retDataObj->fiSInt = fiSIntRem(expr1.fiSInt, expr2.fiSInt)((expr1.fiSInt)%(expr2.fiSInt));
2651 myType = FOAM_SInt;
2652 break;
2653
2654 case FOAM_BVal_SIntDivide:
2655 (void)fintEval(&expr1);
2656 (void)fintEval(&expr2);
2657
2658 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
2659 fiSIntDivide(expr1.fiSInt, expr2.fiSInt,
2660 (FiSInt *) & (retDataObj->ptr[0].fiSInt) ,
2661 (FiSInt *) & (retDataObj->ptr[1].fiSInt));
2662
2663 myType = FOAM_NOp;
2664 break;
2665
2666 case FOAM_BVal_SIntGcd:
2667 (void)fintEval(&expr1);
2668 (void)fintEval(&expr2);
2669 retDataObj->fiSInt = fiSIntGcd(expr1.fiSInt, expr2.fiSInt);
2670 myType = FOAM_SInt;
2671 break;
2672
2673/* case FOAM_BVal_SIntPlusMod:
2674 * case FOAM_BVal_SIntMinusMod:
2675 * case FOAM_BVal_SIntTimesMod:
2676 *
2677 * SEE FOAM_BVal_SInt[Plus|Minus|Times]
2678 */
2679
2680 case FOAM_BVal_SIntPlusMod:
2681 (void)fintEval(&expr1);
2682 (void)fintEval(&expr2);
2683 (void)fintEval(&expr3);
2684 retDataObj->fiSInt = (expr1.fiSInt + expr2.fiSInt) % expr3.fiSInt;
2685 myType = FOAM_SInt;
2686 break;
2687
2688 case FOAM_BVal_SIntMinusMod:
2689 (void)fintEval(&expr1);
2690 (void)fintEval(&expr2);
2691 (void)fintEval(&expr3);
2692 retDataObj->fiSInt = (expr1.fiSInt - expr2.fiSInt) % expr3.fiSInt;
2693 myType = FOAM_SInt;
2694 break;
2695
2696 case FOAM_BVal_SIntTimesMod:
2697 (void)fintEval(&expr1);
2698 (void)fintEval(&expr2);
2699 (void)fintEval(&expr3);
2700 retDataObj->fiSInt = (expr1.fiSInt * expr2.fiSInt) % expr3.fiSInt;
2701 myType = FOAM_SInt;
2702 break;
2703
2704 case FOAM_BVal_SIntLength:
2705 (void)fintEval(&expr1);
2706
2707 retDataObj->fiSInt = fiSIntLength(expr1.fiSInt);
2708 myType = FOAM_SInt;
2709 break;
2710
2711 case FOAM_BVal_SIntShiftUp:
2712 (void)fintEval(&expr1);
2713 (void)fintEval(&expr2);
2714 retDataObj->fiSInt = (expr1.fiSInt << expr2.fiSInt);
2715 myType = FOAM_SInt;
2716 break;
2717
2718 case FOAM_BVal_SIntShiftDn:
2719 (void)fintEval(&expr1);
2720 (void)fintEval(&expr2);
2721 retDataObj->fiSInt = (expr1.fiSInt >> expr2.fiSInt);
2722 myType = FOAM_SInt;
2723 break;
2724
2725 case FOAM_BVal_SIntBit:
2726 (void)fintEval(&expr1);
2727 (void)fintEval(&expr2);
2728 retDataObj->fiBool = fiSIntBit(expr1.fiSInt, expr2.fiSInt)(!!((expr1.fiSInt) & (1L << (expr2.fiSInt))));
2729 myType = FOAM_Bool;
2730 break;
2731
2732 case FOAM_BVal_SIntNot:
2733 (void)fintEval(&expr1);
2734
2735 retDataObj->fiSInt = ~(expr1.fiSInt);
2736 myType = FOAM_SInt;
2737 break;
2738
2739 case FOAM_BVal_SIntAnd:
2740 (void)fintEval(&expr1);
2741 (void)fintEval(&expr2);
2742 retDataObj->fiSInt = (expr1.fiSInt & expr2.fiSInt);
2743 myType = FOAM_SInt;
2744 break;
2745
2746 case FOAM_BVal_SIntOr:
2747 (void)fintEval(&expr1);
2748 (void)fintEval(&expr2);
2749 retDataObj->fiSInt = (expr1.fiSInt | expr2.fiSInt);
2750 myType = FOAM_SInt;
2751 break;
2752
2753 case FOAM_BVal_SIntXOr:
2754 (void)fintEval(&expr1);
2755 (void)fintEval(&expr2);
2756 retDataObj->fiSInt = (expr1.fiSInt ^ expr2.fiSInt);
2757 myType = FOAM_SInt;
2758 break;
2759
2760 case FOAM_BVal_SIntHashCombine:
2761 (void)fintEval(&expr1);
2762 (void)fintEval(&expr2);
2763 retDataObj->fiSInt = hashCombinePair(expr1.fiSInt, expr2.fiSInt);
2764 myType = FOAM_SInt;
2765 break;
2766
2767 /* -------------------- Operations on BInt ------------- */
2768
2769 case FOAM_BVal_BInt0:
2770 retDataObj->fiBInt = fiBInt0();
2771 myType = FOAM_BInt;
2772 break;
2773
2774 case FOAM_BVal_BInt1:
2775 retDataObj->fiBInt = fiBInt1();
2776 myType = FOAM_BInt;
2777 break;
2778
2779 case FOAM_BVal_BIntIsZero:
2780 (void)fintEval(&expr1);
2781 retDataObj->fiBool = fiBIntIsZero(expr1.fiBInt);
2782 myType = FOAM_Bool;
2783 break;
2784
2785 case FOAM_BVal_BIntIsNeg:
2786 (void)fintEval(&expr1);
2787 retDataObj->fiBool = fiBIntIsNeg(expr1.fiBInt);
2788 myType = FOAM_Bool;
2789 break;
2790
2791 case FOAM_BVal_BIntIsEven:
2792 (void)fintEval(&expr1);
2793 retDataObj->fiBool = fiBIntEQ(fiBIntMod(expr1.fiBInt, fiBIntNew(2)), fiBInt0());
2794 myType = FOAM_Bool;
2795 break;
2796
2797 case FOAM_BVal_BIntIsOdd:
2798 (void)fintEval(&expr1);
2799 retDataObj->fiBool = fiBIntNE(fiBIntMod(expr1.fiBInt, fiBIntNew(2)), fiBInt0());
2800 myType = FOAM_Bool;
2801 break;
2802
2803 case FOAM_BVal_BIntIsSingle:
2804 (void)fintEval(&expr1);
2805 retDataObj->fiBool = fiBIntIsSingle(expr1.fiBInt);
2806 myType = FOAM_Bool;
2807 break;
2808
2809 case FOAM_BVal_BIntIsPos:
2810 (void)fintEval(&expr1);
2811 retDataObj->fiBool = fiBIntIsPos(expr1.fiBInt);
2812 myType = FOAM_Bool;
2813 break;
2814
2815 case FOAM_BVal_BIntEQ:
2816 (void)fintEval(&expr1);
2817 (void)fintEval(&expr2);
2818 retDataObj->fiBool = fiBIntEQ(expr1.fiBInt, expr2.fiBInt);
2819 myType = FOAM_Bool;
2820 break;
2821
2822 case FOAM_BVal_BIntNE:
2823 (void)fintEval(&expr1);
2824 (void)fintEval(&expr2);
2825 retDataObj->fiBool = fiBIntNE(expr1.fiBInt, expr2.fiBInt);
2826 myType = FOAM_Bool;
2827 break;
2828
2829 case FOAM_BVal_BIntLT:
2830 (void)fintEval(&expr1);
2831 (void)fintEval(&expr2);
2832 retDataObj->fiBool = fiBIntLT(expr1.fiBInt, expr2.fiBInt);
2833 myType = FOAM_Bool;
2834 break;
2835
2836 case FOAM_BVal_BIntLE:
2837 (void)fintEval(&expr1);
2838 (void)fintEval(&expr2);
2839 retDataObj->fiBool = fiBIntLE(expr1.fiBInt, expr2.fiBInt);
2840 myType = FOAM_Bool;
2841 break;
2842
2843 case FOAM_BVal_BIntNegate:
2844 (void)fintEval(&expr1);
2845 retDataObj->fiBInt = fiBIntNegate(expr1.fiBInt);
2846 myType = FOAM_BInt;
2847 break;
2848
2849 case FOAM_BVal_BIntPrev:
2850 (void)fintEval(&expr1);
2851 retDataObj->fiBInt = fiBIntMinus(expr1.fiBInt, fiBInt1());
2852 myType = FOAM_BInt;
2853 break;
2854
2855 case FOAM_BVal_BIntNext:
2856 (void)fintEval(&expr1);
2857 retDataObj->fiBInt = fiBIntPlus(expr1.fiBInt, fiBInt1());
2858 myType = FOAM_BInt;
2859 break;
2860
2861 case FOAM_BVal_BIntPlus:
2862 (void)fintEval(&expr1);
2863 (void)fintEval(&expr2);
2864 retDataObj->fiBInt = fiBIntPlus(expr1.fiBInt, expr2.fiBInt);
2865 myType = FOAM_BInt;
2866 break;
2867
2868 case FOAM_BVal_BIntMinus:
2869 (void)fintEval(&expr1);
2870 (void)fintEval(&expr2);
2871 retDataObj->fiBInt = fiBIntMinus(expr1.fiBInt, expr2.fiBInt);
2872 myType = FOAM_BInt;
2873 break;
2874
2875 case FOAM_BVal_BIntTimes:
2876 (void)fintEval(&expr1);
2877 (void)fintEval(&expr2);
2878 retDataObj->fiBInt = fiBIntTimes(expr1.fiBInt, expr2.fiBInt);
2879 myType = FOAM_BInt;
2880 break;
2881
2882 case FOAM_BVal_BIntTimesPlus:
2883 (void)fintEval(&expr1);
2884 (void)fintEval(&expr2);
2885 (void)fintEval(&expr3);
2886 retDataObj->fiBInt = fiBIntTimesPlus(expr1.fiBInt,
2887 expr2.fiBInt,
2888 expr3.fiBInt);
2889 myType = FOAM_BInt;
2890 break;
2891
2892 case FOAM_BVal_BIntMod:
2893 (void)fintEval(&expr1);
2894 (void)fintEval(&expr2);
2895 retDataObj->fiBInt = fiBIntMod(expr1.fiBInt, expr2.fiBInt);
2896 myType = FOAM_BInt;
2897 break;
2898
2899 case FOAM_BVal_BIntQuo:
2900 (void)fintEval(&expr1);
2901 (void)fintEval(&expr2);
2902 retDataObj->fiBInt = fiBIntQuo(expr1.fiBInt, expr2.fiBInt);
2903 myType = FOAM_BInt;
2904 break;
2905
2906 case FOAM_BVal_BIntRem:
2907 (void)fintEval(&expr1);
2908 (void)fintEval(&expr2);
2909 retDataObj->fiBInt = fiBIntRem(expr1.fiBInt, expr2.fiBInt);
2910 myType = FOAM_BInt;
2911 break;
2912
2913 case FOAM_BVal_BIntDivide:
2914 (void)fintEval(&expr1);
2915 (void)fintEval(&expr2);
2916
2917 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
2918 fiBIntDivide(expr1.fiBInt, expr2.fiBInt,
2919 (FiBInt *) & (retDataObj->ptr[0].fiBInt),
2920 (FiBInt *) & (retDataObj->ptr[1].fiBInt));
2921
2922 myType = FOAM_NOp;
2923 break;
2924
2925 case FOAM_BVal_BIntGcd:
2926 (void)fintEval(&expr1);
2927 (void)fintEval(&expr2);
2928 retDataObj->fiBInt = fiBIntGcd(expr1.fiBInt, expr2.fiBInt);
2929 myType = FOAM_BInt;
2930 break;
2931
2932 case FOAM_BVal_BIntSIPower:
2933 (void)fintEval(&expr1);
2934 (void)fintEval(&expr2);
2935 retDataObj->fiBInt = fiBIntSIPower(expr1.fiBInt, expr2.fiSInt);
2936 myType = FOAM_BInt;
2937 break;
2938
2939 case FOAM_BVal_BIntBIPower:
2940 (void)fintEval(&expr1);
2941 (void)fintEval(&expr2);
2942 retDataObj->fiBInt = fiBIntBIPower(expr1.fiBInt, expr2.fiBInt);
2943 myType = FOAM_BInt;
2944 break;
2945
2946 case FOAM_BVal_BIntPowerMod:
2947 (void)fintEval(&expr1);
2948 (void)fintEval(&expr2);
2949 (void)fintEval(&expr3);
2950 retDataObj->fiBInt = fiBIntPowerMod(expr1.fiBInt,
2951 expr2.fiBInt,
2952 expr3.fiBInt);
2953 myType = FOAM_BInt;
2954 break;
2955
2956 case FOAM_BVal_BIntLength:
2957 (void)fintEval(&expr1);
2958 retDataObj->fiSInt = fiBIntLength(expr1.fiBInt);
2959 myType = FOAM_SInt;
2960 break;
2961
2962 case FOAM_BVal_BIntShiftUp:
2963 (void)fintEval(&expr1);
2964 (void)fintEval(&expr2);
2965 retDataObj->fiBInt = fiBIntShiftUp(expr1.fiBInt, (int)expr2.fiSInt);
2966 myType = FOAM_BInt;
2967 break;
2968
2969 case FOAM_BVal_BIntShiftDn:
2970 (void)fintEval(&expr1);
2971 (void)fintEval(&expr2);
2972 retDataObj->fiBInt = fiBIntShiftDn(expr1.fiBInt, (int)expr2.fiSInt);
2973 myType = FOAM_BInt;
2974 break;
2975
2976 case FOAM_BVal_BIntShiftRem:
2977 (void)fintEval(&expr1);
2978 (void)fintEval(&expr2);
2979 retDataObj->fiBInt = fiBIntShiftRem(expr1.fiBInt, (int)expr2.fiSInt);
2980 myType = FOAM_BInt;
2981 break;
2982
2983 case FOAM_BVal_BIntBit:
2984 (void)fintEval(&expr1);
2985 (void)fintEval(&expr2);
2986 retDataObj->fiBool = fiBIntBit(expr1.fiBInt, expr2.fiSInt);
2987 myType = FOAM_Bool;
2988 break;
2989
2990 /* -------------------- Operations on Ptr ------------- */
2991
2992 case FOAM_BVal_PtrNil:
2993 retDataObj->fiPtr = 0;
2994 myType = FOAM_Ptr;
2995 break;
2996
2997 case FOAM_BVal_PtrIsNil:
2998 (void)fintEval(&expr1);
2999 retDataObj->fiBool = (expr1.fiPtr == 0);
3000 myType = FOAM_Bool;
3001 break;
3002
3003 case FOAM_BVal_PtrMagicEQ:
3004 (void)fintEval(&expr1);
3005 (void)fintEval(&expr2);
3006 retDataObj->fiBool = (expr1.fiPtr == expr2.fiPtr);
3007 myType = FOAM_Bool;
3008 break;
3009
3010 case FOAM_BVal_PtrEQ:
3011 (void)fintEval(&expr1);
3012 (void)fintEval(&expr2);
3013 retDataObj->fiBool = (expr1.fiPtr == expr2.fiPtr);
3014 myType = FOAM_Bool;
3015 break;
3016
3017 case FOAM_BVal_PtrNE:
3018 (void)fintEval(&expr1);
3019 (void)fintEval(&expr2);
3020 retDataObj->fiBool = (expr1.fiPtr != expr2.fiPtr);
3021 myType = FOAM_Bool;
3022 break;
3023
3024 /* -------------------- Text Operations ----------------- */
3025 case FOAM_BVal_FormatSFlo:
3026 (void)fintEval(&expr1);
3027 (void)fintEval(&expr2);
3028 (void)fintEval(&expr3);
3029
3030 retDataObj->fiSInt = fiFormatSFlo(expr1.fiSFlo,
3031 expr2.fiArr, expr3.fiSInt);
3032 myType = FOAM_SInt;
3033 break;
3034
3035 case FOAM_BVal_FormatDFlo:
3036 (void)fintEval(&expr1);
3037 (void)fintEval(&expr2);
3038 (void)fintEval(&expr3);
3039
3040 retDataObj->fiSInt = fiFormatDFlo(expr1.fiDFlo,
3041 expr2.fiArr, expr3.fiSInt);
3042 myType = FOAM_SInt;
3043 break;
3044
3045 case FOAM_BVal_FormatSInt:
3046 (void)fintEval(&expr1);
3047 (void)fintEval(&expr2);
3048 (void)fintEval(&expr3);
3049
3050 retDataObj->fiSInt = fiFormatSInt(expr1.fiSInt,
3051 expr2.fiArr, expr3.fiSInt);
3052 myType = FOAM_SInt;
3053 break;
3054
3055 case FOAM_BVal_FormatBInt:
3056 (void)fintEval(&expr1);
3057 (void)fintEval(&expr2);
3058 (void)fintEval(&expr3);
3059
3060 retDataObj->fiSInt = fiFormatBInt(expr1.fiBInt,
3061 expr2.fiArr, expr3.fiSInt);
3062 myType = FOAM_SInt;
3063 break;
3064
3065 case FOAM_BVal_ScanSFlo:
3066 (void)fintEval(&expr1);
3067 (void)fintEval(&expr2);
3068
3069 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
3070 fiScanSFlo( expr1.fiArr,
3071 (FiSInt) expr2.fiSInt,
3072 (FiSFlo *) & (retDataObj->ptr[0].fiSFlo),
3073 (FiSInt *) & (retDataObj->ptr[1].fiSInt));
3074
3075 myType = FOAM_NOp;
3076 break;
3077
3078 case FOAM_BVal_ScanDFlo:
3079 (void)fintEval(&expr1);
3080 (void)fintEval(&expr2);
3081
3082 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
3083 fiScanDFlo( expr1.fiArr,
3084 (FiSInt) expr2.fiSInt,
3085 (FiDFlo *) & (retDataObj->ptr[0].fiDFlo),
3086 (FiSInt *) & (retDataObj->ptr[1].fiSInt));
3087
3088 myType = FOAM_NOp;
3089 break;
3090
3091 case FOAM_BVal_ScanSInt:
3092 (void)fintEval(&expr1);
3093 (void)fintEval(&expr2);
3094
3095 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
3096 fiScanSInt( expr1.fiArr,
3097 (FiSInt) expr2.fiSInt,
3098 (FiSInt *) & (retDataObj->ptr[0].fiSInt),
3099 (FiSInt *) & (retDataObj->ptr[1].fiSInt));
3100
3101 myType = FOAM_NOp;
3102 break;
3103
3104 case FOAM_BVal_ScanBInt:
3105 (void)fintEval(&expr1);
3106 (void)fintEval(&expr2);
3107
3108 retDataObj->ptr = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
3109 fiScanBInt( expr1.fiArr,
3110 (FiSInt) expr2.fiSInt,
3111 (FiBInt *) & (retDataObj->ptr[0].fiBInt),
3112 (FiSInt *) & (retDataObj->ptr[1].fiSInt));
3113 myType = FOAM_NOp;
3114 break;
3115
3116 /* -------------------- Conversion Operations ------------- */
3117
3118 case FOAM_BVal_SFloToDFlo:
3119 (void)fintEval(&expr1);
3120 retDataObj->fiDFlo = fiSFloToDFlo(expr1.fiSFlo)((FiDFlo)(expr1.fiSFlo));
3121 myType = FOAM_DFlo;
3122 break;
3123
3124 case FOAM_BVal_DFloToSFlo:
3125 (void)fintEval(&expr1);
3126 retDataObj->fiSFlo = fiDFloToSFlo(expr1.fiDFlo)((FiSFlo)(expr1.fiDFlo));
3127 myType = FOAM_SFlo;
3128 break;
3129
3130 case FOAM_BVal_ByteToSInt:
3131 (void)fintEval(&expr1);
3132 retDataObj->fiSInt = fiByteToSInt(expr1.fiByte)((FiSInt)(expr1.fiByte));
3133 myType = FOAM_SInt;
3134 break;
3135
3136 case FOAM_BVal_SIntToByte:
3137 (void)fintEval(&expr1);
3138 retDataObj->fiByte = fiSIntToByte(expr1.fiSInt)((FiByte)(expr1.fiSInt));
3139 myType = FOAM_Byte;
3140 break;
3141
3142 case FOAM_BVal_HIntToSInt:
3143 (void)fintEval(&expr1);
3144 retDataObj->fiSInt = fiHIntToSInt(expr1.fiHInt)((FiSInt)(expr1.fiHInt));
3145 myType = FOAM_SInt;
3146 break;
3147
3148 case FOAM_BVal_SIntToHInt:
3149 (void)fintEval(&expr1);
3150 retDataObj->fiHInt = fiSIntToHInt(expr1.fiSInt)((FiHInt)(expr1.fiSInt));
3151 myType = FOAM_HInt;
3152 break;
3153
3154 case FOAM_BVal_SIntToBInt:
3155 (void)fintEval(&expr1);
3156 retDataObj->fiBInt = fiSIntToBInt(expr1.fiSInt);
3157 myType = FOAM_BInt;
3158 break;
3159
3160 case FOAM_BVal_BIntToSInt:
3161 (void)fintEval(&expr1);
3162 retDataObj->fiSInt = fiBIntToSInt(expr1.fiBInt);
3163 myType = FOAM_SInt;
3164 break;
3165
3166 case FOAM_BVal_SIntToSFlo:
3167 (void)fintEval(&expr1);
3168 retDataObj->fiSFlo = (FiSFlo) expr1.fiSInt;
3169 myType = FOAM_SFlo;
3170 break;
3171
3172 case FOAM_BVal_SIntToDFlo:
3173 (void)fintEval(&expr1);
3174 retDataObj->fiDFlo = (FiDFlo) expr1.fiSInt;
3175 myType = FOAM_DFlo;
3176 break;
3177
3178 case FOAM_BVal_BIntToSFlo:
3179 (void)fintEval(&expr1);
3180 retDataObj->fiSFlo = fiBIntToSFlo(expr1.fiBInt);
3181 myType = FOAM_SFlo;
3182 break;
3183
3184 case FOAM_BVal_BIntToDFlo:
3185 (void)fintEval(&expr1);
3186 retDataObj->fiDFlo = fiBIntToDFlo(expr1.fiBInt);
3187 myType = FOAM_DFlo;
3188 break;
3189
3190 case FOAM_BVal_PtrToSInt:
3191 (void)fintEval(&expr1);
3192 retDataObj->fiSInt = fiPtrToSInt(expr1.fiPtr)((FiSInt)(expr1.fiPtr));
3193 myType = FOAM_SInt;
3194 break;
3195
3196 case FOAM_BVal_SIntToPtr:
3197 (void)fintEval(&expr1);
3198 retDataObj->fiPtr = fiSIntToPtr(expr1.fiSInt)((FiPtr) (expr1.fiSInt));
3199 myType = FOAM_Ptr;
3200 break;
3201
3202 case FOAM_BVal_ArrToSFlo:
3203 (void)fintEval(&expr1);
3204 retDataObj->fiSFlo = fiArrToSFlo((FiArr) expr1.fiArr);
3205 myType = FOAM_SFlo;
3206 break;
3207
3208 case FOAM_BVal_ArrToDFlo:
3209 (void)fintEval(&expr1);
3210 retDataObj->fiDFlo = fiArrToDFlo((FiArr) expr1.fiArr);
3211 myType = FOAM_DFlo;
3212 break;
3213
3214 case FOAM_BVal_ArrToSInt:
3215 (void)fintEval(&expr1);
3216 retDataObj->fiSInt = fiArrToSInt(expr1.fiArr);
3217 myType = FOAM_SInt;
3218 break;
3219
3220 case FOAM_BVal_ArrToBInt:
3221 (void)fintEval(&expr1);
3222 retDataObj->fiBInt = fiArrToBInt(expr1.fiArr);
3223 myType = FOAM_BInt;
3224 break;
3225
3226 /* ---------------- Platform specific operations ------------- */
3227
3228 case FOAM_BVal_PlatformRTE:
3229 retDataObj->fiSInt = fiPlatformRTE();
3230 myType = FOAM_SInt;
3231 break;
3232
3233 case FOAM_BVal_PlatformOS:
3234 retDataObj->fiSInt = fiPlatformOS();
3235 myType = FOAM_SInt;
3236 break;
3237
3238 case FOAM_BVal_Halt:
3239
3240 (void)fintEval(&expr1);
3241 fintWhere(0);
3242 switch ((int)expr1.fiSInt) {
3243 case FOAM_Halt_BadDependentType:
3244 fiRaiseException((FiWord)"(Aldor error) Bad use of a dependent type");
3245 break;
3246 case FOAM_Halt_NeverReached:
3247 fiRaiseException((FiWord)"(Aldor error) Reached a \"never\"");
3248 break;
3249 case FOAM_Halt_BadUnionCase:
3250 fiRaiseException((FiWord)"(Aldor error) Bad union branch.");
3251 break;
3252 case FOAM_Halt_AssertFailed:
3253 fiRaiseException((FiWord)"(Aldor error) Assertion failed.");
3254 break;
3255 case FOAM_Halt_BadFortranRecursion:
3256 fiRaiseException((FiWord)"(Aldor error) Bad Fortran recursion.");
3257 break;
3258 case FOAM_Halt_BadPointerWrite:
3259 fiRaiseException((FiWord)"(Aldor error) Write to invalid pointer (read-only?).");
3260 break;
3261 default:
3262 fiRaiseException((FiWord)"(Aldor error) Halt");
3263 break;
3264 }
3265 LongJmp(fintJmpBuf, 1){ fluidUnwind((fintJmpBuf).fluidLevel, 1); longjmp((fintJmpBuf
).buf, 1);; }
;
3266
3267 myType = FOAM_Nil;
3268 break;
3269
3270 /* ----------------- Store manager operations ------------- */
3271
3272 case FOAM_BVal_StoForceGC:
3273 fiStoForceGC();
3274 retDataObj->fiPtr = 0; /* Hopefully never used */
3275 myType = FOAM_NOp;
3276 break;
3277
3278 case FOAM_BVal_StoInHeap:
3279 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3279); } while (0); }
;
3280 retDataObj->fiBool = fiStoInHeap(expr1.fiPtr);
3281 myType = FOAM_Bool;
3282 break;
3283
3284 case FOAM_BVal_StoIsWritable:
3285 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3285); } while (0); }
;
3286 retDataObj->fiSInt = fiStoIsWritable(expr1.fiPtr);
3287 myType = FOAM_SInt;
3288 break;
3289
3290 case FOAM_BVal_StoMarkObject:
3291 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3291); } while (0); }
;
3292 retDataObj->fiSInt = fiStoMarkObject(expr1.fiPtr);
3293 myType = FOAM_SInt;
3294 break;
3295
3296 case FOAM_BVal_StoRecode:
3297 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3297); } while (0); }
;
3298 fintTypedEval(&expr2, FOAM_SInt){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3298); } while (0); }
;
3299 retDataObj->fiWord = fiStoRecode(expr1.fiPtr, expr2.fiSInt);
3300 myType = FOAM_Word;
3301 break;
3302
3303 case FOAM_BVal_StoNewObject:
3304 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3304); } while (0); }
;
3305 fintTypedEval(&expr2, FOAM_Bool){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Bool
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Bool || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3305); } while (0); }
;
3306 fiStoNewObject(expr1.fiSInt, expr2.fiBool);
3307 retDataObj->fiPtr = 0; /* Hopefully never used */
3308 myType = FOAM_NOp;
3309 break;
3310
3311 case FOAM_BVal_StoATracer:
3312 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3312); } while (0); }
;
3313 fintTypedEval(&expr2, FOAM_Clos){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Clos
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Clos || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3313); } while (0); }
;
3314 fiStoATracer(expr1.fiSInt, expr2.fiClos);
3315 retDataObj->fiPtr = 0; /* Hopefully never used */
3316 myType = FOAM_NOp;
3317 break;
3318
3319 case FOAM_BVal_StoCTracer:
3320 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3320); } while (0); }
;
3321 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3321); } while (0); }
;
3322 fiStoATracer(expr1.fiSInt, (FiClos) expr2.fiWord);
3323 retDataObj->fiPtr = 0; /* Hopefully never used */
3324 myType = FOAM_NOp;
3325 break;
3326
3327 case FOAM_BVal_StoShow:
3328 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3328); } while (0); }
;
3329 fiStoShow(expr1.fiSInt);
3330 retDataObj->fiPtr = 0; /* Hopefully never used */
3331 myType = FOAM_NOp;
3332 break;
3333
3334 case FOAM_BVal_StoShowArgs:
3335 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3335); } while (0); }
;
3336 retDataObj->fiSInt = fiStoShowArgs(expr1.fiPtr);
3337 myType = FOAM_SInt;
3338 break;
3339
3340 /* --------------------- Raw type tags ------------------ */
3341
3342 case FOAM_BVal_TypeInt8:
3343 retDataObj->fiSInt = fiTypeInt8()(-1);
3344 myType = FOAM_SInt;
3345 break;
3346
3347 case FOAM_BVal_TypeInt16:
3348 retDataObj->fiSInt = fiTypeInt16()(-2);
3349 myType = FOAM_SInt;
3350 break;
3351
3352 case FOAM_BVal_TypeInt32:
3353 retDataObj->fiSInt = fiTypeInt32()(-3);
3354 myType = FOAM_SInt;
3355 break;
3356
3357 case FOAM_BVal_TypeInt64:
3358 retDataObj->fiSInt = fiTypeInt64()(-4);
3359 myType = FOAM_SInt;
3360 break;
3361
3362 case FOAM_BVal_TypeInt128:
3363 retDataObj->fiSInt = fiTypeInt128()(-5);
3364 myType = FOAM_SInt;
3365 break;
3366
3367 case FOAM_BVal_TypeNil:
3368 retDataObj->fiSInt = fiTypeNil()( 0);
3369 myType = FOAM_SInt;
3370 break;
3371
3372 case FOAM_BVal_TypeChar:
3373 retDataObj->fiSInt = fiTypeChar()( 1);
3374 myType = FOAM_SInt;
3375 break;
3376
3377 case FOAM_BVal_TypeBool:
3378 retDataObj->fiSInt = fiTypeBool()( 2);
3379 myType = FOAM_SInt;
3380 break;
3381
3382 case FOAM_BVal_TypeByte:
3383 retDataObj->fiSInt = fiTypeByte()( 3);
3384 myType = FOAM_SInt;
3385 break;
3386
3387 case FOAM_BVal_TypeHInt:
3388 retDataObj->fiSInt = fiTypeHInt()( 4);
3389 myType = FOAM_SInt;
3390 break;
3391
3392 case FOAM_BVal_TypeSInt:
3393 retDataObj->fiSInt = fiTypeSInt()( 5);
3394 myType = FOAM_SInt;
3395 break;
3396
3397 case FOAM_BVal_TypeBInt:
3398 retDataObj->fiSInt = fiTypeBInt()( 6);
3399 myType = FOAM_SInt;
3400 break;
3401
3402 case FOAM_BVal_TypeSFlo:
3403 retDataObj->fiSInt = fiTypeSFlo()( 7);
3404 myType = FOAM_SInt;
3405 break;
3406
3407 case FOAM_BVal_TypeDFlo:
3408 retDataObj->fiSInt = fiTypeDFlo()( 8);
3409 myType = FOAM_SInt;
3410 break;
3411
3412 case FOAM_BVal_TypeWord:
3413 retDataObj->fiSInt = fiTypeWord()( 9);
3414 myType = FOAM_SInt;
3415 break;
3416
3417 case FOAM_BVal_TypeClos:
3418 retDataObj->fiSInt = fiTypeClos()(10);
3419 myType = FOAM_SInt;
3420 break;
3421
3422 case FOAM_BVal_TypePtr:
3423 retDataObj->fiSInt = fiTypePtr()(11);
3424 myType = FOAM_SInt;
3425 break;
3426
3427 case FOAM_BVal_TypeRec:
3428 retDataObj->fiSInt = fiTypeRec()(12);
3429 myType = FOAM_SInt;
3430 break;
3431
3432 case FOAM_BVal_TypeArr:
3433 retDataObj->fiSInt = fiTypeArr()(14);
3434 myType = FOAM_SInt;
3435 break;
3436
3437 case FOAM_BVal_TypeTR:
3438 retDataObj->fiSInt = fiTypeTR()(15);
3439 myType = FOAM_SInt;
3440 break;
3441
3442 case FOAM_BVal_SizeOfInt8:
3443 retDataObj->fiSInt = fiSizeOfInt8()1;
3444 myType = FOAM_SInt;
3445 break;
3446
3447 case FOAM_BVal_SizeOfInt16:
3448 retDataObj->fiSInt = fiSizeOfInt16()2;
3449 myType = FOAM_SInt;
3450 break;
3451
3452 case FOAM_BVal_SizeOfInt32:
3453 retDataObj->fiSInt = fiSizeOfInt32()4;
3454 myType = FOAM_SInt;
3455 break;
3456
3457 case FOAM_BVal_SizeOfInt64:
3458 retDataObj->fiSInt = fiSizeOfInt64()8;
3459 myType = FOAM_SInt;
3460 break;
3461
3462 case FOAM_BVal_SizeOfInt128:
3463 retDataObj->fiSInt = fiSizeOfInt128()16;
3464 myType = FOAM_SInt;
3465 break;
3466
3467 case FOAM_BVal_SizeOfNil:
3468 retDataObj->fiSInt = fiSizeOfNil()sizeof(FiNil);
3469 myType = FOAM_SInt;
3470 break;
3471
3472 case FOAM_BVal_SizeOfChar:
3473 retDataObj->fiSInt = fiSizeOfChar()sizeof(FiChar);
3474 myType = FOAM_SInt;
3475 break;
3476
3477 case FOAM_BVal_SizeOfBool:
3478 retDataObj->fiSInt = fiSizeOfBool()sizeof(FiBool);
3479 myType = FOAM_SInt;
3480 break;
3481
3482 case FOAM_BVal_SizeOfByte:
3483 retDataObj->fiSInt = fiSizeOfByte()sizeof(FiByte);
3484 myType = FOAM_SInt;
3485 break;
3486
3487 case FOAM_BVal_SizeOfHInt:
3488 retDataObj->fiSInt = fiSizeOfHInt()sizeof(FiHInt);
3489 myType = FOAM_SInt;
3490 break;
3491
3492 case FOAM_BVal_SizeOfSInt:
3493 retDataObj->fiSInt = fiSizeOfSInt()sizeof(FiSInt);
3494 myType = FOAM_SInt;
3495 break;
3496
3497 case FOAM_BVal_SizeOfBInt:
3498 retDataObj->fiSInt = fiSizeOfBInt()sizeof(FiBInt);
3499 myType = FOAM_SInt;
3500 break;
3501
3502 case FOAM_BVal_SizeOfSFlo:
3503 retDataObj->fiSInt = fiSizeOfSFlo()sizeof(FiSFlo);
3504 myType = FOAM_SInt;
3505 break;
3506
3507 case FOAM_BVal_SizeOfDFlo:
3508 retDataObj->fiSInt = fiSizeOfDFlo()sizeof(FiDFlo);
3509 myType = FOAM_SInt;
3510 break;
3511
3512 case FOAM_BVal_SizeOfWord:
3513 retDataObj->fiSInt = fiSizeOfWord()sizeof(FiWord);
3514 myType = FOAM_SInt;
3515 break;
3516
3517 case FOAM_BVal_SizeOfClos:
3518 retDataObj->fiSInt = fiSizeOfClos()sizeof(FiClos);
3519 myType = FOAM_SInt;
3520 break;
3521
3522 case FOAM_BVal_SizeOfPtr:
3523 retDataObj->fiSInt = fiSizeOfPtr()sizeof(FiPtr);
3524 myType = FOAM_SInt;
3525 break;
3526
3527 case FOAM_BVal_SizeOfRec:
3528 retDataObj->fiSInt = fiSizeOfRec()sizeof(FiRec);
3529 myType = FOAM_SInt;
3530 break;
3531
3532 case FOAM_BVal_SizeOfArr:
3533 retDataObj->fiSInt = fiSizeOfArr()sizeof(FiArr);
3534 myType = FOAM_SInt;
3535 break;
3536
3537 case FOAM_BVal_SizeOfTR:
3538 retDataObj->fiSInt = fiSizeOfTR()sizeof(FiTR);
3539 myType = FOAM_SInt;
3540 break;
3541
3542 /* ----------------- Linked list operations ------------- */
3543
3544 case FOAM_BVal_ListNil:
3545 retDataObj->fiPtr = fiListNil();
3546 myType = FOAM_Ptr;
3547 break;
3548
3549 case FOAM_BVal_ListEmptyP:
3550 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3550); } while (0); }
;
3551 retDataObj->fiBool = fiListEmptyP(expr1.fiPtr);
3552 myType = FOAM_Bool;
3553 break;
3554
3555 case FOAM_BVal_ListHead:
3556 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3556); } while (0); }
;
3557 retDataObj->fiWord = fiListHead(expr1.fiPtr);
3558 myType = FOAM_Word;
3559 break;
3560
3561 case FOAM_BVal_ListTail:
3562 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3562); } while (0); }
;
3563 retDataObj->fiPtr = fiListTail(expr1.fiPtr);
3564 myType = FOAM_Ptr;
3565 break;
3566
3567 case FOAM_BVal_ListCons:
3568 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3568); } while (0); }
;
3569 fintTypedEval(&expr2, FOAM_Ptr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3569); } while (0); }
;
3570 retDataObj->fiPtr = fiListCons(expr1.fiWord, expr2.fiPtr);
3571 myType = FOAM_Ptr;
3572 break;
3573
3574 default:
3575 bug("BCall: %s (<%s> in [%s]) unimplemented...\n",
3576 foamBValInfo(call)(foamBValInfoTable[(int)(call)-(int)FOAM_BVAL_START]).str, prog->name, prog->unit->name);
3577 NotReached(myType = FOAM_Nil){(void)bug("Not supposed to reach line %d in file: %s\n",3577
, "fint.c");}
;
3578 }
3579
3580 return myType;
3581
3582 /**************************** END OF BCALL ***************************/
3583}
3584
3585/* Execute the program inside the current tape in the environment related to
3586 * unit.
3587 * the return value is the type of the evaluated expression,
3588 * retDataObj is a pointer to the value
3589 */
3590
3591localstatic dataType fintEval_(DataObj retDataObj);
3592localstatic dataType
3593fintEval(DataObj retDataObj)
3594{
3595 dataType d;
3596 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "(fintEval:\n");
3597 d = fintEval_(retDataObj);
3598 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, " fintEval)");
3599
3600 return d;
3601}
3602
3603localstatic dataType
3604fintEval_(DataObj retDataObj)
3605{
3606 extern int isatty(int);
3607 int fmt, tag, argc;
3608 long n;
3609 union dataObj expr;
3610 dataType type, myType = FOAM_NOp;
3611
3612 fintGetTagFmtArgc(tag, fmt, argc){ { (((tag)) = tape[ip++]); (fmt) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fmt)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fmt) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
3613
3614 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "fintEval: %s\n", foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).str);
3615
3616 switch (tag) {
3617
3618 case FOAM_EEnsure:
3619 case FOAM_OCall:
3620 case FOAM_CCall: {
3621 union dataObj par;
3622 dataType retType;
3623 UByte denv;
3624 ProgInfo prog0;
3625 FiEnv env;
3626
3627 DataObj sp0;
3628 DataObj oldStack;
3629 int nFluids;
3630
3631 /* This is a bad place for this, but f. call seems to
3632 * be a horrendous operation
3633 */
3634 if (tag == FOAM_EEnsure) {
3635 retType = FOAM_NOp;
3636 fintTypedEval(&expr, FOAM_Env){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3636); } while (0); }
;
3637 if ((FiEnv)(expr.fiEnv->info) == (FiEnv) NULL((void*)0)) {
3638 myType = FOAM_NOp;
3639 return myType;
3640 }
3641 prog0 = (ProgInfo)((FiClos) expr.fiEnv->info)->prog;
3642 env = ((FiClos) expr.fiEnv->info)->env;
3643 argc = 0;
3644 }
3645 else if (tag == FOAM_CCall) {
3646 fintGetByte(retType)((retType) = tape[ip++]); /* return type */
3647 type = fintEval(&expr);
3648 hardAssert(type == FOAM_Clos || type == FOAM_Word)do { if (!(type == FOAM_Clos || type == FOAM_Word)) fintHardAssert
("type == FOAM_Clos || type == FOAM_Word", "fint.c", 3648); }
while (0)
;
3649 hardAssert(expr.fiClos != NULL)do { if (!(expr.fiClos != ((void*)0))) fintHardAssert("expr.fiClos != NULL"
, "fint.c", 3649); } while (0)
;
3650 prog0 = (ProgInfo) expr.fiClos->prog;
3651 env = expr.fiClos->env;
3652 argc -= 2;
3653 }
3654 else {
3655 fintGetByte(retType)((retType) = tape[ip++]); /* return type */
3656 fintTypedEval(&expr, FOAM_Prog){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Prog
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Prog || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3656); } while (0); }
;
3657 prog0 = expr.progInfo;
3658 fintTypedEval(&expr, FOAM_Env){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3658); } while (0); }
;
3659 env = expr.fiEnv;
3660 argc -= 3;
3661 }
3662
3663 hardAssert(argc >= 0)do { if (!(argc >= 0)) fintHardAssert("argc >= 0", "fint.c"
, 3663); } while (0)
;
3664
3665
3666 stackAlloc(sp0, argc + PAR_OFFSET){ if (sp + argc + 10 >= stack + 3000 - 11) stackChain(argc
+ 10); (sp0) = sp; sp += (argc + 10); }
;
3667 oldStack = stack;
3668
3669 if (DEBUG(fint)fintDebug) {
3670 fintCheckCallStack();
3671 }
3672
3673 for (n = 0; n < argc; n++) {
3674 type = fintEval(&par);
3675 fintSet(type, sp0 + n + PAR_OFFSET, par){ do { if (!(sp0 + n + 10 != ((void*)0))) _do_assert(("sp0 + n + 10 != NULL"
),"fint.c",3675); } while (0); switch ((int)type) { case FOAM_Char
: *(FiChar *)(sp0 + n + 10) = (par).fiChar; break; case FOAM_Bool
: (sp0 + n + 10)->fiBool = (par).fiBool; break; case FOAM_Byte
: (sp0 + n + 10)->fiByte = (par).fiByte; break; case FOAM_HInt
: (sp0 + n + 10)->fiHInt = (par).fiHInt; break; case FOAM_SInt
: (sp0 + n + 10)->fiSInt = (par).fiSInt; break; case FOAM_SFlo
: (sp0 + n + 10)->fiSFlo = (par).fiSFlo; break; case FOAM_DFlo
: (sp0 + n + 10)->fiDFlo = (par).fiDFlo; break; case FOAM_Word
: (sp0 + n + 10)->fiWord = (par).fiWord; break; case FOAM_Arb
: (sp0 + n + 10)->fiArb = (par).fiArb; break; case FOAM_Ptr
: (sp0 + n + 10)->fiPtr = (par).fiPtr; break; case FOAM_Rec
: (sp0 + n + 10)->fiRec = (par).fiRec; break; case FOAM_Arr
: (sp0 + n + 10)->fiArr = (par).fiArr; break; case FOAM_TR
: (sp0 + n + 10)->fiTR = (par).fiTR; break; case FOAM_Prog
: (sp0 + n + 10)->fiProgPos=(par).fiProgPos; break; case FOAM_Clos
: (sp0 + n + 10)->fiClos = (par).fiClos; break; case FOAM_Gener
: (sp0 + n + 10)->fiGener = (par).fiGener; break; case FOAM_GenIter
: (sp0 + n + 10)->fiGenIter = (par).fiGenIter; break; case
FOAM_Env: (sp0 + n + 10)->fiEnv = (par).fiEnv; break; case
FOAM_NOp: fintSetMFmt((sp0 + n + 10), &(par)); break; case
FOAM_Nil: (sp0 + n + 10)->_fiNil = (par)._fiNil; break; case
FOAM_BInt: (sp0 + n + 10)->fiBInt = (Ptr) (bintCopy((BInt
) (par).fiBInt)); break; default: fintWhere(((int) 0));bug("fintSet: type %d unimplemented."
, (int)type); } }
;
3676 }
3677
3678 sp = sp0;
3679 stack = oldStack;
3680
3681 stackFrameAlloc(argc){ if (sp + 10 + argc >= stack + 3000 - 11) stackChain(argc
+10); sp->ptr = bp; bp = sp; sp += 2; (sp++)->labels = labels
; (sp++)->fiChar = (char) labelFmt; (sp++)->ptr = locValues
; (sp++)->fiEnv = lexEnv; (sp++)->progInfo = prog; (sp++
)->fiUnit = unit; (sp++)->ptr = fluidValues; (sp++)->
fiGenIter = currGenIter; sp += argc + 1; }
; /* creates a frame for argc param. */
3682
3683 hardAssert(sp < stack + STACK_SIZE + 1)do { if (!(sp < stack + 3000 + 1)) fintHardAssert("sp < stack + STACK_SIZE + 1"
, "fint.c", 3683); } while (0)
;
3684
3685 if (DEBUG(fint)fintDebug) {
3686 int k;
3687 fprintf(dbOut, "((%s ", foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).str);
3688 (void)fprintf(dbOut, "to %s in %s with par: ",
3689 prog0->name,
3690 prog0->unit->name);
3691 for (k = 0; k < argc; k++)
3692 (void)fprintf(dbOut, "%p ", (void *) parValue(k)(bp[(k)+10]).fiPtr);
3693 (void)fprintf(dbOut, ")\n");
3694 }
3695
3696 stackFrameIp(bp)((bp)[1].fiProgPos) = ip;
3697
3698 /* set globals and env for the call */
3699 prog = prog0;
3700 unit = prog->unit;
3701 tape = fintUnitTape(unit)((unit)->tape);
3702 labels = progInfoLabels(prog)((prog)->labels);
3703 labelFmt = progInfoLabelFmt(prog)((prog)->labelFmt);
3704 ip = progInfoSeq(prog)((prog)->fiProgPos);
3705
3706 if (progInfoLocsCount(prog)((prog)->locsCount))
3707 stackAlloc(locValues, progInfoLocsCount(prog)){ if (sp + ((prog)->locsCount) >= stack + 3000 - 11) stackChain
(((prog)->locsCount)); (locValues) = sp; sp += (((prog)->
locsCount)); }
;
3708
3709 nFluids = progInfoDFluidsCount(prog)((prog)->dfluidsCount);
3710
3711 if (nFluids)
3712 fintPushFluids(nFluids);
3713
3714 denv = progInfoDEnv(prog)((prog)->denv)[0];
3715
3716 if (fintUnitLexsCount(unit, denv)(((unit)->lexLevels[(denv)]).fmtLexsCount)) {
3717 lev0 = fintAlloc(union dataObj,((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(denv)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(denv)]).fmtLexsCount))))
3718 fintUnitLexsCount(unit, denv))((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(denv)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(denv)]).fmtLexsCount))))
;
3719 }
3720 else
3721 lev0 = NULL((void*)0);
3722
3723 fintEnvPush(lexEnv, lev0, env){ lexEnv = (FiEnv) ((DataObj) memset(stoAlloc(0, sizeof(struct
_FiEnv) * (1)), 0, sizeof(struct _FiEnv) * (1))); lexEnv->
level = (Ptr) lev0; lexEnv->next = (env); lexEnv->info =
(FiWord) ((void*)0); }
;
3724
3725 (void)fintStmt(retDataObj);
3726 softAssert(retType == progInfoRetType(prog))do { if (fintSoftAssertIsOn && !(retType == ((prog)->
retType))) fintSoftAssert("retType == progInfoRetType(prog)",
"fint.c", 3726); } while (0)
;
3727
3728 if (DEBUG(fint)fintDebug) {
3729 fintCheckCallStack();
3730 }
3731
3732 if (nFluids)
3733 fiGlobalFluidStack =
3734 (FiFluidStack) fluidValue(nFluids)(fluidValues[(nFluids)].fiFluid);
3735
3736 stackFrameFree(){ ip = bp[1].fiProgPos; labels = bp[2].labels; labelFmt = (int
) bp[3].fiChar; locValues = bp[4].ptr; lexEnv = bp[5].fiEnv; prog
= bp[6].progInfo; unit = bp[7].fiUnit; fluidValues = bp[8].ptr
; currGenIter = bp[9].fiGenIter; tape = ((unit)->tape); if
(bp < stack || bp >= stack + 3000) { sp = stack[1].ptr
; stack = stack[0].ptr; } else sp = bp; bp = bp->ptr; lev0
= (DataObj) lexEnv->level; }
;
3737 if (DEBUG(fint)fintDebug) {
3738 fintCheckCallStack();
3739 }
3740 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, " call returns %p)", (char*) retDataObj->fiSInt);
3741
3742 return retType;
3743 }
3744
3745 case FOAM_Glo:
3746 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3747
3748 hardAssert(n < fintUnitGlobsCount(unit))do { if (!(n < ((unit)->globsCount))) fintHardAssert("n < fintUnitGlobsCount(unit)"
, "fint.c", 3748); } while (0)
;
3749
3750 fintSet(globType(n), retDataObj, globValue(n)){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",3750); } while (0); switch ((int)((((unit)->fmtGlobs
)[(n)]).type)) { case FOAM_Char: *(FiChar *)(retDataObj) = ((
((unit)->globValues[(n)])->dataObj)).fiChar; break; case
FOAM_Bool: (retDataObj)->fiBool = ((((unit)->globValues
[(n)])->dataObj)).fiBool; break; case FOAM_Byte: (retDataObj
)->fiByte = ((((unit)->globValues[(n)])->dataObj)).fiByte
; break; case FOAM_HInt: (retDataObj)->fiHInt = ((((unit)->
globValues[(n)])->dataObj)).fiHInt; break; case FOAM_SInt:
(retDataObj)->fiSInt = ((((unit)->globValues[(n)])->
dataObj)).fiSInt; break; case FOAM_SFlo: (retDataObj)->fiSFlo
= ((((unit)->globValues[(n)])->dataObj)).fiSFlo; break
; case FOAM_DFlo: (retDataObj)->fiDFlo = ((((unit)->globValues
[(n)])->dataObj)).fiDFlo; break; case FOAM_Word: (retDataObj
)->fiWord = ((((unit)->globValues[(n)])->dataObj)).fiWord
; break; case FOAM_Arb: (retDataObj)->fiArb = ((((unit)->
globValues[(n)])->dataObj)).fiArb; break; case FOAM_Ptr: (
retDataObj)->fiPtr = ((((unit)->globValues[(n)])->dataObj
)).fiPtr; break; case FOAM_Rec: (retDataObj)->fiRec = ((((
unit)->globValues[(n)])->dataObj)).fiRec; break; case FOAM_Arr
: (retDataObj)->fiArr = ((((unit)->globValues[(n)])->
dataObj)).fiArr; break; case FOAM_TR: (retDataObj)->fiTR =
((((unit)->globValues[(n)])->dataObj)).fiTR; break; case
FOAM_Prog: (retDataObj)->fiProgPos=((((unit)->globValues
[(n)])->dataObj)).fiProgPos; break; case FOAM_Clos: (retDataObj
)->fiClos = ((((unit)->globValues[(n)])->dataObj)).fiClos
; break; case FOAM_Gener: (retDataObj)->fiGener = ((((unit
)->globValues[(n)])->dataObj)).fiGener; break; case FOAM_GenIter
: (retDataObj)->fiGenIter = ((((unit)->globValues[(n)])
->dataObj)).fiGenIter; break; case FOAM_Env: (retDataObj)->
fiEnv = ((((unit)->globValues[(n)])->dataObj)).fiEnv; break
; case FOAM_NOp: fintSetMFmt((retDataObj), &((((unit)->
globValues[(n)])->dataObj))); break; case FOAM_Nil: (retDataObj
)->_fiNil = ((((unit)->globValues[(n)])->dataObj))._fiNil
; break; case FOAM_BInt: (retDataObj)->fiBInt = (Ptr) (bintCopy
((BInt) ((((unit)->globValues[(n)])->dataObj)).fiBInt))
; break; default: fintWhere(((int) 0));bug("fintSet: type %d unimplemented."
, (int)((((unit)->fmtGlobs)[(n)]).type)); } }
;
3751
3752 myType = globType(n)((((unit)->fmtGlobs)[(n)]).type);
3753
3754 return myType;
3755
3756 case FOAM_Loc:
3757 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3758
3759 hardAssert(progInfoFmtLoc(prog))do { if (!(((prog)->fmtLoc))) fintHardAssert("progInfoFmtLoc(prog)"
, "fint.c", 3759); } while (0)
;
3760 hardAssert(n < progInfoLocsCount(prog))do { if (!(n < ((prog)->locsCount))) fintHardAssert("n < progInfoLocsCount(prog)"
, "fint.c", 3760); } while (0)
;
3761
3762 fintSet(locType(n), retDataObj, locValue(n)){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",3762); } while (0); switch ((int)(((prog)->fmtLoc
)[(n)].type)) { case FOAM_Char: *(FiChar *)(retDataObj) = ((locValues
[(n)])).fiChar; break; case FOAM_Bool: (retDataObj)->fiBool
= ((locValues[(n)])).fiBool; break; case FOAM_Byte: (retDataObj
)->fiByte = ((locValues[(n)])).fiByte; break; case FOAM_HInt
: (retDataObj)->fiHInt = ((locValues[(n)])).fiHInt; break;
case FOAM_SInt: (retDataObj)->fiSInt = ((locValues[(n)]))
.fiSInt; break; case FOAM_SFlo: (retDataObj)->fiSFlo = ((locValues
[(n)])).fiSFlo; break; case FOAM_DFlo: (retDataObj)->fiDFlo
= ((locValues[(n)])).fiDFlo; break; case FOAM_Word: (retDataObj
)->fiWord = ((locValues[(n)])).fiWord; break; case FOAM_Arb
: (retDataObj)->fiArb = ((locValues[(n)])).fiArb; break; case
FOAM_Ptr: (retDataObj)->fiPtr = ((locValues[(n)])).fiPtr;
break; case FOAM_Rec: (retDataObj)->fiRec = ((locValues[(
n)])).fiRec; break; case FOAM_Arr: (retDataObj)->fiArr = (
(locValues[(n)])).fiArr; break; case FOAM_TR: (retDataObj)->
fiTR = ((locValues[(n)])).fiTR; break; case FOAM_Prog: (retDataObj
)->fiProgPos=((locValues[(n)])).fiProgPos; break; case FOAM_Clos
: (retDataObj)->fiClos = ((locValues[(n)])).fiClos; break;
case FOAM_Gener: (retDataObj)->fiGener = ((locValues[(n)]
)).fiGener; break; case FOAM_GenIter: (retDataObj)->fiGenIter
= ((locValues[(n)])).fiGenIter; break; case FOAM_Env: (retDataObj
)->fiEnv = ((locValues[(n)])).fiEnv; break; case FOAM_NOp:
fintSetMFmt((retDataObj), &((locValues[(n)]))); break; case
FOAM_Nil: (retDataObj)->_fiNil = ((locValues[(n)]))._fiNil
; break; case FOAM_BInt: (retDataObj)->fiBInt = (Ptr) (bintCopy
((BInt) ((locValues[(n)])).fiBInt)); break; default: fintWhere
(((int) 0));bug("fintSet: type %d unimplemented.", (int)(((prog
)->fmtLoc)[(n)].type)); } }
;
3763
3764 myType = locType(n)(((prog)->fmtLoc)[(n)].type);
3765
3766 return myType;
3767
3768 case FOAM_Par:
3769 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3770
3771 hardAssert(progInfoFmtPar(prog))do { if (!(((prog)->fmtPar))) fintHardAssert("progInfoFmtPar(prog)"
, "fint.c", 3771); } while (0)
;
3772 hardAssert(n < progInfoParsCount(prog))do { if (!(n < ((prog)->parsCount))) fintHardAssert("n < progInfoParsCount(prog)"
, "fint.c", 3772); } while (0)
;
3773
3774 fintSet(parType(n), retDataObj, parValue(n)){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",3774); } while (0); switch ((int)(((prog)->fmtPar
)[(n)].type)) { case FOAM_Char: *(FiChar *)(retDataObj) = ((bp
[(n)+10])).fiChar; break; case FOAM_Bool: (retDataObj)->fiBool
= ((bp[(n)+10])).fiBool; break; case FOAM_Byte: (retDataObj)
->fiByte = ((bp[(n)+10])).fiByte; break; case FOAM_HInt: (
retDataObj)->fiHInt = ((bp[(n)+10])).fiHInt; break; case FOAM_SInt
: (retDataObj)->fiSInt = ((bp[(n)+10])).fiSInt; break; case
FOAM_SFlo: (retDataObj)->fiSFlo = ((bp[(n)+10])).fiSFlo; break
; case FOAM_DFlo: (retDataObj)->fiDFlo = ((bp[(n)+10])).fiDFlo
; break; case FOAM_Word: (retDataObj)->fiWord = ((bp[(n)+10
])).fiWord; break; case FOAM_Arb: (retDataObj)->fiArb = ((
bp[(n)+10])).fiArb; break; case FOAM_Ptr: (retDataObj)->fiPtr
= ((bp[(n)+10])).fiPtr; break; case FOAM_Rec: (retDataObj)->
fiRec = ((bp[(n)+10])).fiRec; break; case FOAM_Arr: (retDataObj
)->fiArr = ((bp[(n)+10])).fiArr; break; case FOAM_TR: (retDataObj
)->fiTR = ((bp[(n)+10])).fiTR; break; case FOAM_Prog: (retDataObj
)->fiProgPos=((bp[(n)+10])).fiProgPos; break; case FOAM_Clos
: (retDataObj)->fiClos = ((bp[(n)+10])).fiClos; break; case
FOAM_Gener: (retDataObj)->fiGener = ((bp[(n)+10])).fiGener
; break; case FOAM_GenIter: (retDataObj)->fiGenIter = ((bp
[(n)+10])).fiGenIter; break; case FOAM_Env: (retDataObj)->
fiEnv = ((bp[(n)+10])).fiEnv; break; case FOAM_NOp: fintSetMFmt
((retDataObj), &((bp[(n)+10]))); break; case FOAM_Nil: (retDataObj
)->_fiNil = ((bp[(n)+10]))._fiNil; break; case FOAM_BInt: (
retDataObj)->fiBInt = (Ptr) (bintCopy((BInt) ((bp[(n)+10])
).fiBInt)); break; default: fintWhere(((int) 0));bug("fintSet: type %d unimplemented."
, (int)(((prog)->fmtPar)[(n)].type)); } }
;
3775
3776 myType = parType(n)(((prog)->fmtPar)[(n)].type);
3777
3778 return myType;
3779
3780 case FOAM_Lex: {
3781 int lev, type;
3782 DataObj pLev;
3783
3784 fintGetInt(fmt, lev){ switch (fmt) { case 0: { String _s = fintGetn(4); (lev) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((lev) = tape[ip++]); break
; default: (lev) = (fmt) - 2; break; } }
;
3785 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3786 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "(Lex %d %d)", (int) lev, (int) n);
3787 switch (lev) {
3788 case 0: type = lexType(lev, n)(((unit)->lexLevels)[(prog->denv[(lev)])].fmtLex[(n)].type
)
;
3789 fintSet(type, retDataObj, lev0[n]){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",3789); } while (0); switch ((int)type) { case FOAM_Char
: *(FiChar *)(retDataObj) = (lev0[n]).fiChar; break; case FOAM_Bool
: (retDataObj)->fiBool = (lev0[n]).fiBool; break; case FOAM_Byte
: (retDataObj)->fiByte = (lev0[n]).fiByte; break; case FOAM_HInt
: (retDataObj)->fiHInt = (lev0[n]).fiHInt; break; case FOAM_SInt
: (retDataObj)->fiSInt = (lev0[n]).fiSInt; break; case FOAM_SFlo
: (retDataObj)->fiSFlo = (lev0[n]).fiSFlo; break; case FOAM_DFlo
: (retDataObj)->fiDFlo = (lev0[n]).fiDFlo; break; case FOAM_Word
: (retDataObj)->fiWord = (lev0[n]).fiWord; break; case FOAM_Arb
: (retDataObj)->fiArb = (lev0[n]).fiArb; break; case FOAM_Ptr
: (retDataObj)->fiPtr = (lev0[n]).fiPtr; break; case FOAM_Rec
: (retDataObj)->fiRec = (lev0[n]).fiRec; break; case FOAM_Arr
: (retDataObj)->fiArr = (lev0[n]).fiArr; break; case FOAM_TR
: (retDataObj)->fiTR = (lev0[n]).fiTR; break; case FOAM_Prog
: (retDataObj)->fiProgPos=(lev0[n]).fiProgPos; break; case
FOAM_Clos: (retDataObj)->fiClos = (lev0[n]).fiClos; break
; case FOAM_Gener: (retDataObj)->fiGener = (lev0[n]).fiGener
; break; case FOAM_GenIter: (retDataObj)->fiGenIter = (lev0
[n]).fiGenIter; break; case FOAM_Env: (retDataObj)->fiEnv =
(lev0[n]).fiEnv; break; case FOAM_NOp: fintSetMFmt((retDataObj
), &(lev0[n])); break; case FOAM_Nil: (retDataObj)->_fiNil
= (lev0[n])._fiNil; break; case FOAM_BInt: (retDataObj)->
fiBInt = (Ptr) (bintCopy((BInt) (lev0[n]).fiBInt)); break; default
: fintWhere(((int) 0));bug("fintSet: type %d unimplemented.",
(int)type); } }
;
3790 myType = type;
3791 return myType;
3792
3793 case 1: pLev = ((DataObj) lexEnv->next->level);
3794 break;
3795 case 2: pLev = ((DataObj) lexEnv->next->next->level);
3796 break;
3797 case 3: pLev = ((DataObj) lexEnv->next->next->next->level);
3798 break;
3799 case 4: pLev = ((DataObj) lexEnv->next->next->next->next->level);
3800 break;
3801 default: {
3802 FiEnv e = lexEnv;
3803 int j;
3804
3805 for (j = 0; j < lev; j++)
3806 e = e->next;
3807 pLev = (DataObj) e->level;
3808 break;
3809 }
3810 }
3811
3812 hardAssert(lev < progInfoDEnvsCount(prog))do { if (!(lev < ((prog)->denvsCount))) fintHardAssert(
"lev < progInfoDEnvsCount(prog)", "fint.c", 3812); } while
(0)
;
3813
3814 type = lexType(lev, n)(((unit)->lexLevels)[(prog->denv[(lev)])].fmtLex[(n)].type
)
;
3815 fintSet(type, retDataObj, pLev[n]){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",3815); } while (0); switch ((int)type) { case FOAM_Char
: *(FiChar *)(retDataObj) = (pLev[n]).fiChar; break; case FOAM_Bool
: (retDataObj)->fiBool = (pLev[n]).fiBool; break; case FOAM_Byte
: (retDataObj)->fiByte = (pLev[n]).fiByte; break; case FOAM_HInt
: (retDataObj)->fiHInt = (pLev[n]).fiHInt; break; case FOAM_SInt
: (retDataObj)->fiSInt = (pLev[n]).fiSInt; break; case FOAM_SFlo
: (retDataObj)->fiSFlo = (pLev[n]).fiSFlo; break; case FOAM_DFlo
: (retDataObj)->fiDFlo = (pLev[n]).fiDFlo; break; case FOAM_Word
: (retDataObj)->fiWord = (pLev[n]).fiWord; break; case FOAM_Arb
: (retDataObj)->fiArb = (pLev[n]).fiArb; break; case FOAM_Ptr
: (retDataObj)->fiPtr = (pLev[n]).fiPtr; break; case FOAM_Rec
: (retDataObj)->fiRec = (pLev[n]).fiRec; break; case FOAM_Arr
: (retDataObj)->fiArr = (pLev[n]).fiArr; break; case FOAM_TR
: (retDataObj)->fiTR = (pLev[n]).fiTR; break; case FOAM_Prog
: (retDataObj)->fiProgPos=(pLev[n]).fiProgPos; break; case
FOAM_Clos: (retDataObj)->fiClos = (pLev[n]).fiClos; break
; case FOAM_Gener: (retDataObj)->fiGener = (pLev[n]).fiGener
; break; case FOAM_GenIter: (retDataObj)->fiGenIter = (pLev
[n]).fiGenIter; break; case FOAM_Env: (retDataObj)->fiEnv =
(pLev[n]).fiEnv; break; case FOAM_NOp: fintSetMFmt((retDataObj
), &(pLev[n])); break; case FOAM_Nil: (retDataObj)->_fiNil
= (pLev[n])._fiNil; break; case FOAM_BInt: (retDataObj)->
fiBInt = (Ptr) (bintCopy((BInt) (pLev[n]).fiBInt)); break; default
: fintWhere(((int) 0));bug("fintSet: type %d unimplemented.",
(int)type); } }
;
3816
3817 myType = type;
3818
3819 return myType;
3820 }
3821
3822 case FOAM_Fluid: {
3823 FiFluid afluid;
3824 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3825
3826 hardAssert(n < fintUnitFluidsCount(unit))do { if (!(n < ((unit)->fluidsCount))) fintHardAssert("n < fintUnitFluidsCount(unit)"
, "fint.c", 3826); } while (0)
;
3827
3828 afluid = fiGetFluid(fluidId(n)(((unit)->fmtFluids)[(n)].id));
3829 expr.fiWord = fiFluidValue(afluid);
3830
3831 fintSet(fluidType(n), retDataObj, expr){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",3831); } while (0); switch ((int)(((unit)->fmtFluids
)[(n)].type)) { case FOAM_Char: *(FiChar *)(retDataObj) = (expr
).fiChar; break; case FOAM_Bool: (retDataObj)->fiBool = (expr
).fiBool; break; case FOAM_Byte: (retDataObj)->fiByte = (expr
).fiByte; break; case FOAM_HInt: (retDataObj)->fiHInt = (expr
).fiHInt; break; case FOAM_SInt: (retDataObj)->fiSInt = (expr
).fiSInt; break; case FOAM_SFlo: (retDataObj)->fiSFlo = (expr
).fiSFlo; break; case FOAM_DFlo: (retDataObj)->fiDFlo = (expr
).fiDFlo; break; case FOAM_Word: (retDataObj)->fiWord = (expr
).fiWord; break; case FOAM_Arb: (retDataObj)->fiArb = (expr
).fiArb; break; case FOAM_Ptr: (retDataObj)->fiPtr = (expr
).fiPtr; break; case FOAM_Rec: (retDataObj)->fiRec = (expr
).fiRec; break; case FOAM_Arr: (retDataObj)->fiArr = (expr
).fiArr; break; case FOAM_TR: (retDataObj)->fiTR = (expr).
fiTR; break; case FOAM_Prog: (retDataObj)->fiProgPos=(expr
).fiProgPos; break; case FOAM_Clos: (retDataObj)->fiClos =
(expr).fiClos; break; case FOAM_Gener: (retDataObj)->fiGener
= (expr).fiGener; break; case FOAM_GenIter: (retDataObj)->
fiGenIter = (expr).fiGenIter; break; case FOAM_Env: (retDataObj
)->fiEnv = (expr).fiEnv; break; case FOAM_NOp: fintSetMFmt
((retDataObj), &(expr)); break; case FOAM_Nil: (retDataObj
)->_fiNil = (expr)._fiNil; break; case FOAM_BInt: (retDataObj
)->fiBInt = (Ptr) (bintCopy((BInt) (expr).fiBInt)); break;
default: fintWhere(((int) 0));bug("fintSet: type %d unimplemented."
, (int)(((unit)->fmtFluids)[(n)].type)); } }
;
3832
3833 myType = fluidType(n)(((unit)->fmtFluids)[(n)].type);
3834
3835 return myType;
3836 }
3837/* !! */
3838 case FOAM_Env: {
3839 int lev;
3840
3841 fintGetInt(fmt, lev){ switch (fmt) { case 0: { String _s = fintGetn(4); (lev) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((lev) = tape[ip++]); break
; default: (lev) = (fmt) - 2; break; } }
;
3842
3843 switch (lev) {
3844 case 0: retDataObj->fiEnv = lexEnv;
3845 break;
3846 case 1: retDataObj->fiEnv = lexEnv->next;
3847 break;
3848 case 2: retDataObj->fiEnv = lexEnv->next->next;
3849 break;
3850 case 3: retDataObj->fiEnv = lexEnv->next->next->next;
3851 break;
3852 case 4: retDataObj->fiEnv = lexEnv->next->next->next->next;
3853 break;
3854 default: {
3855 FiEnv e = lexEnv;
3856 int j;
3857
3858 for (j = 0; j < lev; j++)
3859 e = e->next;
3860 retDataObj->fiEnv = e;
3861 break;
3862 }
3863 }
3864
3865 myType = FOAM_Env;
3866
3867 return myType;
3868 }
3869
3870 case FOAM_CEnv: {
3871 union dataObj clos;
3872
3873 fintTypedEval(&clos, FOAM_Clos){ dataType type = fintEval(&clos); do { if (!(type == FOAM_Clos
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Clos || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3873); } while (0); }
;
3874 hardAssert(clos.fiClos != NULL)do { if (!(clos.fiClos != ((void*)0))) fintHardAssert("clos.fiClos != NULL"
, "fint.c", 3874); } while (0)
;
3875 retDataObj->fiEnv = clos.fiClos->env;
3876 myType = FOAM_Env;
3877 break;
3878 }
3879
3880 case FOAM_CProg: {
3881 union dataObj clos;
3882
3883 fintTypedEval(&clos, FOAM_Clos){ dataType type = fintEval(&clos); do { if (!(type == FOAM_Clos
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Clos || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3883); } while (0); }
;
3884 hardAssert(clos.fiClos != NULL)do { if (!(clos.fiClos != ((void*)0))) fintHardAssert("clos.fiClos != NULL"
, "fint.c", 3884); } while (0)
;
3885 retDataObj->fiProgPos = (FiProgPos) clos.fiClos->prog;
3886 myType = FOAM_Prog;
3887 break;
3888 }
3889
3890 case FOAM_EInfo: {
3891 union dataObj env;
3892
3893 fintTypedEval(&env, FOAM_Env){ dataType type = fintEval(&env); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3893); } while (0); }
;
3894 hardAssert(env.fiEnv != NULL)do { if (!(env.fiEnv != ((void*)0))) fintHardAssert("env.fiEnv != NULL"
, "fint.c", 3894); } while (0)
;
3895 retDataObj->fiWord = (FiWord) (env.fiEnv->info);
3896 myType = FOAM_Word;
3897 break;
3898 }
3899
3900
3901 case FOAM_EEnv: {
3902 int n;
3903 union dataObj env;
3904 FiEnv e;
3905
3906 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3907 fintTypedEval(&env, FOAM_Env){ dataType type = fintEval(&env); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3907); } while (0); }
;
3908 for (e = env.fiEnv; n; n--, e = e->next)
3909 hardAssert(e)do { if (!(e)) fintHardAssert("e", "fint.c", 3909); } while (
0)
;
3910 retDataObj->fiEnv = e;
3911 myType = FOAM_Env;
3912 break;
3913 }
3914
3915 case FOAM_PRef: {
3916 int n;
3917 union dataObj expr;
3918 /* Luckily, fiProgGetInfo does not look too carefully at its arg */
3919 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3920 assert(n==0)do { if (!(n==0)) _do_assert(("n==0"),"fint.c",3920); } while
(0)
;
3921 fintTypedEval(&expr, FOAM_Prog){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Prog
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Prog || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3921); } while (0); }
;
3922 retDataObj->fiWord = (FiWord) expr.progInfo->_progInfo;
3923 myType = FOAM_SInt;
3924 break;
3925 }
3926/* !! */
3927 case FOAM_PushEnv:
3928 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3929 fintTypedEval(&expr, FOAM_Env){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3929); } while (0); }
;
3930 retDataObj->fiEnv = (FiEnv) fintAlloc(struct _FiEnv, 1)((DataObj) memset(stoAlloc(0, sizeof(struct _FiEnv) * (1)), 0
, sizeof(struct _FiEnv) * (1)))
;
3931 retDataObj->fiEnv->level = (Ptr)
3932 fintAlloc(union dataObj, fintUnitLexsCount(unit, n))((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(n)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(n)]).fmtLexsCount))))
;
3933 retDataObj->fiEnv->next = expr.fiEnv;
3934 retDataObj->fiEnv->info = (FiWord) NULL((void*)0);
3935
3936 myType = FOAM_Env;
3937 break;
3938
3939 case FOAM_Clos: {
3940 union dataObj env;
3941 union dataObj prog0;
3942
3943 fintTypedEval(&env, FOAM_Env){ dataType type = fintEval(&env); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3943); } while (0); }
;
3944 fintTypedEval(&prog0, FOAM_Prog){ dataType type = fintEval(&prog0); do { if (!(type == FOAM_Prog
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Prog || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3944); } while (0); }
;
3945
3946 fintClosMake(retDataObj->fiClos, env, prog0){ (retDataObj->fiClos) = (FiClos) ((DataObj) memset(stoAlloc
(0, sizeof(struct _FiClos) * (1)), 0, sizeof(struct _FiClos) *
(1))); (retDataObj->fiClos)->prog = (FiProg) (prog0).fiProgPos
; (retDataObj->fiClos)->env = (env).fiEnv;}
;
3947
3948 myType = FOAM_Clos;
3949 return myType;
3950 }
3951 case FOAM_Gener: {
3952 union dataObj env;
3953 union dataObj prog0;
3954 FiGener gener;
3955 int n;
3956 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3957 fintTypedEval(&env, FOAM_Env){ dataType type = fintEval(&env); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3957); } while (0); }
;
3958 fintTypedEval(&prog0, FOAM_Prog){ dataType type = fintEval(&prog0); do { if (!(type == FOAM_Prog
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Prog || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3958); } while (0); }
;
3959
3960 fintGenerMake(retDataObj->fiGener, env, prog0, 0){ (retDataObj->fiGener) = (FiGener) ((DataObj) memset(stoAlloc
(0, sizeof(struct _FiGener) * (1)), 0, sizeof(struct _FiGener
) * (1))); (retDataObj->fiGener)->prog = (FiProg) (prog0
).fiProgPos; (retDataObj->fiGener)->stateSize = 0; (retDataObj
->fiGener)->env = (env).fiEnv;}
;
3961
3962 myType = FOAM_Gener;
3963 return myType;
3964 }
3965 case FOAM_GenIter: {
3966 FiGenIter gi;
3967 fintTypedEval(&expr, FOAM_Gener){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Gener
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Gener || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3967); } while (0); }
;
3968 gi = (FiGenIter) stoAlloc(OB_Other0, sizeof(*retDataObj->fiGenIter));
3969 gi->env = expr.fiGener->env;
3970 gi->prog = expr.fiGener->prog;
3971 gi->step = -1;
3972 gi->state = NULL((void*)0);
3973 retDataObj->fiGenIter = gi;
3974 myType = FOAM_GenIter;
3975 return myType;
3976 }
3977 case FOAM_GenerValue: {
3978 union dataObj dgi;
3979 fintTypedEval(&dgi, FOAM_GenIter){ dataType type = fintEval(&dgi); do { if (!(type == FOAM_GenIter
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_GenIter || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",3979); } while (0); }
;
3980 retDataObj->fiWord = fiGenerValue(dgi.fiGenIter)((dgi.fiGenIter)->value);
3981 myType = FOAM_Word;
3982 return myType;
3983 }
3984 case FOAM_Const:
3985 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
3986
3987 hardAssert(n < fintUnitConstsCount(unit))do { if (!(n < ((unit)->constsCount))) fintHardAssert("n < fintUnitConstsCount(unit)"
, "fint.c", 3987); } while (0)
;
3988
3989 fintSet(constType(n), retDataObj, constValue(n)){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",3989); } while (0); switch ((int)((((unit)->fmtConsts
)[(n)]).type)) { case FOAM_Char: *(FiChar *)(retDataObj) = ((
(unit)->constValues[(n)])).fiChar; break; case FOAM_Bool: (
retDataObj)->fiBool = (((unit)->constValues[(n)])).fiBool
; break; case FOAM_Byte: (retDataObj)->fiByte = (((unit)->
constValues[(n)])).fiByte; break; case FOAM_HInt: (retDataObj
)->fiHInt = (((unit)->constValues[(n)])).fiHInt; break;
case FOAM_SInt: (retDataObj)->fiSInt = (((unit)->constValues
[(n)])).fiSInt; break; case FOAM_SFlo: (retDataObj)->fiSFlo
= (((unit)->constValues[(n)])).fiSFlo; break; case FOAM_DFlo
: (retDataObj)->fiDFlo = (((unit)->constValues[(n)])).fiDFlo
; break; case FOAM_Word: (retDataObj)->fiWord = (((unit)->
constValues[(n)])).fiWord; break; case FOAM_Arb: (retDataObj)
->fiArb = (((unit)->constValues[(n)])).fiArb; break; case
FOAM_Ptr: (retDataObj)->fiPtr = (((unit)->constValues[
(n)])).fiPtr; break; case FOAM_Rec: (retDataObj)->fiRec = (
((unit)->constValues[(n)])).fiRec; break; case FOAM_Arr: (
retDataObj)->fiArr = (((unit)->constValues[(n)])).fiArr
; break; case FOAM_TR: (retDataObj)->fiTR = (((unit)->constValues
[(n)])).fiTR; break; case FOAM_Prog: (retDataObj)->fiProgPos
=(((unit)->constValues[(n)])).fiProgPos; break; case FOAM_Clos
: (retDataObj)->fiClos = (((unit)->constValues[(n)])).fiClos
; break; case FOAM_Gener: (retDataObj)->fiGener = (((unit)
->constValues[(n)])).fiGener; break; case FOAM_GenIter: (retDataObj
)->fiGenIter = (((unit)->constValues[(n)])).fiGenIter; break
; case FOAM_Env: (retDataObj)->fiEnv = (((unit)->constValues
[(n)])).fiEnv; break; case FOAM_NOp: fintSetMFmt((retDataObj)
, &(((unit)->constValues[(n)]))); break; case FOAM_Nil
: (retDataObj)->_fiNil = (((unit)->constValues[(n)]))._fiNil
; break; case FOAM_BInt: (retDataObj)->fiBInt = (Ptr) (bintCopy
((BInt) (((unit)->constValues[(n)])).fiBInt)); break; default
: fintWhere(((int) 0));bug("fintSet: type %d unimplemented.",
(int)((((unit)->fmtConsts)[(n)]).type)); } }
;
3990
3991 myType = constType(n)((((unit)->fmtConsts)[(n)]).type);
3992
3993 return myType;
3994
3995 case FOAM_Catch: {
3996 union dataObj clos;
3997 union dataObj nuffin;
3998 union dataObj *rets;
3999 FiBool ok;
4000 FiWord val, exn = 0;
4001
4002
4003 /* Evaluate the catch expression */
4004 fintTypedEval(&clos, FOAM_Clos){ dataType type = fintEval(&clos); do { if (!(type == FOAM_Clos
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Clos || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4004); } while (0); }
;
4005 (void)fintEval(&nuffin); /* ignore */
4006
4007
4008 /* Check that old-style catches are gone */
4009 hardAssert(fintCurrentFormat != emptyFormatSlot)do { if (!(fintCurrentFormat != 4)) fintHardAssert("fintCurrentFormat != emptyFormatSlot"
, "fint.c", 4009); } while (0)
;
4010
4011
4012 /* Decide which type of try-block this is. */
4013 if (fintUnitLexsCount(unit,fintCurrentFormat)(((unit)->lexLevels[(fintCurrentFormat)]).fmtLexsCount) == 3) {
4014 /* catch-with-value */
4015 fintBlock(ok, val, exn, fintDoCall0(&clos, retDataObj)){ int __fmt = fintCurrentFormat; { FiStateBox frobnitz; FiState
state = &frobnitz;; if (!(fiSaveState0(state), _setjmp (
state->machineState))) { val = fintDoCall0(&clos, retDataObj
); fiRestoreState0(state); ok = 1; } else { fiRestoreState0(state
); if (state->target != (FiWord) state) { fiUnwind(state->
target, state->value); } exn = state->value; ok = 0; } }
; fintCurrentFormat = __fmt; }
;
4016 rets = fintAlloc(union dataObj, 3)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (3)), 0
, sizeof(union dataObj) * (3)))
;
4017 rets[0].fiSInt = ok;
4018 rets[1].fiWord = retDataObj->fiWord;
4019 rets[2].fiWord = exn;
4020 retDataObj->ptr = rets;
4021 }
4022 else {
4023 /* catch-with-no-value */
4024 fintVoidBlock(ok, exn, fintDoCall0(&clos, retDataObj)){ int __fmt = fintCurrentFormat; { FiStateBox frobnitz; FiState
state = &frobnitz;; if (!(fiSaveState0(state), _setjmp (
state->machineState))) { fintDoCall0(&clos, retDataObj
); fiRestoreState0(state); ok = 1; } else { fiRestoreState0(state
); if (state->target != (FiWord) state) { fiUnwind(state->
target, state->value); } exn = state->value; ok = 0; } }
; fintCurrentFormat = __fmt; }
;
4025 rets = fintAlloc(union dataObj, 2)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (2)), 0
, sizeof(union dataObj) * (2)))
;
4026 rets[0].fiSInt = ok;
4027 rets[1].fiWord = exn;
4028 retDataObj->ptr = rets;
4029 }
4030
4031
4032 /* Tell the caller where we've put our value */
4033 myType = FOAM_Ptr;
4034 break;
4035 }
4036 case FOAM_Cast: {
4037 /*
4038 * The job of the FOAM cast instruction is to change the
4039 * type under which a value is viewed. It is important
4040 * that this operation DOES NOT alter the information
4041 * associated with the value unless it cannot be avoided.
4042 * Some loss of data is inevitable if we view DFlos as
4043 * SFlos or SInts as Bools.
4044 *
4045 * For C-like coercions with information loss, such as
4046 *
4047 * anInt = (int)aDFlo;
4048 * anSFlo = (float)anInt;
4049 *
4050 * we use the built-in convert() operations instead of
4051 * pretend. The FOAM cast instruction is not used for
4052 * this kind of value manipulation.
4053 */
4054 dataType frType, toType;
4055
4056 fintGetByte(toType)((toType) = tape[ip++]);
4057
4058 frType = fintEval(&expr);
4059
4060 switch ((int)frType) {
4061 case FOAM_SFlo:
4062 switch ((int)toType) {
4063 case FOAM_SFlo:
4064 retDataObj->fiSFlo = expr.fiSFlo;
4065 break;
4066 case FOAM_DFlo:
4067 retDataObj->fiDFlo = expr.fiSFlo;
4068 break;
4069 case FOAM_SInt:
4070 case FOAM_Word:
4071 retDataObj->fiSInt = fiSFloToWord(expr.fiSFlo);
4072 break;
4073 case FOAM_HInt:
4074 retDataObj->fiHInt = (FiHInt) expr.fiSFlo;
4075 break;
4076 default:
4077 bug("FintEval: Cast from %d to %d unimplemented.",
4078 (int)frType, (int)toType);
4079 }
4080 break;
4081 case FOAM_DFlo:
4082 switch ((int)toType) {
4083 case FOAM_DFlo:
4084 retDataObj->fiDFlo = expr.fiDFlo;
4085 break;
4086 case FOAM_SFlo:
4087 retDataObj->fiSFlo = (FiSFlo) expr.fiDFlo;
4088 break;
4089 case FOAM_SInt:
4090 case FOAM_Word:
4091 retDataObj->fiSInt = (FiWord)
4092 fiBoxDFlo(expr.fiDFlo);
4093 break;
4094 case FOAM_HInt:
4095 retDataObj->fiHInt = (FiHInt) expr.fiDFlo;
4096 break;
4097 default:
4098 bug("FintEval: Cast from %d to %d unimplemented.",
4099 (int)frType, (int)toType);
4100 }
4101 break;
4102 case FOAM_SInt:
4103 switch ((int)toType) {
4104 case FOAM_Word:
4105 retDataObj->fiWord = expr.fiSInt;
4106 goto castDone;
4107 case FOAM_SFlo:
4108 retDataObj->fiSFlo = fiWordToSFlo(expr.fiSInt);
4109 goto castDone;
4110 case FOAM_DFlo:
4111 retDataObj->fiDFlo = fiUnBoxDFlo(expr.fiSInt);
4112 goto castDone;
4113 }
4114 /* fall through !*/
4115 case FOAM_Word:
4116 switch ((int)toType) {
4117 case FOAM_SInt:
4118 retDataObj->fiSInt = expr.fiWord;
4119 goto castDone;
4120 case FOAM_SFlo:
4121 retDataObj->fiSFlo = fiWordToSFlo(expr.fiSInt);
4122 goto castDone;
4123 case FOAM_DFlo:
4124 retDataObj->fiDFlo = fiUnBoxDFlo(expr.fiSInt);
4125 goto castDone;
4126 }
4127 /* fall through !*/
4128 default:{
4129 int frSize = 0, toSize = 0;
4130
4131 hardAssert(toType != FOAM_SFlo)do { if (!(toType != FOAM_SFlo)) fintHardAssert("toType != FOAM_SFlo"
, "fint.c", 4131); } while (0)
;
4132 hardAssert(toType != FOAM_DFlo)do { if (!(toType != FOAM_DFlo)) fintHardAssert("toType != FOAM_DFlo"
, "fint.c", 4132); } while (0)
;
4133 if (frType == FOAM_NOp && toType== FOAM_NOp) break;
4134 fintGetTypeSize(frSize, frType){ switch ((int)frType) { case FOAM_Char: (frSize) = sizeof(FiChar
); break; case FOAM_Bool: (frSize) = sizeof(FiBool); break; case
FOAM_Byte: (frSize) = sizeof(FiByte); break; case FOAM_HInt:
(frSize) = sizeof(FiHInt); break; case FOAM_SInt: (frSize) =
sizeof(FiSInt); break; case FOAM_BInt: (frSize) = sizeof(FiBInt
); break; case FOAM_SFlo: (frSize) = sizeof(FiSFlo); break; case
FOAM_DFlo: (frSize) = sizeof(FiDFlo); break; case FOAM_Arr: (
frSize) = sizeof(FiArr); break; case FOAM_Rec: (frSize) = sizeof
(FiRec); break; case FOAM_TR: (frSize) = sizeof(FiTR); break;
case FOAM_Env: (frSize) = sizeof(FiEnv); break; case FOAM_Prog
: (frSize) = sizeof(FiProg); break; case FOAM_Clos: (frSize) =
sizeof(FiClos); break; case FOAM_Gener: (frSize) = sizeof(FiGener
); break; case FOAM_GenIter: (frSize) = sizeof(FiGenIter); break
; case FOAM_Ptr: (frSize) = sizeof(FiPtr); break; case FOAM_Word
: (frSize) = sizeof(FiWord); break; case FOAM_Arb: (frSize) =
sizeof(FiArb); break; case FOAM_Nil: (frSize) = sizeof(FiNil
); break; default: fintWhere(((int) 0));bug("fintGetTypeSize: type %d unimplemented."
, (int)frType); }}
;
4135 fintGetTypeSize(toSize, toType){ switch ((int)toType) { case FOAM_Char: (toSize) = sizeof(FiChar
); break; case FOAM_Bool: (toSize) = sizeof(FiBool); break; case
FOAM_Byte: (toSize) = sizeof(FiByte); break; case FOAM_HInt:
(toSize) = sizeof(FiHInt); break; case FOAM_SInt: (toSize) =
sizeof(FiSInt); break; case FOAM_BInt: (toSize) = sizeof(FiBInt
); break; case FOAM_SFlo: (toSize) = sizeof(FiSFlo); break; case
FOAM_DFlo: (toSize) = sizeof(FiDFlo); break; case FOAM_Arr: (
toSize) = sizeof(FiArr); break; case FOAM_Rec: (toSize) = sizeof
(FiRec); break; case FOAM_TR: (toSize) = sizeof(FiTR); break;
case FOAM_Env: (toSize) = sizeof(FiEnv); break; case FOAM_Prog
: (toSize) = sizeof(FiProg); break; case FOAM_Clos: (toSize) =
sizeof(FiClos); break; case FOAM_Gener: (toSize) = sizeof(FiGener
); break; case FOAM_GenIter: (toSize) = sizeof(FiGenIter); break
; case FOAM_Ptr: (toSize) = sizeof(FiPtr); break; case FOAM_Word
: (toSize) = sizeof(FiWord); break; case FOAM_Arb: (toSize) =
sizeof(FiArb); break; case FOAM_Nil: (toSize) = sizeof(FiNil
); break; default: fintWhere(((int) 0));bug("fintGetTypeSize: type %d unimplemented."
, (int)toType); }}
;
4136
4137 /* $$ !! not portable */
4138 if (frSize == sizeof(FiChar)) {
4139 if (toSize == sizeof(FiChar))
4140 retDataObj->fiChar = expr.fiChar;
4141
4142 else if (toSize == sizeof(FiHInt))
4143 retDataObj->fiHInt = expr.fiChar;
4144 else if (toSize == sizeof(FiWord))
4145 retDataObj->fiWord = expr.fiChar;
4146 else
4147 bug("FintEval: Cast from %d to %d unimplemented.",
4148 (int)frType, (int)toType);
4149
4150 }
4151 else if (frSize == sizeof(FiHInt)) {
4152 if (toSize == sizeof(FiChar))
4153 retDataObj->fiChar = expr.fiHInt;
4154 else if (toSize == sizeof(FiHInt))
4155 retDataObj->fiHInt = expr.fiHInt;
4156
4157 else if (toSize == sizeof(FiWord))
4158 retDataObj->fiWord = expr.fiHInt;
4159 else
4160 bug("FintEval: Cast from %d to %d unimplemented.",
4161 (int)frType, (int)toType);
4162 }
4163 else if (frSize == sizeof(FiWord)) {
4164 if (toSize == sizeof(FiChar))
4165 retDataObj->fiChar = (FiChar) expr.fiWord;
4166 else if (toSize == sizeof(FiHInt))
4167 retDataObj->fiHInt = (FiHInt) expr.fiWord;
4168 else if (toSize == sizeof(FiWord))
4169 retDataObj->fiWord = expr.fiWord;
4170
4171 else
4172 bug("FintEval: Cast from %d to %d unimplemented.",
4173 (int)frType, (int)toType);
4174 }
4175 else
4176 bug("FintEval: Cast from %d to %d unimplemented.",
4177 (int)frType, (int)toType);
4178
4179 break;
4180 }
4181 }
4182 castDone:
4183 myType = toType;
4184
4185 return myType;
4186 }
4187
4188 case FOAM_Nil: {
4189 retDataObj->_fiNil = (FiNil) 0;
4190 myType = FOAM_Nil;
4191 return myType;
4192 }
4193
4194 case FOAM_Char:
4195 case FOAM_Byte:
4196 fintGetByte(n)((n) = tape[ip++]);
4197 retDataObj->fiByte = (FiByte) n;
4198 myType = tag;
4199 return myType;
4200
4201 case FOAM_Bool:
4202 fintGetByte(n)((n) = tape[ip++]);
4203 retDataObj->fiBool = (FiByte) n;
4204 myType = tag;
4205 return myType;
4206
4207 case FOAM_HInt:
4208 fintGetHInt(n){ String _s = fintGetn(2); (n) = ((((ULong) _s[0])&((1<<
8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<8)); }
;
4209 retDataObj->fiHInt = (FiHInt)n;
4210 /* fintGetHInt(retDataObj->fiHInt); */
4211 myType = FOAM_HInt;
4212 return myType;
4213
4214 case FOAM_SInt:
4215 fintGetSInt(retDataObj->fiSInt){ String _s = fintGetn(4); (retDataObj->fiSInt) = (int) ((
(((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1])&
((1<<8)-1))<<8))|(((((ULong) _s[2])&((1<<
8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<8))<<
(2*8))); }
;
4216 myType = FOAM_SInt;
4217 return myType;
4218
4219 case FOAM_BInt: {
4220 Bool neg;
4221 U16 static_data[4];
4222 U16 *data;
4223 int slen, bi;
4224 long n;
4225
4226 fintGetByte(neg)((neg) = tape[ip++]);
4227 fintGetInt(fmt, slen){ switch (fmt) { case 0: { String _s = fintGetn(4); (slen) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slen) = tape[ip++]); break
; default: (slen) = (fmt) - 2; break; } }
;
4228 data = (slen <= 4) ? static_data :
4229 (U16*) stoAlloc(OB_Other0, slen*sizeof(int));
4230
4231 for (bi = 0; bi < slen; bi++) {
4232 fintGetHInt(n){ String _s = fintGetn(2); (n) = ((((ULong) _s[0])&((1<<
8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<8)); }
;
4233 data[bi] = (U16)n;
4234 }
4235 retDataObj->fiBInt = (FiBInt) bintFrPlacevS((Bool) neg,
4236 slen, data);
4237 if (slen > 4)
4238 stoFree(data);
4239 myType = FOAM_BInt;
4240 return myType;
4241 }
4242
4243 case FOAM_SFlo:
4244 retDataObj->fiSFlo = (FiSFlo) fintRdSFloat();
4245 myType = FOAM_SFlo;
4246 return myType;
4247
4248 case FOAM_DFlo:
4249 retDataObj->fiDFlo = (FiDFlo) fintRdDFloat();
4250 myType = FOAM_DFlo;
4251 return myType;
4252
4253 case FOAM_BCall:
4254 myType = fintEvalBCall(retDataObj);
4255 return myType;
4256
4257 case FOAM_Arr: {
4258 int i;
4259
4260 fintGetByte(type)((type) = tape[ip++]);
4261 argc--;
4262
4263 switch ((int)type) {
4264
4265 case FOAM_Char:
4266 retDataObj->fiArr = (Ptr) fiArrNew_Char(argc+1);
4267 break;
4268 case FOAM_Bool:
4269 retDataObj->fiArr = (Ptr) fiArrNew_Bool(argc+1);
4270 break;
4271 case FOAM_Byte:
4272 retDataObj->fiArr = (Ptr) fiArrNew_Byte(argc+1);
4273 break;
4274 case FOAM_HInt:
4275 retDataObj->fiArr = (Ptr) fiArrNew_HInt(argc+1);
4276 break;
4277 case FOAM_SInt:
4278 retDataObj->fiArr = (Ptr) fiArrNew_SInt(argc+1);
4279 break;
4280 case FOAM_SFlo:
4281 retDataObj->fiArr = (Ptr) fiArrNew_SFlo(argc+1);
4282 break;
4283 case FOAM_DFlo:
4284 retDataObj->fiArr = (Ptr) fiArrNew_DFlo(argc+1);
4285 break;
4286 case FOAM_Word:
4287 retDataObj->fiArr = (Ptr) fiArrNew_Word(argc+1);
4288 break;
4289 case FOAM_BInt:
4290 retDataObj->fiArr = (Ptr) fiArrNew_BInt(argc+1);
4291 break;
4292 default:
4293 bug("fintEval: array of type %s unimplemented for Arr", foamInfo(type)(foamInfoTable [(int)(type)-(int)FOAM_START]).str);
4294 }
4295
4296 for (n = 0; n < argc; n++) {
4297 fintGetSInt(i){ String _s = fintGetn(4); (i) = (int) (((((ULong) _s[0])&
((1<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8))|(((((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[
3])&((1<<8)-1))<<8))<<(2*8))); }
;
4298 /* fintASetElem(type, retDataObj, n, expr); !!*/
4299 ((char *)(retDataObj->fiArr))[n] = i;
4300 }
4301 ((char *)(retDataObj->fiArr))[argc] = '\0';
4302
4303 myType = FOAM_Arr;
4304 break;
4305 }
4306
4307 case FOAM_ANew:
4308 fintGetByte(type)((type) = tape[ip++]);
4309 fintTypedEval(&expr, FOAM_SInt){ dataType type = fintEval(&expr); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4309); } while (0); }
;
4310
4311 switch ((int)type) {
4312 case FOAM_Char:
4313 retDataObj->fiArr = (Ptr) fiArrNew_Char(expr.fiSInt);
4314 break;
4315 case FOAM_Bool:
4316 retDataObj->fiArr = (Ptr) fiArrNew_Word(expr.fiSInt); /* $$ !! WORD */
4317 break;
4318 case FOAM_Byte:
4319 retDataObj->fiArr = (Ptr) fiArrNew_Byte(expr.fiSInt);
4320 break;
4321 case FOAM_HInt:
4322 retDataObj->fiArr = (Ptr) fiArrNew_HInt(expr.fiSInt);
4323 break;
4324 case FOAM_SInt:
4325 retDataObj->fiArr = (Ptr) fiArrNew_SInt(expr.fiSInt);
4326 break;
4327 case FOAM_SFlo:
4328 retDataObj->fiArr = (Ptr) fiArrNew_SFlo(expr.fiSInt);
4329 break;
4330 case FOAM_DFlo:
4331 retDataObj->fiArr = (Ptr) fiArrNew_DFlo(expr.fiSInt);
4332 break;
4333 case FOAM_Word:
4334 retDataObj->fiArr = (Ptr) fiArrNew_Word(expr.fiSInt);
4335 break;
4336 case FOAM_BInt:
4337 retDataObj->fiArr = (Ptr) fiArrNew_BInt(expr.fiSInt);
4338 break;
4339 default:
4340 bug("fintEval: array of type %s unimplemented for ANew", foamInfo(type)(foamInfoTable [(int)(type)-(int)FOAM_START]).str);
4341 }
4342
4343 myType = FOAM_Arr;
4344 break;
4345
4346 case FOAM_AElt: {
4347 union dataObj elem;
4348
4349 fintGetByte(type)((type) = tape[ip++]);
4350 fintTypedEval(&elem, FOAM_SInt){ dataType type = fintEval(&elem); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4350); } while (0); }
;
4351 fintTypedEval(&expr, FOAM_Arr){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4351); } while (0); }
;
4352
4353 fintAGetElem(type, retDataObj, &expr, elem.fiSInt){ switch ((int)type) { case FOAM_Char: (retDataObj)->fiChar
= ((FiChar *)((&expr)->fiArr))[(elem.fiSInt)]; break;
case FOAM_Bool: (retDataObj)->fiBool = ((FiBool *)((&
expr)->fiArr))[(elem.fiSInt)]; break; case FOAM_Byte: (retDataObj
)->fiByte = ((FiByte *)((&expr)->fiArr))[(elem.fiSInt
)]; break; case FOAM_HInt: (retDataObj)->fiHInt = ((FiHInt
*)((&expr)->fiArr))[(elem.fiSInt)]; break; case FOAM_SInt
: (retDataObj)->fiSInt = ((FiSInt *)((&expr)->fiArr
))[(elem.fiSInt)]; break; case FOAM_SFlo: (retDataObj)->fiSFlo
= ((FiSFlo *)((&expr)->fiArr))[(elem.fiSInt)]; break;
case FOAM_DFlo: (retDataObj)->fiDFlo = ((FiDFlo *)((&
expr)->fiArr))[(elem.fiSInt)]; break; case FOAM_Word: (retDataObj
)->fiWord = ((FiWord *)((&expr)->fiArr))[(elem.fiSInt
)]; break; case FOAM_BInt: (retDataObj)->fiBInt = ((FiBInt
*)((&expr)->fiArr))[(elem.fiSInt)]; break; default: fintWhere
(((int) 0));bug("fintAGetElem: type %d unimplemented.", (int)
type); } }
;
4354
4355 myType = type;
4356
4357 break;
4358 }
4359
4360 case FOAM_RRElt: {
4361 bug("fintEval: FOAM_RRElt not implemented");
4362 break;
4363 }
4364
4365 case FOAM_RRNew: {
4366 bug("fintEval: FOAM_RRNew not implemented");
4367 break;
4368 }
4369
4370 case FOAM_RNew: {
4371 long i, bSize;
4372
4373 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
4374
4375 retDataObj->fiRec = (FiRec)
4376 fintAlloc(union dataObj, fintUnitLexsCount(unit,n))((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(n)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(n)]).fmtLexsCount))))
;
4377
4378 bSize = sizeof(union dataObj) * fintUnitLexsCount(unit, n)(((unit)->lexLevels[(n)]).fmtLexsCount);
4379 for (i = 0; i < bSize; i++)
4380 ((UByte *) retDataObj->fiRec)[i] = 0;
4381
4382 myType = FOAM_Rec;
4383 break;
4384 }
4385 case FOAM_RElt: {
4386 int slot;
4387
4388 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
4389 fintTypedEval(&expr, FOAM_Rec){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Rec
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Rec || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4389); } while (0); }
;
4390 fintGetInt(fmt, slot){ switch (fmt) { case 0: { String _s = fintGetn(4); (slot) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slot) = tape[ip++]); break
; default: (slot) = (fmt) - 2; break; } }
;
4391
4392 type = fmtType0(n, slot)(((unit)->lexLevels)[(n)].fmtLex[(slot)].type);
4393
4394 assert((DataObj)(expr.fiRec) != NULL)do { if (!((DataObj)(expr.fiRec) != ((void*)0))) _do_assert((
"(DataObj)(expr.fiRec) != NULL"),"fint.c",4394); } while (0)
;
4395
4396 fintSet(type, retDataObj, ((DataObj)(expr.fiRec))[slot]){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",4396); } while (0); switch ((int)type) { case FOAM_Char
: *(FiChar *)(retDataObj) = (((DataObj)(expr.fiRec))[slot]).fiChar
; break; case FOAM_Bool: (retDataObj)->fiBool = (((DataObj
)(expr.fiRec))[slot]).fiBool; break; case FOAM_Byte: (retDataObj
)->fiByte = (((DataObj)(expr.fiRec))[slot]).fiByte; break;
case FOAM_HInt: (retDataObj)->fiHInt = (((DataObj)(expr.fiRec
))[slot]).fiHInt; break; case FOAM_SInt: (retDataObj)->fiSInt
= (((DataObj)(expr.fiRec))[slot]).fiSInt; break; case FOAM_SFlo
: (retDataObj)->fiSFlo = (((DataObj)(expr.fiRec))[slot]).fiSFlo
; break; case FOAM_DFlo: (retDataObj)->fiDFlo = (((DataObj
)(expr.fiRec))[slot]).fiDFlo; break; case FOAM_Word: (retDataObj
)->fiWord = (((DataObj)(expr.fiRec))[slot]).fiWord; break;
case FOAM_Arb: (retDataObj)->fiArb = (((DataObj)(expr.fiRec
))[slot]).fiArb; break; case FOAM_Ptr: (retDataObj)->fiPtr
= (((DataObj)(expr.fiRec))[slot]).fiPtr; break; case FOAM_Rec
: (retDataObj)->fiRec = (((DataObj)(expr.fiRec))[slot]).fiRec
; break; case FOAM_Arr: (retDataObj)->fiArr = (((DataObj)(
expr.fiRec))[slot]).fiArr; break; case FOAM_TR: (retDataObj)->
fiTR = (((DataObj)(expr.fiRec))[slot]).fiTR; break; case FOAM_Prog
: (retDataObj)->fiProgPos=(((DataObj)(expr.fiRec))[slot]).
fiProgPos; break; case FOAM_Clos: (retDataObj)->fiClos = (
((DataObj)(expr.fiRec))[slot]).fiClos; break; case FOAM_Gener
: (retDataObj)->fiGener = (((DataObj)(expr.fiRec))[slot]).
fiGener; break; case FOAM_GenIter: (retDataObj)->fiGenIter
= (((DataObj)(expr.fiRec))[slot]).fiGenIter; break; case FOAM_Env
: (retDataObj)->fiEnv = (((DataObj)(expr.fiRec))[slot]).fiEnv
; break; case FOAM_NOp: fintSetMFmt((retDataObj), &(((DataObj
)(expr.fiRec))[slot])); break; case FOAM_Nil: (retDataObj)->
_fiNil = (((DataObj)(expr.fiRec))[slot])._fiNil; break; case FOAM_BInt
: (retDataObj)->fiBInt = (Ptr) (bintCopy((BInt) (((DataObj
)(expr.fiRec))[slot]).fiBInt)); break; default: fintWhere(((int
) 0));bug("fintSet: type %d unimplemented.", (int)type); } }
;
4397
4398 myType = type;
4399
4400 break;
4401 }
4402
4403 case FOAM_TRNew: {
4404 int isz, asz, sz;
4405 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
4406 fintTypedEval(&expr, FOAM_SInt){ dataType type = fintEval(&expr); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4406); } while (0); }
;
4407 hardAssert(fintUnitLexsCount(unit, n))do { if (!((((unit)->lexLevels[(n)]).fmtLexsCount))) fintHardAssert
("fintUnitLexsCount(unit, n)", "fint.c", 4407); } while (0)
;
4408
4409 sz = fintUnitLexsCount(unit,n)(((unit)->lexLevels[(n)]).fmtLexsCount) - 1;
4410 isz = lexFormat(n, int0)(((unit)->lexLevels)[(n)].fmtLex[(((int) 0))].format);
4411 asz = sz - isz;
4412 retDataObj->fiTR = (FiTR)
4413 fintAlloc(union dataObj, isz + asz * expr.fiSInt)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (isz + asz
* expr.fiSInt)), 0, sizeof(union dataObj) * (isz + asz * expr
.fiSInt)))
;
4414
4415 myType = FOAM_TR;
4416 break;
4417 }
4418 case FOAM_IRElt: {
4419 int slot;
4420
4421 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
4422 fintTypedEval(&expr, FOAM_TR){ dataType type = fintEval(&expr); do { if (!(type == FOAM_TR
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_TR || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4422); } while (0); }
;
4423 fintGetInt(fmt, slot){ switch (fmt) { case 0: { String _s = fintGetn(4); (slot) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slot) = tape[ip++]); break
; default: (slot) = (fmt) - 2; break; } }
;
4424
4425 type = fmtType0(n, slot + 1)(((unit)->lexLevels)[(n)].fmtLex[(slot + 1)].type);
4426
4427 assert((DataObj)(expr.fiTR) != NULL)do { if (!((DataObj)(expr.fiTR) != ((void*)0))) _do_assert(("(DataObj)(expr.fiTR) != NULL"
),"fint.c",4427); } while (0)
;
4428
4429 fintSet(type, retDataObj, ((DataObj)(expr.fiTR))[slot]){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",4429); } while (0); switch ((int)type) { case FOAM_Char
: *(FiChar *)(retDataObj) = (((DataObj)(expr.fiTR))[slot]).fiChar
; break; case FOAM_Bool: (retDataObj)->fiBool = (((DataObj
)(expr.fiTR))[slot]).fiBool; break; case FOAM_Byte: (retDataObj
)->fiByte = (((DataObj)(expr.fiTR))[slot]).fiByte; break; case
FOAM_HInt: (retDataObj)->fiHInt = (((DataObj)(expr.fiTR))
[slot]).fiHInt; break; case FOAM_SInt: (retDataObj)->fiSInt
= (((DataObj)(expr.fiTR))[slot]).fiSInt; break; case FOAM_SFlo
: (retDataObj)->fiSFlo = (((DataObj)(expr.fiTR))[slot]).fiSFlo
; break; case FOAM_DFlo: (retDataObj)->fiDFlo = (((DataObj
)(expr.fiTR))[slot]).fiDFlo; break; case FOAM_Word: (retDataObj
)->fiWord = (((DataObj)(expr.fiTR))[slot]).fiWord; break; case
FOAM_Arb: (retDataObj)->fiArb = (((DataObj)(expr.fiTR))[slot
]).fiArb; break; case FOAM_Ptr: (retDataObj)->fiPtr = (((DataObj
)(expr.fiTR))[slot]).fiPtr; break; case FOAM_Rec: (retDataObj
)->fiRec = (((DataObj)(expr.fiTR))[slot]).fiRec; break; case
FOAM_Arr: (retDataObj)->fiArr = (((DataObj)(expr.fiTR))[slot
]).fiArr; break; case FOAM_TR: (retDataObj)->fiTR = (((DataObj
)(expr.fiTR))[slot]).fiTR; break; case FOAM_Prog: (retDataObj
)->fiProgPos=(((DataObj)(expr.fiTR))[slot]).fiProgPos; break
; case FOAM_Clos: (retDataObj)->fiClos = (((DataObj)(expr.
fiTR))[slot]).fiClos; break; case FOAM_Gener: (retDataObj)->
fiGener = (((DataObj)(expr.fiTR))[slot]).fiGener; break; case
FOAM_GenIter: (retDataObj)->fiGenIter = (((DataObj)(expr.
fiTR))[slot]).fiGenIter; break; case FOAM_Env: (retDataObj)->
fiEnv = (((DataObj)(expr.fiTR))[slot]).fiEnv; break; case FOAM_NOp
: fintSetMFmt((retDataObj), &(((DataObj)(expr.fiTR))[slot
])); break; case FOAM_Nil: (retDataObj)->_fiNil = (((DataObj
)(expr.fiTR))[slot])._fiNil; break; case FOAM_BInt: (retDataObj
)->fiBInt = (Ptr) (bintCopy((BInt) (((DataObj)(expr.fiTR))
[slot]).fiBInt)); break; default: fintWhere(((int) 0));bug("fintSet: type %d unimplemented."
, (int)type); } }
;
4430
4431 myType = type;
4432
4433 break;
4434 }
4435
4436 case FOAM_TRElt: {
4437 union dataObj idx;
4438 long slot;
4439 int isz, asz, sz;
4440 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
4441 fintTypedEval(&expr, FOAM_TR){ dataType type = fintEval(&expr); do { if (!(type == FOAM_TR
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_TR || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4441); } while (0); }
;
4442 fintTypedEval(&idx, FOAM_SInt){ dataType type = fintEval(&idx); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4442); } while (0); }
;
4443 fintGetInt(fmt, slot){ switch (fmt) { case 0: { String _s = fintGetn(4); (slot) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slot) = tape[ip++]); break
; default: (slot) = (fmt) - 2; break; } }
;
4444 sz = fintUnitLexsCount(unit,n)(((unit)->lexLevels[(n)]).fmtLexsCount) - 1;
4445 isz = lexFormat(n, int0)(((unit)->lexLevels)[(n)].fmtLex[(((int) 0))].format);
4446 asz = sz - isz;
4447
4448 type = fmtType0(n, slot+asz+1)(((unit)->lexLevels)[(n)].fmtLex[(slot+asz+1)].type);
4449 slot = isz + asz*idx.fiSInt + slot;
4450 fintSet(type, retDataObj, ((DataObj)(expr.fiTR))[slot]){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",4450); } while (0); switch ((int)type) { case FOAM_Char
: *(FiChar *)(retDataObj) = (((DataObj)(expr.fiTR))[slot]).fiChar
; break; case FOAM_Bool: (retDataObj)->fiBool = (((DataObj
)(expr.fiTR))[slot]).fiBool; break; case FOAM_Byte: (retDataObj
)->fiByte = (((DataObj)(expr.fiTR))[slot]).fiByte; break; case
FOAM_HInt: (retDataObj)->fiHInt = (((DataObj)(expr.fiTR))
[slot]).fiHInt; break; case FOAM_SInt: (retDataObj)->fiSInt
= (((DataObj)(expr.fiTR))[slot]).fiSInt; break; case FOAM_SFlo
: (retDataObj)->fiSFlo = (((DataObj)(expr.fiTR))[slot]).fiSFlo
; break; case FOAM_DFlo: (retDataObj)->fiDFlo = (((DataObj
)(expr.fiTR))[slot]).fiDFlo; break; case FOAM_Word: (retDataObj
)->fiWord = (((DataObj)(expr.fiTR))[slot]).fiWord; break; case
FOAM_Arb: (retDataObj)->fiArb = (((DataObj)(expr.fiTR))[slot
]).fiArb; break; case FOAM_Ptr: (retDataObj)->fiPtr = (((DataObj
)(expr.fiTR))[slot]).fiPtr; break; case FOAM_Rec: (retDataObj
)->fiRec = (((DataObj)(expr.fiTR))[slot]).fiRec; break; case
FOAM_Arr: (retDataObj)->fiArr = (((DataObj)(expr.fiTR))[slot
]).fiArr; break; case FOAM_TR: (retDataObj)->fiTR = (((DataObj
)(expr.fiTR))[slot]).fiTR; break; case FOAM_Prog: (retDataObj
)->fiProgPos=(((DataObj)(expr.fiTR))[slot]).fiProgPos; break
; case FOAM_Clos: (retDataObj)->fiClos = (((DataObj)(expr.
fiTR))[slot]).fiClos; break; case FOAM_Gener: (retDataObj)->
fiGener = (((DataObj)(expr.fiTR))[slot]).fiGener; break; case
FOAM_GenIter: (retDataObj)->fiGenIter = (((DataObj)(expr.
fiTR))[slot]).fiGenIter; break; case FOAM_Env: (retDataObj)->
fiEnv = (((DataObj)(expr.fiTR))[slot]).fiEnv; break; case FOAM_NOp
: fintSetMFmt((retDataObj), &(((DataObj)(expr.fiTR))[slot
])); break; case FOAM_Nil: (retDataObj)->_fiNil = (((DataObj
)(expr.fiTR))[slot])._fiNil; break; case FOAM_BInt: (retDataObj
)->fiBInt = (Ptr) (bintCopy((BInt) (((DataObj)(expr.fiTR))
[slot]).fiBInt)); break; default: fintWhere(((int) 0));bug("fintSet: type %d unimplemented."
, (int)type); } }
;
4451
4452 myType = type;
4453
4454 break;
4455 }
4456
4457 case FOAM_EElt: {
4458 int format, lev, n, i;
4459 FiEnv env;
4460
4461 fintGetInt(fmt, format){ switch (fmt) { case 0: { String _s = fintGetn(4); (format) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((format) = tape[ip++])
; break; default: (format) = (fmt) - 2; break; } }
;
4462 fintTypedEval(&expr, FOAM_Env){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4462); } while (0); }
;
4463 fintGetInt(fmt, lev){ switch (fmt) { case 0: { String _s = fintGetn(4); (lev) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((lev) = tape[ip++]); break
; default: (lev) = (fmt) - 2; break; } }
;
4464 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
4465
4466 env = expr.fiEnv;
4467 for (i = 0; i < lev; i++) {
4468 env = env->next;
4469 hardAssert(env != NULL)do { if (!(env != ((void*)0))) fintHardAssert("env != NULL", "fint.c"
, 4469); } while (0)
;
4470 }
4471
4472 type = fmtType0(format, n)(((unit)->lexLevels)[(format)].fmtLex[(n)].type);
4473 /* !! now the offset is ignored */
4474 fintSet(type, retDataObj, ((DataObj)(env->level))[n]){ do { if (!(retDataObj != ((void*)0))) _do_assert(("retDataObj != NULL"
),"fint.c",4474); } while (0); switch ((int)type) { case FOAM_Char
: *(FiChar *)(retDataObj) = (((DataObj)(env->level))[n]).fiChar
; break; case FOAM_Bool: (retDataObj)->fiBool = (((DataObj
)(env->level))[n]).fiBool; break; case FOAM_Byte: (retDataObj
)->fiByte = (((DataObj)(env->level))[n]).fiByte; break;
case FOAM_HInt: (retDataObj)->fiHInt = (((DataObj)(env->
level))[n]).fiHInt; break; case FOAM_SInt: (retDataObj)->fiSInt
= (((DataObj)(env->level))[n]).fiSInt; break; case FOAM_SFlo
: (retDataObj)->fiSFlo = (((DataObj)(env->level))[n]).fiSFlo
; break; case FOAM_DFlo: (retDataObj)->fiDFlo = (((DataObj
)(env->level))[n]).fiDFlo; break; case FOAM_Word: (retDataObj
)->fiWord = (((DataObj)(env->level))[n]).fiWord; break;
case FOAM_Arb: (retDataObj)->fiArb = (((DataObj)(env->
level))[n]).fiArb; break; case FOAM_Ptr: (retDataObj)->fiPtr
= (((DataObj)(env->level))[n]).fiPtr; break; case FOAM_Rec
: (retDataObj)->fiRec = (((DataObj)(env->level))[n]).fiRec
; break; case FOAM_Arr: (retDataObj)->fiArr = (((DataObj)(
env->level))[n]).fiArr; break; case FOAM_TR: (retDataObj)->
fiTR = (((DataObj)(env->level))[n]).fiTR; break; case FOAM_Prog
: (retDataObj)->fiProgPos=(((DataObj)(env->level))[n]).
fiProgPos; break; case FOAM_Clos: (retDataObj)->fiClos = (
((DataObj)(env->level))[n]).fiClos; break; case FOAM_Gener
: (retDataObj)->fiGener = (((DataObj)(env->level))[n]).
fiGener; break; case FOAM_GenIter: (retDataObj)->fiGenIter
= (((DataObj)(env->level))[n]).fiGenIter; break; case FOAM_Env
: (retDataObj)->fiEnv = (((DataObj)(env->level))[n]).fiEnv
; break; case FOAM_NOp: fintSetMFmt((retDataObj), &(((DataObj
)(env->level))[n])); break; case FOAM_Nil: (retDataObj)->
_fiNil = (((DataObj)(env->level))[n])._fiNil; break; case FOAM_BInt
: (retDataObj)->fiBInt = (Ptr) (bintCopy((BInt) (((DataObj
)(env->level))[n]).fiBInt)); break; default: fintWhere(((int
) 0));bug("fintSet: type %d unimplemented.", (int)type); } }
;
4475
4476 myType = type;
4477
4478 break;
4479 }
4480
4481 case FOAM_MFmt: {
4482 /* Save the existing format */
4483 int format = fintCurrentFormat;
4484
4485 fintGetInt(fmt, fintCurrentFormat){ switch (fmt) { case 0: { String _s = fintGetn(4); (fintCurrentFormat
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((fintCurrentFormat) = tape
[ip++]); break; default: (fintCurrentFormat) = (fmt) - 2; break
; } }
;
4486 fintTypedEval(&expr, FOAM_NOp){ dataType type = fintEval(&expr); do { if (!(type == FOAM_NOp
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_NOp || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4486); } while (0); }
;
4487 retDataObj->mFmt = (MFmt) stoAlloc(OB_Other0, sizeof(struct mFmt));
4488
4489 retDataObj->mFmt->fmt = fintCurrentFormat;
4490 retDataObj->mFmt->values = expr.ptr;
4491 myType = FOAM_NOp;
4492
4493 /* Restore the old format */
4494 fintCurrentFormat = format;
4495 break;
4496 }
4497 case FOAM_Values:
4498 if (argc) {
4499 retDataObj->ptr = fintAlloc(union dataObj, argc)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (argc))
, 0, sizeof(union dataObj) * (argc)))
;
4500
4501 for (n = 0; n < argc; n++)
4502 (void)fintEval(retDataObj->ptr + n);
4503 }
4504 else
4505 retDataObj->ptr = 0;
4506
4507 myType = FOAM_NOp;
4508
4509 break;
4510
4511 case FOAM_PCall: {
4512 union dataObj expr1, expr2, expr3, expr4;
4513 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
; /* protocol */
4514 fintGetByte(type)((type) = tape[ip++]);
4515 (void)fintEval(&expr);
4516
4517 switch ((int)expr.fiSInt) {
4518 case FINT_FOREIGN_fputs:
4519 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4519); } while (0); }
;
4520 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4520); } while (0); }
;
4521 retDataObj->fiWord = (FiWord)
4522 fputs((char *) expr1.fiArr, (FILE *) expr2.fiWord);
4523 break;
4524 case FINT_FOREIGN_fputss:
4525 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4525); } while (0); }
;
4526 fintTypedEval(&expr2, FOAM_SInt){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4526); } while (0); }
;
4527 fintTypedEval(&expr3, FOAM_SInt){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4527); } while (0); }
;
4528 fintTypedEval(&expr4, FOAM_Word){ dataType type = fintEval(&expr4); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4528); } while (0); }
;
4529 retDataObj->fiSInt = (FiSInt)
4530 fputss((char *) expr1.fiArr,
4531 (int)expr2.fiSInt,(int) expr3.fiSInt, (FILE *) expr4.fiWord);
4532 break;
4533 case FINT_FOREIGN_fgetss:
4534 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4534); } while (0); }
;
4535 fintTypedEval(&expr2, FOAM_SInt){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4535); } while (0); }
;
4536 fintTypedEval(&expr3, FOAM_SInt){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4536); } while (0); }
;
4537 fintTypedEval(&expr4, FOAM_Word){ dataType type = fintEval(&expr4); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4537); } while (0); }
;
4538 retDataObj->fiSInt = (FiSInt)
4539 fgetss((char *) expr1.fiArr,
4540 (int)expr2.fiSInt, (int)expr3.fiSInt, (FILE *) expr4.fiWord);
4541 break;
4542 case FINT_FOREIGN_isatty:
4543 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4543); } while (0); }
;
4544 retDataObj->fiSInt = (FiSInt) isatty((int)expr1.fiSInt);
4545 break;
4546 case FINT_FOREIGN_fileno:
4547 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4547); } while (0); }
;
4548 retDataObj->fiSInt = (FiSInt) fileno((FILE *) expr1.fiPtr);
4549 break;
4550 case FINT_FOREIGN_stdinFile:
4551 retDataObj->fiWord = (FiWord) stdinFile();
4552 break;
4553 case FINT_FOREIGN_stdoutFile:
4554 retDataObj->fiWord = (FiWord) stdoutFile();
4555 break;
4556 case FINT_FOREIGN_stderrFile:
4557 retDataObj->fiWord = (FiWord) stderrFile();
4558 break;
4559 case FINT_FOREIGN_formatSInt:
4560 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4560); } while (0); }
;
4561 retDataObj->fiWord =(FiWord)formatSInt(expr1.fiSInt);
4562 break;
4563 case FINT_FOREIGN_formatBInt:
4564 fintTypedEval(&expr1, FOAM_BInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_BInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_BInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4564); } while (0); }
;
4565 retDataObj->fiWord =(FiWord)formatBInt(expr1.fiBInt);
4566 break;
4567 case FINT_FOREIGN_formatSFloat:
4568 fintTypedEval(&expr1, FOAM_SFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4568); } while (0); }
;
4569 retDataObj->fiWord =(FiWord)formatSFloat(expr1.fiSFlo);
4570 break;
4571 case FINT_FOREIGN_formatDFloat:
4572 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4572); } while (0); }
;
4573 retDataObj->fiWord =(FiWord)formatDFloat(expr1.fiDFlo);
4574 break;
4575
4576 /* Old debugging system */
4577 case FINT_FOREIGN_fiGetDebugVar:
4578 retDataObj->fiWord = fiGetDebugVar();
4579 break;
4580 case FINT_FOREIGN_fiSetDebugVar:
4581 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4581); } while (0); }
;
4582 fiSetDebugVar(expr1.fiWord);
4583 retDataObj->fiWord = (FiWord) 0;
4584 break;
4585
4586 /* New debugging system */
4587 case FINT_FOREIGN_fiGetDebugger:
4588 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4588); } while (0); }
;
4589 retDataObj->fiClos =
4590 (FiClos)fiGetDebugger(expr1.fiSInt);
4591 break;
4592 case FINT_FOREIGN_fiSetDebugger:
4593 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4593); } while (0); }
;
4594 fintTypedEval(&expr2, FOAM_Clos){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Clos
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Clos || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4594); } while (0); }
;
4595 fiSetDebugger(expr1.fiSInt, (FiWord)expr2.fiClos);
4596 retDataObj->fiWord = (FiWord) 0;
4597 break;
4598
4599 case FINT_FOREIGN_fputc:
4600 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4600); } while (0); }
;
4601 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4601); } while (0); }
;
4602 retDataObj->fiWord = (FiWord)
4603 fputc((int)expr1.fiSInt, (FILE *) expr2.fiWord);
4604 break;
4605
4606 case FINT_FOREIGN_lfputc:
4607 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4607); } while (0); }
;
4608 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4608); } while (0); }
;
4609 retDataObj->fiWord = (FiWord)
4610 fputc((int)expr1.fiSInt, (FILE *) expr2.fiWord);
4611 break;
4612
4613 case FINT_FOREIGN_sqrt:
4614 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4614); } while (0); }
;
4615 retDataObj->fiDFlo = (FiDFlo)
4616 sqrt(expr1.fiDFlo);
4617 break;
4618
4619 case FINT_FOREIGN_pow:
4620 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4620); } while (0); }
;
4621 fintTypedEval(&expr2, FOAM_DFlo){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4621); } while (0); }
;
4622 retDataObj->fiDFlo = (FiDFlo)
4623 pow(expr1.fiDFlo, expr2.fiDFlo);
4624 break;
4625
4626 case FINT_FOREIGN_log:
4627 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4627); } while (0); }
;
4628 retDataObj->fiDFlo = (FiDFlo)
4629 log(expr1.fiDFlo);
4630 break;
4631
4632 case FINT_FOREIGN_log10:
4633 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4633); } while (0); }
;
4634 retDataObj->fiDFlo = (FiDFlo)
4635 log10(expr1.fiDFlo);
4636 break;
4637
4638 case FINT_FOREIGN_exp:
4639 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4639); } while (0); }
;
4640 retDataObj->fiDFlo = (FiDFlo)
4641 exp(expr1.fiDFlo);
4642 break;
4643
4644 case FINT_FOREIGN_sin:
4645 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4645); } while (0); }
;
4646 retDataObj->fiDFlo = (FiDFlo)
4647 sin(expr1.fiDFlo);
4648 break;
4649
4650 case FINT_FOREIGN_cos:
4651 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4651); } while (0); }
;
4652 retDataObj->fiDFlo = (FiDFlo)
4653 cos(expr1.fiDFlo);
4654 break;
4655
4656 case FINT_FOREIGN_tan:
4657 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4657); } while (0); }
;
4658 retDataObj->fiDFlo = (FiDFlo)
4659 tan(expr1.fiDFlo);
4660 break;
4661
4662 case FINT_FOREIGN_sinh:
4663 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4663); } while (0); }
;
4664 retDataObj->fiDFlo = (FiDFlo)
4665 sinh(expr1.fiDFlo);
4666 break;
4667
4668 case FINT_FOREIGN_cosh:
4669 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4669); } while (0); }
;
4670 retDataObj->fiDFlo = (FiDFlo)
4671 cosh(expr1.fiDFlo);
4672 break;
4673
4674 case FINT_FOREIGN_tanh:
4675 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4675); } while (0); }
;
4676 retDataObj->fiDFlo = (FiDFlo)
4677 tanh(expr1.fiDFlo);
4678 break;
4679
4680 case FINT_FOREIGN_asin:
4681 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4681); } while (0); }
;
4682 retDataObj->fiDFlo = (FiDFlo)
4683 asin(expr1.fiDFlo);
4684 break;
4685
4686 case FINT_FOREIGN_acos:
4687 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4687); } while (0); }
;
4688 retDataObj->fiDFlo = (FiDFlo)
4689 acos(expr1.fiDFlo);
4690 break;
4691
4692 case FINT_FOREIGN_atan:
4693 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4693); } while (0); }
;
4694 retDataObj->fiDFlo = (FiDFlo)
4695 atan(expr1.fiDFlo);
4696 break;
4697
4698 case FINT_FOREIGN_atan2:
4699 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4699); } while (0); }
;
4700 fintTypedEval(&expr2, FOAM_DFlo){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4700); } while (0); }
;
4701 retDataObj->fiDFlo = (FiDFlo)
4702 atan2(expr1.fiDFlo, expr2.fiDFlo);
4703 break;
4704
4705 case FINT_FOREIGN_fopen:
4706 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4706); } while (0); }
;
4707 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4707); } while (0); }
;
4708 retDataObj->fiWord = (FiWord)
4709 fopen((char *)expr1.fiArr, (char *)expr2.fiArr);
4710 break;
4711
4712 case FINT_FOREIGN_fclose:
4713 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4713); } while (0); }
;
4714 retDataObj->fiSInt = (FiSInt)
4715 fclose((FILE*)expr1.fiWord);
4716 break;
4717
4718 case FINT_FOREIGN_fflush:
4719 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4719); } while (0); }
;
4720 retDataObj->fiSInt = (FiSInt)
4721 fflush((FILE*)expr1.fiWord);
4722 break;
4723
4724 case FINT_FOREIGN_fgetc:
4725 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4725); } while (0); }
;
4726 retDataObj->fiSInt = (FiSInt)
4727 fgetc((FILE *)expr1.fiWord);
4728 break;
4729
4730 case FINT_FOREIGN_fseek:
4731 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4731); } while (0); }
;
4732 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4732); } while (0); }
;
4733 fintTypedEval(&expr3, FOAM_Word){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4733); } while (0); }
;
4734 retDataObj->fiSInt = (FiSInt)
4735 fseek((FILE *)expr1.fiWord,
4736 expr2.fiWord,
4737 expr3.fiWord);
4738 break;
4739
4740 case FINT_FOREIGN_fseekset:
4741 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4741); } while (0); }
;
4742 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4742); } while (0); }
;
4743 retDataObj->fiSInt = (FiSInt)
4744 fseek((FILE *)expr1.fiWord,
4745 expr2.fiWord,
4746 SEEK_SET0);
4747 break;
4748
4749 case FINT_FOREIGN_ftell:
4750 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4750); } while (0); }
;
4751 retDataObj->fiSInt = (FiSInt)ftell((FILE *)expr1.fiWord);
4752 break;
4753
4754 case FINT_FOREIGN_strLength:
4755 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4755); } while (0); }
;
4756 retDataObj->fiSInt = (FiSInt)
4757 strLength((String) expr1.fiArr);
4758 break;
4759
4760 case FINT_FOREIGN_fiStrHash:
4761 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4761); } while (0); }
;
4762 retDataObj->fiSInt = (FiSInt)
4763 strHash((String) expr1.fiArr);
4764 break;
4765
4766 case FINT_FOREIGN_fiDoubleHexPrintToString:
4767 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4767); } while (0); }
;
4768 retDataObj->fiWord = (FiWord)
4769 fiDoubleHexPrintToString(expr1.fiWord);
4770 break;
4771
4772 case FINT_FOREIGN_fiInitialiseFpu:
4773 fiInitialiseFpu();
4774 /* we lie ... */
4775 retDataObj->fiSInt = 0;
4776 break;
4777
4778 case FINT_FOREIGN_fiIeeeGetRoundingMode:
4779 retDataObj->fiWord = (FiWord)
4780 fiIeeeGetRoundingMode();
4781 break;
4782
4783 case FINT_FOREIGN_fiIeeeSetRoundingMode:
4784 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4784); } while (0); }
;
4785 retDataObj->fiWord = (FiWord)
4786 fiIeeeSetRoundingMode(expr1.fiWord);
4787 break;
4788
4789 case FINT_FOREIGN_fiIeeeGetExceptionStatus:
4790 retDataObj->fiWord = (FiWord)
4791 fiIeeeGetExceptionStatus();
4792 break;
4793
4794 case FINT_FOREIGN_fiIeeeSetExceptionStatus:
4795 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4795); } while (0); }
;
4796 retDataObj->fiWord = (FiWord)
4797 fiIeeeSetExceptionStatus(expr1.fiWord);
4798 break;
4799
4800 case FINT_FOREIGN_fiIeeeGetEnabledExceptions:
4801 retDataObj->fiWord = (FiWord)
4802 fiIeeeGetEnabledExceptions();
4803 break;
4804
4805 case FINT_FOREIGN_fiIeeeSetEnabledExceptions:
4806 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4806); } while (0); }
;
4807 retDataObj->fiWord = (FiWord)
4808 fiIeeeSetEnabledExceptions(expr1.fiWord);
4809 break;
4810
4811 case FINT_FOREIGN_fiDFloMantissa:
4812 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4812); } while (0); }
;
4813 retDataObj->fiBInt = (FiBInt)
4814 fiDFloMantissa(expr1.fiDFlo);
4815 break;
4816
4817 case FINT_FOREIGN_fiDFloExponent:
4818 fintTypedEval(&expr1, FOAM_DFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_DFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_DFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4818); } while (0); }
;
4819 retDataObj->fiBInt = (FiBInt)
4820 fiDFloExponent(expr1.fiDFlo);
4821 break;
4822
4823 case FINT_FOREIGN_fiSFloMantissa:
4824 fintTypedEval(&expr1, FOAM_SFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4824); } while (0); }
;
4825 retDataObj->fiBInt = (FiBInt)
4826 fiSFloMantissa(expr1.fiSFlo);
4827 break;
4828
4829 case FINT_FOREIGN_fiSFloExponent:
4830 fintTypedEval(&expr1, FOAM_SFlo){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SFlo
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SFlo || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4830); } while (0); }
;
4831 retDataObj->fiBInt = (FiBInt)
4832 fiSFloExponent(expr1.fiSFlo);
4833 break;
4834
4835
4836 /* ------ Operating System Interface ------- */
4837
4838 case FINT_FOREIGN_osRun:
4839 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4839); } while (0); }
;
4840 retDataObj->fiSInt = (FiSInt)
4841 osRun((String) expr1.fiArr);
4842 break;
4843
4844 case FINT_FOREIGN_osRunConcurrent:
4845 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4845); } while (0); }
;
4846 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4846); } while (0); }
;
4847 fintTypedEval(&expr3, FOAM_Word){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4847); } while (0); }
;
4848 fintTypedEval(&expr4, FOAM_Word){ dataType type = fintEval(&expr4); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4848); } while (0); }
;
4849 retDataObj->fiSInt = (FiSInt)
4850 osRunConcurrent((String) expr1.fiArr,
4851 (FILE **) expr2.fiWord,
4852 (FILE **) expr3.fiWord,
4853 (FILE **) expr4.fiWord);
4854 break;
4855
4856 case FINT_FOREIGN_osRunQuoteArg:
4857 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4857); } while (0); }
;
4858 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4858); } while (0); }
;
4859 retDataObj->fiSInt = (FiSInt)
4860 osRunQuoteArg((String) expr1.fiArr,
4861 (int (*)(int)) expr2.fiWord);
4862 break;
4863
4864 case FINT_FOREIGN_osCpuTime:
4865 retDataObj->fiSInt = (FiSInt) osCpuTime();
4866 break;
4867
4868 case FINT_FOREIGN_osDate:
4869 retDataObj->fiArr = (FiArr) osDate();
4870 break;
4871
4872 case FINT_FOREIGN_osGetEnv:
4873 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4873); } while (0); }
;
4874 retDataObj->fiArr = (FiArr)
4875 osGetEnv((String) expr1.fiArr);
4876 break;
4877
4878 case FINT_FOREIGN_osPutEnv:
4879 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4879); } while (0); }
;
4880 retDataObj->fiSInt = (FiSInt)
4881 osPutEnv((String) expr1.fiArr);
4882 break;
4883
4884 case FINT_FOREIGN_osPutEnvIsKept:
4885 retDataObj->fiBool = (FiBool)
4886 osPutEnvIsKept();
4887 break;
4888
4889 case FINT_FOREIGN_osCurDirName:
4890 retDataObj->fiArr = (FiArr)
4891 osCurDirName();
4892 break;
4893 case FINT_FOREIGN_osTmpDirName:
4894 retDataObj->fiArr = (FiArr)
4895 osTmpDirName();
4896 break;
4897
4898 case FINT_FOREIGN_osFnameDirEqual:
4899 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4899); } while (0); }
;
4900 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4900); } while (0); }
;
4901 retDataObj->fiBool = (FiBool)
4902 osFnameDirEqual((String) expr1.fiArr,
4903 (String) expr2.fiArr);
4904 break;
4905 case FINT_FOREIGN_osSubdir:
4906 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4906); } while (0); }
;
4907 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4907); } while (0); }
;
4908 fintTypedEval(&expr3, FOAM_Arr){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4908); } while (0); }
;
4909 osSubdir((String) expr1.fiArr,
4910 (String) expr2.fiArr,
4911 (String) expr3.fiArr);
4912 break;
4913
4914 case FINT_FOREIGN_osSubdirLength:
4915 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4915); } while (0); }
;
4916 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4916); } while (0); }
;
4917 retDataObj->fiSInt = (FiSInt)
4918 osSubdirLength((String) expr1.fiArr,
4919 (String) expr2.fiArr);
4920 break;
4921
4922 case FINT_FOREIGN_osFnameParse:
4923 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4923); } while (0); }
;
4924 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4924); } while (0); }
;
4925 fintTypedEval(&expr3, FOAM_Arr){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4925); } while (0); }
;
4926 fintTypedEval(&expr4, FOAM_Arr){ dataType type = fintEval(&expr4); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4926); } while (0); }
;
4927 osFnameParse((String *) expr1.fiArr,
4928 (String) expr2.fiArr,
4929 (String) expr3.fiArr,
4930 (String) expr4.fiArr);
4931 break;
4932
4933 case FINT_FOREIGN_osFnameParseSize:
4934 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4934); } while (0); }
;
4935 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4935); } while (0); }
;
4936 retDataObj->fiSInt = (FiSInt)
4937 osFnameParseSize((String) expr1.fiArr,
4938 (String) expr2.fiArr);
4939 break;
4940
4941 case FINT_FOREIGN_osFnameUnparse:
4942 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4942); } while (0); }
;
4943 fintTypedEval(&expr2, FOAM_Word){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4943); } while (0); }
;
4944 fintTypedEval(&expr3, FOAM_Bool){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_Bool
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Bool || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4944); } while (0); }
;
4945 retDataObj->fiSInt = (FiSInt)
4946 osFnameUnparse((String) expr1.fiArr,
4947 (String *) expr2.fiWord,
4948 (Bool)expr3.fiBool);
4949 break;
4950
4951 case FINT_FOREIGN_osFnameUnparseSize:
4952 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4952); } while (0); }
;
4953 fintTypedEval(&expr2, FOAM_Bool){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Bool
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Bool || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4953); } while (0); }
;
4954 retDataObj->fiSInt = (FiSInt)
4955 osFnameUnparseSize((String *) expr1.fiWord,
4956 (Bool)expr2.fiBool);
4957 break;
4958
4959 case FINT_FOREIGN_osFnameTempSeed:
4960 retDataObj->fiSInt = (FiSInt)
4961 osFnameTempSeed();
4962 break;
4963 case FINT_FOREIGN_osFnameTempDir:
4964 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4964); } while (0); }
;
4965 retDataObj->fiArr = (FiArr)
4966 osFnameTempDir((String) expr1.fiArr);
4967 break;
4968
4969 case FINT_FOREIGN_osIsInteractive:
4970 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4970); } while (0); }
;
4971 retDataObj->fiBool = (FiBool)
4972 osIsInteractive((FILE *) expr1.fiWord);
4973 break;
4974
4975 case FINT_FOREIGN_osFileRemove:
4976 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4976); } while (0); }
;
4977 retDataObj->fiSInt = (FiSInt)
4978 osFileRemove((String) expr1.fiArr);
4979 break;
4980
4981 case FINT_FOREIGN_osFileRename:
4982 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4982); } while (0); }
;
4983 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4983); } while (0); }
;
4984 retDataObj->fiSInt = (FiSInt)
4985 osFileRename((String) expr1.fiArr,
4986 (String) expr2.fiArr);
4987 break;
4988
4989 case FINT_FOREIGN_osFileIsThere:
4990 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4990); } while (0); }
;
4991 retDataObj->fiBool = (FiBool)
4992 osFileIsThere((String) expr1.fiArr);
4993 break;
4994
4995 case FINT_FOREIGN_osFileHash:
4996 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",4996); } while (0); }
;
4997 retDataObj->fiSInt = (FiSInt)
4998 osFileHash((String) expr1.fiArr);
4999 break;
5000
5001 case FINT_FOREIGN_osFileSize:
5002 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5002); } while (0); }
;
5003 retDataObj->fiSInt = (FiSInt)
5004 osFileSize((String) expr1.fiArr);
5005 break;
5006
5007 case FINT_FOREIGN_osDirIsThere:
5008 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5008); } while (0); }
;
5009 retDataObj->fiBool = (FiBool)
5010 osDirIsThere((String) expr1.fiArr);
5011 break;
5012
5013 case FINT_FOREIGN_osDirSwap:
5014 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5014); } while (0); }
;
5015 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5015); } while (0); }
;
5016 fintTypedEval(&expr3, FOAM_SInt){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5016); } while (0); }
;
5017
5018 retDataObj->fiSInt = (FiSInt)
5019 osDirSwap((String) expr1.fiArr,
5020 (String) expr2.fiArr,
5021 (FiSInt) expr3.fiSInt);
5022 break;
5023
5024 case FINT_FOREIGN_osIncludePath:
5025 retDataObj->fiArr = (FiArr)
5026 osIncludePath();
5027 break;
5028 case FINT_FOREIGN_osLibraryPath:
5029 retDataObj->fiArr = (FiArr)
5030 osLibraryPath();
5031 break;
5032 case FINT_FOREIGN_osExecutePath:
5033 retDataObj->fiArr = (FiArr)
5034 osExecutePath();
5035 break;
5036
5037 case FINT_FOREIGN_osPathLength:
5038 fintTypedEval(&expr1, FOAM_Arr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5038); } while (0); }
;
5039 retDataObj->fiSInt = (FiSInt)
5040 osPathLength((String) expr1.fiArr);
5041 break;
5042 case FINT_FOREIGN_osPathParse:
5043 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5043); } while (0); }
;
5044 fintTypedEval(&expr2, FOAM_Arr){ dataType type = fintEval(&expr2); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5044); } while (0); }
;
5045 fintTypedEval(&expr3, FOAM_Arr){ dataType type = fintEval(&expr3); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5045); } while (0); }
;
5046 osPathParse((String *) expr1.fiWord,
5047 (String) expr2.fiArr,
5048 (String) expr3.fiArr);
5049 break;
5050 case FINT_FOREIGN_gcTimer: {
5051 retDataObj->fiWord = (FiWord) stoGcTimer();
5052 break;
5053 }
5054 case FINT_FOREIGN_fiRaiseException: {
5055 fintTypedEval(&expr1, FOAM_Word){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Word
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Word || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5055); } while (0); }
;
5056 fiRaiseException(expr1.fiWord);
5057 break;
5058 }
5059 case FINT_FOREIGN_osAllocShow: {
5060 osAllocShow();
5061 break;
5062 }
5063 case FINT_FOREIGN_osAlloc: {
5064 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5064); } while (0); }
;
5065 retDataObj->fiPtr = osAlloc((unsigned long *)expr1.fiPtr);
5066 break;
5067 }
5068 case FINT_FOREIGN_osFree: {
5069 fintTypedEval(&expr1, FOAM_Ptr){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_Ptr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Ptr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5069); } while (0); }
;
5070 osFree((FiPtr)expr1.fiPtr);
5071 break;
5072 }
5073 case FINT_FOREIGN_osMemMap: {
5074 fintTypedEval(&expr1, FOAM_SInt){ dataType type = fintEval(&expr1); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5074); } while (0); }
;
5075 retDataObj->fiArr = (FiArr)osMemMap((int)expr1.fiSInt);
5076 break;
5077 }
5078 case FINT_FOREIGN_randomSeed: {
5079 retDataObj->fiSInt = rand();
5080 break;
5081 }
5082 default: {
5083 AInt pcallId = expr.fiSInt;
5084 bug("fintEval: %s PCall " AINT_FMT"%ld" " %s, (called from <%s> in [%s])\n",
5085 pcallId == -1
5086 ? "undeclared"
5087 : "unimplemented",
5088 pcallId,
5089 pcallId > 0 && pcallId < FINT_FOREIGN_END
5090 ? fintForeignTable[pcallId].string
5091 : "??",
5092 prog->name, prog->unit->name);
5093 }
5094 }
5095
5096 myType = type;
5097 break;
5098 }
5099
5100 default:
5101 bug("fintEval: %s (<%s> in [%s]) unimplemented... (or Seq without Return)\n",
5102 foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).str, prog->name, prog->unit->name);
5103 NotReached(myType = FOAM_Nil){(void)bug("Not supposed to reach line %d in file: %s\n",5103
, "fint.c");}
;
5104 }
5105
5106 return myType;
5107}
5108
5109/* Store in retDataObj a reference to a global, a local, a lexVar, ...
5110 * NOTE: here retDataType != NULL
5111 */
5112localstatic dataType
5113fintGetReference(Ref pDataObj)
5114{
5115 int fmt, tag, n, argc;
5116 dataType myType = 0;
5117
5118 fintGetTagFmt(tag, fmt){ ((tag) = tape[ip++]); fmt = ((tag)<(FOAM_VECTOR_START)? 0
:(((tag)-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); tag = (((tag)) - ((fmt))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); }
;
5119
5120 switch (tag) {
5121 case FOAM_Glo:
5122 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5123
5124 hardAssert(n < fintUnitGlobsCount(unit))do { if (!(n < ((unit)->globsCount))) fintHardAssert("n < fintUnitGlobsCount(unit)"
, "fint.c", 5124); } while (0)
;
5125
5126 *pDataObj = &(globValue(n)(((unit)->globValues[(n)])->dataObj));
5127 myType = globType(n)((((unit)->fmtGlobs)[(n)]).type);
5128 break;
5129
5130 case FOAM_Loc:
5131
5132 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5133
5134 hardAssert(progInfoFmtLoc(prog))do { if (!(((prog)->fmtLoc))) fintHardAssert("progInfoFmtLoc(prog)"
, "fint.c", 5134); } while (0)
;
5135 hardAssert(n < progInfoLocsCount(prog))do { if (!(n < ((prog)->locsCount))) fintHardAssert("n < progInfoLocsCount(prog)"
, "fint.c", 5135); } while (0)
;
5136
5137 *pDataObj = &(locValue(n)(locValues[(n)]));
5138 myType = locType(n)(((prog)->fmtLoc)[(n)].type);
5139 break;
5140
5141 case FOAM_Par:
5142
5143 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5144
5145 hardAssert(progInfoFmtPar(prog))do { if (!(((prog)->fmtPar))) fintHardAssert("progInfoFmtPar(prog)"
, "fint.c", 5145); } while (0)
;
5146 hardAssert(n < progInfoParsCount(prog))do { if (!(n < ((prog)->parsCount))) fintHardAssert("n < progInfoParsCount(prog)"
, "fint.c", 5146); } while (0)
;
5147
5148 *pDataObj = &(parValue(n)(bp[(n)+10]));
5149 myType = parType(n)(((prog)->fmtPar)[(n)].type);
5150 break;
5151
5152 case FOAM_Lex: {
5153 int lev;
5154 DataObj pLev;
5155
5156 fintGetInt(fmt, lev){ switch (fmt) { case 0: { String _s = fintGetn(4); (lev) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((lev) = tape[ip++]); break
; default: (lev) = (fmt) - 2; break; } }
;
5157 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5158
5159 switch (lev) {
5160 case 0: *pDataObj = lev0 + n;
5161 myType = lexType(int0, n)(((unit)->lexLevels)[(prog->denv[(((int) 0))])].fmtLex[
(n)].type)
;
5162 return myType;
5163
5164 case 1: pLev = ((DataObj) lexEnv->next->level);
5165 break;
5166 case 2: pLev = ((DataObj) lexEnv->next->next->level);
5167 break;
5168 case 3: pLev = ((DataObj) lexEnv->next->next->next->level);
5169 break;
5170 case 4: pLev = ((DataObj) lexEnv->next->next->next->next->level);
5171 break;
5172 default: {
5173 FiEnv e = lexEnv;
5174 int j;
5175
5176 for (j = 0; j < lev; j++)
5177 e = e->next;
5178 pLev = (DataObj) e->level;
5179 break;
5180 }
5181 }
5182
5183 *pDataObj = pLev + n;
5184
5185 myType = lexType(lev, n)(((unit)->lexLevels)[(prog->denv[(lev)])].fmtLex[(n)].type
)
;
5186
5187 return myType;
5188 }
5189
5190 case FOAM_Fluid: {
5191 FiFluid afluid;
5192 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5193
5194 hardAssert(n < fintUnitFluidsCount(unit))do { if (!(n < ((unit)->fluidsCount))) fintHardAssert("n < fintUnitFluidsCount(unit)"
, "fint.c", 5194); } while (0)
;
5195
5196 afluid = fiGetFluid(fluidId(n)(((unit)->fmtFluids)[(n)].id));
5197
5198 *pDataObj = (DataObj) &(afluid->value);
5199 myType = fluidType(n)(((unit)->fmtFluids)[(n)].type);
5200 break;
5201 }
5202
5203 case FOAM_Const:
5204
5205 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5206
5207 hardAssert(n < fintUnitConstsCount(unit))do { if (!(n < ((unit)->constsCount))) fintHardAssert("n < fintUnitConstsCount(unit)"
, "fint.c", 5207); } while (0)
;
5208
5209 *pDataObj = &(constValue(n)((unit)->constValues[(n)]));
5210 myType = constType(n)((((unit)->fmtConsts)[(n)]).type);
5211
5212 break;
5213
5214 case FOAM_AElt: {
5215 union dataObj elem;
5216 union dataObj expr;
5217 int type;
5218
5219 fintGetByte(type)((type) = tape[ip++]);
5220 fintTypedEval(&elem, FOAM_SInt){ dataType type = fintEval(&elem); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5220); } while (0); }
;
5221 fintTypedEval(&expr, FOAM_Arr){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Arr
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Arr || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5221); } while (0); }
;
5222
5223 fintAGetElemRef(type, *pDataObj, &expr, elem.fiSInt){ switch ((int)type) { case FOAM_Char:(*pDataObj)=(DataObj)((
(FiChar *)((&expr)->fiArr)) + (elem.fiSInt)); break; case
FOAM_Bool:(*pDataObj)=(DataObj)(((FiBool *)((&expr)->
fiArr)) + (elem.fiSInt)); break; case FOAM_Byte:(*pDataObj)=(
DataObj)(((FiByte *)((&expr)->fiArr)) + (elem.fiSInt))
; break; case FOAM_HInt:(*pDataObj)=(DataObj)(((FiHInt *)((&
expr)->fiArr)) + (elem.fiSInt)); break; case FOAM_SInt:(*pDataObj
)=(DataObj)(((FiSInt *)((&expr)->fiArr)) + (elem.fiSInt
)); break; case FOAM_SFlo:(*pDataObj)=(DataObj)(((FiSFlo *)((
&expr)->fiArr)) + (elem.fiSInt)); break; case FOAM_DFlo
:(*pDataObj)=(DataObj)(((FiDFlo *)((&expr)->fiArr)) + (
elem.fiSInt)); break; case FOAM_Word:(*pDataObj)=(DataObj)(((
FiWord *)((&expr)->fiArr)) + (elem.fiSInt)); break; case
FOAM_BInt:(*pDataObj)=(DataObj)(((FiBInt *)((&expr)->
fiArr)) + (elem.fiSInt)); break; default: fintWhere(((int) 0)
);bug("fintAGetElemRef: type %d unimplemented.", (int)type); }
}
;
5224
5225 myType = type;
5226
5227 break;
5228 }
5229
5230 case FOAM_RRElt: {
5231 bug("fintGetReference: FOAM_RRElt not implemented");
5232 break;
5233 }
5234
5235 case FOAM_RElt: {
5236 int slot;
5237 union dataObj expr;
5238
5239 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5240 fintTypedEval(&expr, FOAM_Rec){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Rec
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Rec || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5240); } while (0); }
;
5241 fintGetInt(fmt, slot){ switch (fmt) { case 0: { String _s = fintGetn(4); (slot) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slot) = tape[ip++]); break
; default: (slot) = (fmt) - 2; break; } }
;
5242
5243 assert((DataObj)(expr.fiRec)!=NULL)do { if (!((DataObj)(expr.fiRec)!=((void*)0))) _do_assert(("(DataObj)(expr.fiRec)!=NULL"
),"fint.c",5243); } while (0)
;
5244 *pDataObj = ((DataObj)(expr.fiRec)) + slot;
5245
5246 myType = fmtType0(n, slot)(((unit)->lexLevels)[(n)].fmtLex[(slot)].type);
5247
5248 break;
5249 }
5250
5251 case FOAM_IRElt: {
5252 int slot;
5253 union dataObj expr;
5254
5255 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5256 fintTypedEval(&expr, FOAM_TR){ dataType type = fintEval(&expr); do { if (!(type == FOAM_TR
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_TR || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5256); } while (0); }
;
5257 fintGetInt(fmt, slot){ switch (fmt) { case 0: { String _s = fintGetn(4); (slot) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slot) = tape[ip++]); break
; default: (slot) = (fmt) - 2; break; } }
;
5258
5259
5260 assert((DataObj)(expr.fiTR) != NULL)do { if (!((DataObj)(expr.fiTR) != ((void*)0))) _do_assert(("(DataObj)(expr.fiTR) != NULL"
),"fint.c",5260); } while (0)
;
5261 *pDataObj = ((DataObj)(expr.fiTR)) + slot;
5262
5263 myType = fmtType0(n, slot + 1)(((unit)->lexLevels)[(n)].fmtLex[(slot + 1)].type);
5264
5265 break;
5266 }
5267 case FOAM_TRElt: {
5268 long slot;
5269 union dataObj expr, idx;
5270 int isz, asz, sz;
5271
5272 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5273 fintTypedEval(&expr, FOAM_TR){ dataType type = fintEval(&expr); do { if (!(type == FOAM_TR
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_TR || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5273); } while (0); }
;
5274 fintTypedEval(&idx, FOAM_SInt){ dataType type = fintEval(&idx); do { if (!(type == FOAM_SInt
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_SInt || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5274); } while (0); }
;
5275 fintGetInt(fmt, slot){ switch (fmt) { case 0: { String _s = fintGetn(4); (slot) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slot) = tape[ip++]); break
; default: (slot) = (fmt) - 2; break; } }
;
5276 sz = fintUnitLexsCount(unit,n)(((unit)->lexLevels[(n)]).fmtLexsCount) - 1;
5277 isz = lexFormat(n, int0)(((unit)->lexLevels)[(n)].fmtLex[(((int) 0))].format);
5278 asz = sz - isz;
5279
5280 myType = fmtType0(n, slot + isz + 1)(((unit)->lexLevels)[(n)].fmtLex[(slot + isz + 1)].type);
5281 slot = isz + asz*idx.fiSInt + slot;
5282
5283 assert((DataObj)(expr.fiTR) != NULL)do { if (!((DataObj)(expr.fiTR) != ((void*)0))) _do_assert(("(DataObj)(expr.fiTR) != NULL"
),"fint.c",5283); } while (0)
;
5284 *pDataObj = ((DataObj)(expr.fiTR)) + slot;
5285
5286
5287 break;
5288 }
5289
5290 case FOAM_CEnv: {
5291 union dataObj clos;
5292
5293 fintTypedEval(&clos, FOAM_Clos){ dataType type = fintEval(&clos); do { if (!(type == FOAM_Clos
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Clos || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5293); } while (0); }
;
5294 *pDataObj = (DataObj) &clos.fiClos->env;
5295 myType = FOAM_Env;
5296 break;
5297 }
5298
5299 case FOAM_CProg: {
5300 union dataObj clos;
5301
5302 fintTypedEval(&clos, FOAM_Clos){ dataType type = fintEval(&clos); do { if (!(type == FOAM_Clos
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Clos || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5302); } while (0); }
;
5303 *pDataObj = (DataObj) &clos.fiClos->prog;
5304 myType = FOAM_Prog;
5305 break;
5306 }
5307
5308 case FOAM_EInfo: {
5309 union dataObj env;
5310
5311 fintTypedEval(&env, FOAM_Env){ dataType type = fintEval(&env); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5311); } while (0); }
;
5312 *pDataObj = (DataObj) &(env.fiEnv->info);
5313 myType = FOAM_Word;
5314 break;
5315 }
5316
5317 case FOAM_EElt: {
5318 int format, lev, n, i;
5319 FiEnv env;
5320 union dataObj expr;
5321 dataType type;
5322
5323 fintGetInt(fmt, format){ switch (fmt) { case 0: { String _s = fintGetn(4); (format) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((format) = tape[ip++])
; break; default: (format) = (fmt) - 2; break; } }
;
5324 fintTypedEval(&expr, FOAM_Env){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Env
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Env || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5324); } while (0); }
;
5325 fintGetInt(fmt, lev){ switch (fmt) { case 0: { String _s = fintGetn(4); (lev) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((lev) = tape[ip++]); break
; default: (lev) = (fmt) - 2; break; } }
;
5326 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5327
5328 env = expr.fiEnv;
5329 for (i = 0; i < lev; i++) {
5330 env = env->next;
5331 hardAssert(env)do { if (!(env)) fintHardAssert("env", "fint.c", 5331); } while
(0)
;
5332 }
5333
5334 type = fmtType0(format, n)(((unit)->lexLevels)[(format)].fmtLex[(n)].type);
5335 /* !! now the offset is ignored */
5336 *pDataObj = ((DataObj)(env->level)) + n;
5337
5338 myType = type;
5339
5340 break;
5341 }
5342 case FOAM_PRef: {
5343 union dataObj expr;
5344 int n;
5345
5346 fintGetInt(fmt, n){ switch (fmt) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fmt) - 2; break; } }
;
5347 assert(n==0)do { if (!(n==0)) _do_assert(("n==0"),"fint.c",5347); } while
(0)
;
5348 fintTypedEval(&expr, FOAM_Prog){ dataType type = fintEval(&expr); do { if (!(type == FOAM_Prog
|| type == FOAM_Word || type == FOAM_Nil)) _do_assert(("type == FOAM_Prog || type == FOAM_Word || type == FOAM_Nil"
),"fint.c",5348); } while (0); }
;
5349 /* $$!! NOW WILL NOT WORK */
5350 *pDataObj = (DataObj) &(expr.progInfo->_progInfo);
5351 myType = FOAM_SInt;
5352 break;
5353 }
5354
5355 case FOAM_Values: {
5356 dataType type;
5357
5358 fintGetInt(fmt, argc){ switch (fmt) { case 0: { String _s = fintGetn(4); (argc) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fmt) - 2; break; } }
;
5359 *pDataObj = fintAlloc(DataObj, argc)((DataObj) memset(stoAlloc(0, sizeof(DataObj) * (argc)), 0, sizeof
(DataObj) * (argc)))
;
5360
5361 for (n = 0; n < argc; n++)
5362 type = fintGetReference((((Ref) *pDataObj) + n));
5363
5364 myType = FOAM_NOp;
5365 break;
5366 }
5367 default:
5368 bug("reference to %d unimplemented...", tag);
5369 NotReached(myType = FOAM_Nil){(void)bug("Not supposed to reach line %d in file: %s\n",5369
, "fint.c");}
;
5370 }
5371
5372 return myType;
5373}
5374
5375localstatic void
5376fintSetMFmt(DataObj ref, DataObj expr)
5377{
5378 int i, n;
5379 int fmt = expr->mFmt->fmt;
5380 DataObj values = expr->mFmt->values;
5381
5382
5383 /* Hack, due to bad foam generation */
5384 if (!values) return;
5385
5386
5387 /* Check that old-style catch expressions are dead */
5388 hardAssert(fmt >= 0)do { if (!(fmt >= 0)) fintHardAssert("fmt >= 0", "fint.c"
, 5388); } while (0)
;
5389
5390
5391 /* How many fields in this multi? */
5392 n = fintUnitLexsCount(unit,fmt)(((unit)->lexLevels[(fmt)]).fmtLexsCount);
5393
5394
5395 /* Copy each value into its destination reference */
5396 for (i = 0; i < n; i++)
5397 fintSet(fmtType0(fmt, i), ((Ref) ref)[i], values[i]){ do { if (!(((Ref) ref)[i] != ((void*)0))) _do_assert(("((Ref) ref)[i] != NULL"
),"fint.c",5397); } while (0); switch ((int)(((unit)->lexLevels
)[(fmt)].fmtLex[(i)].type)) { case FOAM_Char: *(FiChar *)(((Ref
) ref)[i]) = (values[i]).fiChar; break; case FOAM_Bool: (((Ref
) ref)[i])->fiBool = (values[i]).fiBool; break; case FOAM_Byte
: (((Ref) ref)[i])->fiByte = (values[i]).fiByte; break; case
FOAM_HInt: (((Ref) ref)[i])->fiHInt = (values[i]).fiHInt;
break; case FOAM_SInt: (((Ref) ref)[i])->fiSInt = (values
[i]).fiSInt; break; case FOAM_SFlo: (((Ref) ref)[i])->fiSFlo
= (values[i]).fiSFlo; break; case FOAM_DFlo: (((Ref) ref)[i]
)->fiDFlo = (values[i]).fiDFlo; break; case FOAM_Word: (((
Ref) ref)[i])->fiWord = (values[i]).fiWord; break; case FOAM_Arb
: (((Ref) ref)[i])->fiArb = (values[i]).fiArb; break; case
FOAM_Ptr: (((Ref) ref)[i])->fiPtr = (values[i]).fiPtr; break
; case FOAM_Rec: (((Ref) ref)[i])->fiRec = (values[i]).fiRec
; break; case FOAM_Arr: (((Ref) ref)[i])->fiArr = (values[
i]).fiArr; break; case FOAM_TR: (((Ref) ref)[i])->fiTR = (
values[i]).fiTR; break; case FOAM_Prog: (((Ref) ref)[i])->
fiProgPos=(values[i]).fiProgPos; break; case FOAM_Clos: (((Ref
) ref)[i])->fiClos = (values[i]).fiClos; break; case FOAM_Gener
: (((Ref) ref)[i])->fiGener = (values[i]).fiGener; break; case
FOAM_GenIter: (((Ref) ref)[i])->fiGenIter = (values[i]).fiGenIter
; break; case FOAM_Env: (((Ref) ref)[i])->fiEnv = (values[
i]).fiEnv; break; case FOAM_NOp: fintSetMFmt((((Ref) ref)[i])
, &(values[i])); break; case FOAM_Nil: (((Ref) ref)[i])->
_fiNil = (values[i])._fiNil; break; case FOAM_BInt: (((Ref) ref
)[i])->fiBInt = (Ptr) (bintCopy((BInt) (values[i]).fiBInt)
); break; default: fintWhere(((int) 0));bug("fintSet: type %d unimplemented."
, (int)(((unit)->lexLevels)[(fmt)].fmtLex[(i)].type)); } }
;
5398
5399
5400 /* Clean up */
5401 fintFree(values)stoFree((values));
5402 fintFree(expr->mFmt)stoFree((expr->mFmt));
5403}
5404
5405localstatic dataType
5406fintDoCall0(DataObj clos, DataObj retDataObj)
5407{
5408 return fintDoCall(clos, retDataObj, int0((int) 0));
5409}
5410
5411localstatic dataType
5412fintDoCall1(DataObj clos, DataObj retDataObj, DataObj arg1)
5413{
5414 return fintDoCall(clos, retDataObj, 1, arg1);
5415}
5416
5417localstatic dataType
5418fintDoCall(DataObj clos, DataObj retDataObj, int argc, ...)
5419{
5420 DataObj *argv;
5421 dataType type;
5422 va_list argp;
5423 int i;
5424
5425 argv = (DataObj *) stoAlloc(OB_Other0, argc * sizeof(DataObj));
5426
5427 va_start(argp, argc)__builtin_va_start(argp, argc);
5428 for (i = 0; i<argc; i++) argv[i] = va_arg(argp, DataObj)__builtin_va_arg(argp, DataObj);
5429 va_end(argp)__builtin_va_end(argp);
5430
5431 type = fintDoCallN(clos, retDataObj, argc, argv);
5432 stoFree(argv);
5433
5434 return type;
5435}
5436
5437localstatic dataType
5438fintDoCallN(DataObj clos, DataObj retDataObj, int argc, DataObj *argv)
5439{
5440 ProgInfo prog0 = (ProgInfo) clos->fiClos->prog;
5441 FiEnv env = clos->fiClos->env;
5442 DataObj sp0;
5443 DataObj oldStack;
5444 int nFluids, i;
5445 UByte denv;
5446
5447 stackAlloc(sp0, 0 + PAR_OFFSET){ if (sp + 0 + 10 >= stack + 3000 - 11) stackChain(0 + 10)
; (sp0) = sp; sp += (0 + 10); }
;
5448 oldStack = stack;
5449
5450 /* NB all arguments are words, right? */
5451 for (i = 0; i < argc; i++)
5452 fintSet(FOAM_Word, sp0 + i + PAR_OFFSET, *argv[i]){ do { if (!(sp0 + i + 10 != ((void*)0))) _do_assert(("sp0 + i + 10 != NULL"
),"fint.c",5452); } while (0); switch ((int)FOAM_Word) { case
FOAM_Char: *(FiChar *)(sp0 + i + 10) = (*argv[i]).fiChar; break
; case FOAM_Bool: (sp0 + i + 10)->fiBool = (*argv[i]).fiBool
; break; case FOAM_Byte: (sp0 + i + 10)->fiByte = (*argv[i
]).fiByte; break; case FOAM_HInt: (sp0 + i + 10)->fiHInt =
(*argv[i]).fiHInt; break; case FOAM_SInt: (sp0 + i + 10)->
fiSInt = (*argv[i]).fiSInt; break; case FOAM_SFlo: (sp0 + i +
10)->fiSFlo = (*argv[i]).fiSFlo; break; case FOAM_DFlo: (
sp0 + i + 10)->fiDFlo = (*argv[i]).fiDFlo; break; case FOAM_Word
: (sp0 + i + 10)->fiWord = (*argv[i]).fiWord; break; case FOAM_Arb
: (sp0 + i + 10)->fiArb = (*argv[i]).fiArb; break; case FOAM_Ptr
: (sp0 + i + 10)->fiPtr = (*argv[i]).fiPtr; break; case FOAM_Rec
: (sp0 + i + 10)->fiRec = (*argv[i]).fiRec; break; case FOAM_Arr
: (sp0 + i + 10)->fiArr = (*argv[i]).fiArr; break; case FOAM_TR
: (sp0 + i + 10)->fiTR = (*argv[i]).fiTR; break; case FOAM_Prog
: (sp0 + i + 10)->fiProgPos=(*argv[i]).fiProgPos; break; case
FOAM_Clos: (sp0 + i + 10)->fiClos = (*argv[i]).fiClos; break
; case FOAM_Gener: (sp0 + i + 10)->fiGener = (*argv[i]).fiGener
; break; case FOAM_GenIter: (sp0 + i + 10)->fiGenIter = (*
argv[i]).fiGenIter; break; case FOAM_Env: (sp0 + i + 10)->
fiEnv = (*argv[i]).fiEnv; break; case FOAM_NOp: fintSetMFmt((
sp0 + i + 10), &(*argv[i])); break; case FOAM_Nil: (sp0 +
i + 10)->_fiNil = (*argv[i])._fiNil; break; case FOAM_BInt
: (sp0 + i + 10)->fiBInt = (Ptr) (bintCopy((BInt) (*argv[i
]).fiBInt)); break; default: fintWhere(((int) 0));bug("fintSet: type %d unimplemented."
, (int)FOAM_Word); } }
;
5453
5454 sp = sp0;
5455
5456 stackFrameAlloc(argc){ if (sp + 10 + argc >= stack + 3000 - 11) stackChain(argc
+10); sp->ptr = bp; bp = sp; sp += 2; (sp++)->labels = labels
; (sp++)->fiChar = (char) labelFmt; (sp++)->ptr = locValues
; (sp++)->fiEnv = lexEnv; (sp++)->progInfo = prog; (sp++
)->fiUnit = unit; (sp++)->ptr = fluidValues; (sp++)->
fiGenIter = currGenIter; sp += argc + 1; }
; /* creates a frame for argc param. */
5457 hardAssert(sp < stack + STACK_SIZE + 1)do { if (!(sp < stack + 3000 + 1)) fintHardAssert("sp < stack + STACK_SIZE + 1"
, "fint.c", 5457); } while (0)
;
5458
5459 stackFrameIp(bp)((bp)[1].fiProgPos) = ip;
5460
5461 /* set globals and env for the call */
5462 prog = prog0;
5463 unit = prog->unit;
5464 tape = fintUnitTape(unit)((unit)->tape);
5465 labels = progInfoLabels(prog)((prog)->labels);
5466 labelFmt = progInfoLabelFmt(prog)((prog)->labelFmt);
5467 ip = progInfoSeq(prog)((prog)->fiProgPos);
5468
5469 if (progInfoLocsCount(prog)((prog)->locsCount))
5470 stackAlloc(locValues, progInfoLocsCount(prog)){ if (sp + ((prog)->locsCount) >= stack + 3000 - 11) stackChain
(((prog)->locsCount)); (locValues) = sp; sp += (((prog)->
locsCount)); }
;
5471
5472 nFluids = progInfoDFluidsCount(prog)((prog)->dfluidsCount);
5473
5474 if (nFluids)
5475 fintPushFluids(nFluids);
5476
5477 denv = progInfoDEnv(prog)((prog)->denv)[0];
5478
5479 if (fintUnitLexsCount(unit, denv)(((unit)->lexLevels[(denv)]).fmtLexsCount)) {
5480 lev0 = fintAlloc(union dataObj,((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(denv)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(denv)]).fmtLexsCount))))
5481 fintUnitLexsCount(unit, denv))((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(denv)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(denv)]).fmtLexsCount))))
;
5482 }
5483 else
5484 lev0 = NULL((void*)0);
5485
5486 fintEnvPush(lexEnv, lev0, env){ lexEnv = (FiEnv) ((DataObj) memset(stoAlloc(0, sizeof(struct
_FiEnv) * (1)), 0, sizeof(struct _FiEnv) * (1))); lexEnv->
level = (Ptr) lev0; lexEnv->next = (env); lexEnv->info =
(FiWord) ((void*)0); }
;
5487
5488 (void)fintStmt(retDataObj);
5489
5490 if (nFluids)
5491 fiGlobalFluidStack =
5492 (FiFluidStack) fluidValue(nFluids)(fluidValues[(nFluids)].fiFluid);
5493
5494 stackFrameFree(){ ip = bp[1].fiProgPos; labels = bp[2].labels; labelFmt = (int
) bp[3].fiChar; locValues = bp[4].ptr; lexEnv = bp[5].fiEnv; prog
= bp[6].progInfo; unit = bp[7].fiUnit; fluidValues = bp[8].ptr
; currGenIter = bp[9].fiGenIter; tape = ((unit)->tape); if
(bp < stack || bp >= stack + 3000) { sp = stack[1].ptr
; stack = stack[0].ptr; } else sp = bp; bp = bp->ptr; lev0
= (DataObj) lexEnv->level; }
;
5495
5496 return progInfoRetType(prog)((prog)->retType);
5497
5498}
5499
5500localstatic Bool
5501fintGenerStep(FiGenIter iter)
5502{
5503 DataObj oldStack;
5504 FiEnv env;
5505 DataObj sp0;
5506 union dataObj retVal;
5507 UByte denv;
5508
5509 stackAlloc(sp0, 0 + PAR_OFFSET){ if (sp + 0 + 10 >= stack + 3000 - 11) stackChain(0 + 10)
; (sp0) = sp; sp += (0 + 10); }
;
5510 oldStack = stack;
Value stored to 'oldStack' is never read
5511
5512 stackFrameAlloc(0){ if (sp + 10 + 0 >= stack + 3000 - 11) stackChain(0 +10);
sp->ptr = bp; bp = sp; sp += 2; (sp++)->labels = labels
; (sp++)->fiChar = (char) labelFmt; (sp++)->ptr = locValues
; (sp++)->fiEnv = lexEnv; (sp++)->progInfo = prog; (sp++
)->fiUnit = unit; (sp++)->ptr = fluidValues; (sp++)->
fiGenIter = currGenIter; sp += 0 + 1; }
;
5513 stackFrameIp(bp)((bp)[1].fiProgPos) = ip;
5514 prog = (ProgInfo) iter->prog;
5515 unit = prog->unit;
5516 tape = fintUnitTape(unit)((unit)->tape);
5517 labels = progInfoLabels(prog)((prog)->labels);
5518 ip = progInfoSeq(prog)((prog)->fiProgPos);
5519 env = iter->env;
5520
5521 if (iter->step == -1) {
5522 denv = progInfoDEnv(prog)((prog)->denv)[0];
5523
5524 if (fintUnitLexsCount(unit, denv)(((unit)->lexLevels[(denv)]).fmtLexsCount)) {
5525 DataObj newLev0;
5526 newLev0 = fintAlloc(union dataObj,((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(denv)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(denv)]).fmtLexsCount))))
5527 fintUnitLexsCount(unit, denv))((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(denv)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(denv)]).fmtLexsCount))))
;
5528 iter->env0 = fiEnvPush(newLev0, iter->env)fiEnvPushFun((FiPtr) (newLev0), iter->env);
5529 }
5530 else
5531 iter->env0 = NULL((void*)0);
5532 }
5533
5534 if (iter->step == -1) {
5535 iter->state = (progInfoLocsCount(prog)((prog)->locsCount) ? (FiPtr) fintGenerLocsAlloc(progInfoLocsCount(prog)((prog)->locsCount)) : NULL((void*)0));
5536 }
5537 if (iter->step != -1) {
5538 ip = iter->step;
5539 }
5540
5541 iter->step = 0;
5542 locValues = (DataObj) iter->state;
5543 lev0 = iter->env0 == NULL((void*)0) ? NULL((void*)0) : (DataObj) iter->env0->level;
5544 fintEnvPush(lexEnv, lev0, env){ lexEnv = (FiEnv) ((DataObj) memset(stoAlloc(0, sizeof(struct
_FiEnv) * (1)), 0, sizeof(struct _FiEnv) * (1))); lexEnv->
level = (Ptr) lev0; lexEnv->next = (env); lexEnv->info =
(FiWord) ((void*)0); }
;
5545 currGenIter = iter;
5546 fintStmt(&retVal);
5547
5548 stackFrameFree(){ ip = bp[1].fiProgPos; labels = bp[2].labels; labelFmt = (int
) bp[3].fiChar; locValues = bp[4].ptr; lexEnv = bp[5].fiEnv; prog
= bp[6].progInfo; unit = bp[7].fiUnit; fluidValues = bp[8].ptr
; currGenIter = bp[9].fiGenIter; tape = ((unit)->tape); if
(bp < stack || bp >= stack + 3000) { sp = stack[1].ptr
; stack = stack[0].ptr; } else sp = bp; bp = bp->ptr; lev0
= (DataObj) lexEnv->level; }
;
5549 if (iter->step == 0) {
5550 fintGenerLocsFree((DataObj) iter->state);
5551 }
5552
5553 return iter->step == 0; // (true indicates completed)
5554}
5555
5556DataObj
5557fintGenerLocsAlloc(int sz)
5558{
5559 return (DataObj) stoAlloc(OB_Other0, sizeof(union dataObj) * sz);
5560}
5561
5562void
5563fintGenerLocsFree(DataObj obj)
5564{
5565 stoFree(obj);
5566}
5567/*****************************************************************************
5568 *
5569 * :: Storage management
5570 *
5571 ****************************************************************************/
5572
5573localstatic void
5574unitFree(FintUnit unit)
5575{
5576 fmtGlobalsFree(unit);
5577 fmtConstantsFree(unit);
5578 fmtFluidsFree(unit);
5579 lexLevelsFree(unit);
5580}
5581
5582localstatic Fmt
5583fmtAlloc(int nDecls)
5584{
5585 if (nDecls)
5586 return (Fmt) fintAlloc(struct fmt, nDecls)((DataObj) memset(stoAlloc(0, sizeof(struct fmt) * (nDecls)),
0, sizeof(struct fmt) * (nDecls)))
;
5587 return NULL((void*)0);
5588}
5589
5590localstatic void
5591fmtFree(Fmt fmt)
5592{
5593 if (fmt) {
5594 strFree(fmtId(fmt)((fmt)->id));
5595 stoFree(fmt);
5596 }
5597}
5598
5599localstatic void
5600fmtGlobalsFree(FintUnit unit)
5601{
5602 ShDataObj * globValues = fintUnitGlobValues(unit)((unit)->globValues);
5603 int globCount = fintUnitGlobsCount(unit)((unit)->globsCount);
5604 int n;
5605
5606 for (n = 0; n < globCount; n++)
5607 shDataObjFree(globValues[n]);
5608
5609 fmtFree(fintUnitGlobs(unit)((unit)->fmtGlobs));
5610 fintFree0(globValues)if (globValues) stoFree(globValues);
5611}
5612
5613localstatic void
5614fmtConstantsFree(FintUnit unit)
5615{
5616 int n;
5617
5618 for (n = 0; n < fintUnitConstsCount(unit)((unit)->constsCount); n++)
5619 if (constType(n)((((unit)->fmtConsts)[(n)]).type) == FOAM_Prog) {
5620 ProgInfo p = constValue(n)((unit)->constValues[(n)]).progInfo;
5621
5622 fintFree0(progInfoLabels(p))if (((p)->labels)) stoFree(((p)->labels));
5623 fintFree0(progInfoFmtLoc(p))if (((p)->fmtLoc)) stoFree(((p)->fmtLoc));
5624 fintFree0(progInfoFmtPar(p))if (((p)->fmtPar)) stoFree(((p)->fmtPar));
5625 fintFree0(progInfoDFluid(p))if (((p)->dfluid)) stoFree(((p)->dfluid));
5626 fintFree0(progInfoDEnv(p))if (((p)->denv)) stoFree(((p)->denv));
5627
5628 fintFree(p)stoFree((p));
5629 }
5630
5631
5632 fmtFree(fintUnitConsts(unit)((unit)->fmtConsts));
5633}
5634
5635localstatic void
5636fmtFluidsFree(FintUnit unit)
5637{
5638 fmtFree(fintUnitFluids(unit)((unit)->fmtFluids));
5639}
5640
5641localstatic void
5642lexLevelsFree(FintUnit unit)
5643{
5644 LexLevels l = fintUnitLexLevels(unit)((unit)->lexLevels);
5645 int levCount = fintUnitLexLevelsCount(unit)((unit)->lexLevelsCount);
5646 int n;
5647
5648 for (n = 0; n < levCount ; n++)
5649 fmtFree((Fmt) l->fmtLex);
5650
5651 fintFree0(l)if (l) stoFree(l);
5652
5653}
5654
5655localstatic void
5656fintInitForeignGlobValue(DataObj retDataObj, int n)
5657{
5658 if (!fintForeignTable[n].isConst)
5659 retDataObj->fiSInt =(FiSInt) fintForeignTable[n].funct;
5660 else {
5661 switch(fintForeignTable[n].funct) {
5662
5663 case FINT_FOREIGN_osIoRdMode:
5664 retDataObj->fiArr = (FiArr) osIoRdMode;
5665 break;
5666 case FINT_FOREIGN_osIoWrMode:
5667 retDataObj->fiArr = (FiArr) osIoWrMode;
5668 break;
5669 case FINT_FOREIGN_osIoApMode:
5670 retDataObj->fiArr = (FiArr) osIoApMode;
5671 break;
5672 case FINT_FOREIGN_osIoRbMode:
5673 retDataObj->fiArr = (FiArr) osIoRbMode;
5674 break;
5675 case FINT_FOREIGN_osIoWbMode:
5676 retDataObj->fiArr = (FiArr) osIoWbMode;
5677 break;
5678 case FINT_FOREIGN_osIoAbMode:
5679 retDataObj->fiArr = (FiArr) osIoAbMode;
5680 break;
5681 case FINT_FOREIGN_osIoRubMode:
5682 retDataObj->fiArr = (FiArr) osIoRubMode;
5683 break;
5684 case FINT_FOREIGN_osIoWubMode:
5685 retDataObj->fiArr = (FiArr) osIoWubMode;
5686 break;
5687 case FINT_FOREIGN_osIoAubMode:
5688 retDataObj->fiArr = (FiArr) osIoAubMode;
5689 break;
5690
5691 case FINT_FOREIGN_osObjectFileType:
5692 retDataObj->fiArr = (FiArr) osObjectFileType;
5693 break;
5694 case FINT_FOREIGN_osExecFileType:
5695 retDataObj->fiArr = (FiArr) osExecFileType;
5696 break;
5697
5698 case FINT_FOREIGN_osFnameNParts:
5699 retDataObj->fiSInt = (FiSInt) osFnameNParts;
5700 break;
5701
5702 default:
5703 bug("fintForeignInitGlobalValue: bad foreign const.");
5704 }
5705 }
5706}
5707
5708localstatic ShDataObj
5709shDataObjAdd(AInt type, String id, int protocol, int globNum, FintUnit curUnit)
5710{
5711 int n = 0;
5712 ShDataObj new;
5713 Bool found = false((int) 0);
5714 FintUnit u = NULL((void*)0);
5715 String id_orig = NULL((void*)0);
5716 new = shDataObjFind(type, id, protocol);
5717
5718 /* !! Hack: resolving globals we look also in the current unit.
5719 * This because a bug in genfoam generate 2 globals with the
5720 * same name in the same unit.
5721 * Once the bug has been fixed, the globNum par. can be removed
5722 * hack 03450
5723 */
5724
5725 if (new == NULL((void*)0)) {
5726 u = curUnit;
5727 for (n = 0; n < globNum; n++)
5728 if (!strcmp(id, fintUnitGlobs(u)((u)->fmtGlobs)[n].id)) {
5729 new = fintUnitGlobValues(u)((u)->globValues)[n];
5730 new->refCounter++;
5731 break;
5732 }
5733 }
5734
5735 if (new != NULL((void*)0)) {
5736 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut, "(linked glob %s)\n", id);
5737 return new;
5738 }
5739
5740
5741 /*
5742 * Create an new shared object initialised with the value
5743 * -1 (see next paragraph). We expect that the object will
5744 * be initialised with its correct value later on.
5745 *
5746 * The main exceptions to this are foreign imports (usually
5747 * the target of a PCall). If we recognise the name of the
5748 * identifer as a foreign import the shared object will be
5749 * initialised with its index in fintForeignTable. Since 0
5750 * is a valid index, we use -1 to indicate failure.
5751 *
5752 * Future work: keep the unresolved identifier names around
5753 * somewhere handy so that fintEval can give a better bug
5754 * report when it hits an unrecognised PCall.
5755 */
5756 new = (ShDataObj) stoAlloc(OB_Other0, sizeof(struct shDataObj));
5757 new->dataObj.fiWord = -1; /* Don't use 0 here!!! */
5758 new->refCounter = 1;
5759
5760 /* Handle mangled names if necessary */
5761 if (protocol == FOAM_Proto_C) {
5762 String tmp = strchr(id, '-');
5763 if (tmp) {
5764 id_orig = id;
5765 id = strCopy(id);
5766 id[tmp - id_orig] = '\0';
5767 }
5768 }
5769 if (protocol == FOAM_Proto_Init)
5770 lazyLibGet(id);
5771 else {
5772 found = false((int) 0);
5773 for (n=0; fintForeignTable[n].string; n++)
5774 if (id[0] == fintForeignTable[n].string[0] &&
5775 !strcmp(id, fintForeignTable[n].string)) {
5776 found = true1;
5777 break;
5778 }
5779
5780 if (found) {
5781 fintInitForeignGlobValue(&(new->dataObj), n);
5782 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut, "(Resolved foreign %s)\n",
5783 fintForeignTable[n].string);
5784 } else {
5785 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut, "Could not resolve: %s\n", id);
5786 }
5787 }
5788
5789 if (id_orig)
5790 strFree(id);
5791
5792 return new;
5793}
5794
5795localstatic ShDataObj
5796shDataObjFind(AInt type, String id, int protocol)
5797{
5798 ShDataObj obj = NULL((void*)0);
5799 FintUnitList ul;
5800 FintUnit u;
5801 int m, n;
5802
5803 /* NB: Should worry about protocol and check type */
5804 for (ul = cdr(fintUnitList)((fintUnitList)->rest); ul; ul = cdr(ul)((ul)->rest)) {
5805 u = car(ul)((ul)->first);
5806 m = fintUnitGlobsCount(u)((u)->globsCount);
5807 for (n = 0; n < m ; n++) {
5808 if (strcmp(id, fintUnitGlobs(u)((u)->fmtGlobs)[n].id) == 0) {
5809 obj = fintUnitGlobValues(u)((u)->globValues)[n];
5810 obj->refCounter++;
5811 }
5812 }
5813 if (obj) break;
5814 }
5815 return obj;
5816}
5817
5818localstatic ShDataObj
5819shDataObjFindBis(AInt type, String id, int protocol)
5820{
5821 ShDataObj obj = NULL((void*)0);
5822 FintUnitList ul;
5823 FintUnit u;
5824 int m, n;
5825
5826 /* NB: Should worry about protocol and check type */
5827 /* this one looks in the current one too
5828 * see hack 03450
5829 */
5830 for (ul = fintUnitList; ul; ul = cdr(ul)((ul)->rest)) {
5831 u = car(ul)((ul)->first);
5832 m = fintUnitGlobsCount(u)((u)->globsCount);
5833 for (n = 0; n < m ; n++) {
5834 if (strcmp(id, fintUnitGlobs(u)((u)->fmtGlobs)[n].id) == 0) {
5835 obj = fintUnitGlobValues(u)((u)->globValues)[n];
5836 obj->refCounter++;
5837 }
5838 }
5839 if (obj) break;
5840 }
5841 return obj;
5842}
5843
5844
5845localstatic void
5846shDataObjFree(ShDataObj obj)
5847{
5848 if (obj->refCounter-- == 0) fintFree(obj)stoFree((obj));
5849}
5850
5851
5852localstatic void
5853stackChain(int num)
5854{
5855 if (num > STACK_SIZE3000) bug("Stack Growth Excessive!");
5856 if (!stack[STACK_SIZE3000].ptr) {
5857 DataObj newStack = fintAlloc(union dataObj, STACK_SIZE + 1)((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * (3000 +
1)), 0, sizeof(union dataObj) * (3000 + 1)))
;
5858
5859 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut,"Allocating a new stack of size %d\n",
5860 STACK_SIZE3000);
5861
5862 newStack[STACK_SIZE3000].ptr = 0;
5863 stack[STACK_SIZE3000].ptr = newStack;
5864 newStack[0].ptr = stack;
5865 newStack[1].ptr = sp;
5866 sp = newStack + 2;
5867 stack = newStack;
5868 }
5869 else {
5870 stack = stack[STACK_SIZE3000].ptr;
5871 stack[1].ptr = sp;
5872 sp = stack + 2;
5873 }
5874
5875 return;
5876}
5877
5878/****************************************************************************
5879 *
5880 * Unit loading procedures
5881 *
5882 ***************************************************************************/
5883
5884
5885/* Assumes that the next tag in tape is DDecl. Reads all the decls and put them
5886 * in the fmt passed. Returns the number of decls read.
5887 */
5888/* "tswi" or "tswibp" */
5889localstatic int
5890fintReadFmt(Fmt * pFmt)
5891{
5892 int tag, fm, argc, n, i, slen;
5893 Fmt fmt;
5894
5895 fintGetTagFmtArgc(tag, fm, argc){ { (((tag)) = tape[ip++]); (fm) = (((tag))<(FOAM_VECTOR_START
)? 0:((((tag))-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); (tag) = ((((tag))) - (((fm)))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); } if ((foamInfoTable [(int)(tag)-(int)FOAM_START]).argc ==
(-1)) { switch (fm) { case 0: { String _s = fintGetn(4); (argc
) = (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (fm) - 2; break; } } else (argc) = (foamInfoTable
[(int)(tag)-(int)FOAM_START]).argc; }
;
5896 hardAssert(tag == FOAM_DDecl)do { if (!(tag == FOAM_DDecl)) fintHardAssert("tag == FOAM_DDecl"
, "fint.c", 5896); } while (0)
;
5897 argc -= 1;
5898 fmt = fmtAlloc(argc);
5899 /* Usage field */
5900 fintGetByte(n)((n) = tape[ip++]);
5901 *pFmt = fmt;
5902
5903 for (i = 0; i < argc; i++, fmt++) {
5904 /* Tag */
5905 fintGetTagFmt(tag, fm){ ((tag) = tape[ip++]); fm = ((tag)<(FOAM_VECTOR_START)? 0
:(((tag)-(FOAM_VECTOR_START))/(FOAM_LIMIT - (FOAM_VECTOR_START
)))); tag = (((tag)) - ((fm))*(FOAM_LIMIT - (FOAM_VECTOR_START
))); }
;
5906 hardAssert(tag == FOAM_Decl || tag == FOAM_GDecl)do { if (!(tag == FOAM_Decl || tag == FOAM_GDecl)) fintHardAssert
("tag == FOAM_Decl || tag == FOAM_GDecl", "fint.c", 5906); } while
(0)
;
5907 /* Type */
5908 fintGetByte(n)((n) = tape[ip++]);
5909 fmtType(fmt)((fmt)->type) = FOAM_START + n;
5910 /* id */
5911 fintGetInt(fm, slen){ switch (fm) { case 0: { String _s = fintGetn(4); (slen) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slen) = tape[ip++]); break
; default: (slen) = (fm) - 2; break; } }
;
5912 fmtId(fmt)((fmt)->id) = fintRdChars(slen);
5913 /* symeIndex -- ignore */
5914 fintGetSInt(n){ String _s = fintGetn(4); (n) = (int) (((((ULong) _s[0])&
((1<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8))|(((((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[
3])&((1<<8)-1))<<8))<<(2*8))); }
;
5915 /* Format */
5916 fintGetInt(fm, n){ switch (fm) { case 0: { String _s = fintGetn(4); (n) = (int
) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s[1]
)&((1<<8)-1))<<8))|(((((ULong) _s[2])&((1
<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (fm) - 2; break; } }
;
5917 fmtFormat(fmt)((fmt)->format) = n;
5918 if (tag == FOAM_Decl) {
5919 /* Default protocol */
5920 fmtProtocol(fmt)((fmt)->protocol) = FOAM_Proto_Foam;
5921 } else {
5922 /* Direction -- ignore */
5923 fintGetByte(n)((n) = tape[ip++]);
5924 /* Protocol */
5925 fintGetByte(n)((n) = tape[ip++]);
5926 fmtProtocol(fmt)((fmt)->protocol) = FOAM_PROTO_START + n;
5927 }
5928 }
5929
5930 return argc;
5931}
5932
5933localstatic void
5934fintLoadGlobalsFmt(FintUnit unit)
5935{
5936 int n, i;
5937
5938 n = fintReadFmt(&fintUnitGlobs(unit)((unit)->fmtGlobs));
5939 fintUnitGlobsCount(unit)((unit)->globsCount) = n;
5940
5941 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut, "Read globals: %d\n", n);
5942
5943 fintUnitGlobValues(unit)((unit)->globValues) = (ShDataObj *)
5944 fintAlloc(ShDataObj, n)((DataObj) memset(stoAlloc(0, sizeof(ShDataObj) * (n)), 0, sizeof
(ShDataObj) * (n)))
;
5945
5946 for (i = 0; i < n; i++)
5947 fintUnitGlobValues(unit)((unit)->globValues)[i] =
5948 shDataObjAdd(globType(i)((((unit)->fmtGlobs)[(i)]).type), globId(i)((((unit)->fmtGlobs)[(i)]).id),
5949 globProtocol(i)((((unit)->fmtGlobs)[(i)]).protocol), i, unit);
5950}
5951
5952localstatic void
5953fintLoadConstantsFmt(FintUnit unit)
5954{
5955 int n;
5956
5957 n = fintReadFmt(&fintUnitConsts(unit)((unit)->fmtConsts));
5958 fintUnitConstsCount(unit)((unit)->constsCount) = n;
5959 fintUnitConstValues(unit)((unit)->constValues) = (DataObj)
5960 stoAlloc(OB_Other0, sizeof(*(unit->constValues)) * n);
5961
5962 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut, "Read constants: %d\n", n);
5963
5964}
5965
5966localstatic void
5967fintLoadFluidsFmt(FintUnit unit)
5968{
5969 int n;
5970
5971 skipProg(NULL((void*)0), NULL((void*)0)); /* skip the unused format */
5972 n = fintReadFmt(&fintUnitFluids(unit)((unit)->fmtFluids));
5973 fintUnitFluidsCount(unit)((unit)->fluidsCount) = n;
5974
5975 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut, "Read fluids: %d\n", n);
5976}
5977
5978localstatic void
5979fintLoadLexLevels(FintUnit unit, int nLexLevels)
5980{
5981 int n, j;
5982 LexLevels lexLevels;
5983 Fmt * pFmt;
5984
5985 fintUnitLexLevelsCount(unit)((unit)->lexLevelsCount) = nLexLevels;
5986 lexLevels = (LexLevels) fintAlloc(lexLevel, nLexLevels)((DataObj) memset(stoAlloc(0, sizeof(lexLevel) * (nLexLevels)
), 0, sizeof(lexLevel) * (nLexLevels)))
;
5987
5988 fintUnitLexLevels(unit)((unit)->lexLevels) = lexLevels;
5989
5990 for (j = 0; j < POS_LEX_FMT4 ; j++) {
5991 lexLevels[j].fmtLexsCount = 0;
5992 lexLevels[j].fmtLex = 0;
5993 }
5994
5995 for (; j < nLexLevels ; j++) {
5996 pFmt = &(lexLevels[j].fmtLex);
5997 n = fintReadFmt(pFmt);
5998 lexLevels[j].fmtLexsCount = n;
5999
6000 fintLinkDEBUGif (!fintLinkDebug) { } else afprintf(dbOut, "Level: %d, read %d lexicals\n", j, n);
6001 }
6002}
6003
6004/****************************************************************************
6005 *
6006 * SkipProg
6007 *
6008 ***************************************************************************/
6009
6010/* If pLabels == NULL, then skipProg'll ignore labels processing
6011 */
6012localstatic void
6013skipProg(FiProgPos * pLabels, int * pLabelsCount)
6014{
6015 int fi, si, tag, argc, format, bi;
6016 String argf;
6017 Bool neg;
6018 Bool isNary;
6019
6020 fintGetByte(tag)((tag) = tape[ip++]);
6021 format = FOAM_FORMAT_GET(tag)((tag)<(FOAM_VECTOR_START)? 0:(((tag)-(FOAM_VECTOR_START))
/(FOAM_LIMIT - (FOAM_VECTOR_START))))
;
6022 tag = FOAM_FORMAT_REMOVE(tag, format)((tag) - (format)*(FOAM_LIMIT - (FOAM_VECTOR_START)));
6023
6024 isNary = (foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).argc == FOAM_NARY(-1));
6025
6026 if (!isNary)
6027 argc = foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).argc;
6028 else
6029 fintGetInt(format, argc){ switch (format) { case 0: { String _s = fintGetn(4); (argc)
= (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((argc) = tape[ip++]); break
; default: (argc) = (format) - 2; break; } }
;
6030
6031 if (tag == FOAM_Label && pLabels) {
6032 long n;
6033 fintGetInt(format, n){ switch (format) { case 0: { String _s = fintGetn(4); (n) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (format) - 2; break; } }
;
6034 pLabels[n] = ip; /* next instruction */
6035 *pLabelsCount += 1;
6036 return;
6037 }
6038
6039 argf = foamInfo(tag)(foamInfoTable [(int)(tag)-(int)FOAM_START]).argf;
6040
6041 for (fi = si = 0; si < argc; fi++, si++) {
6042 int af = argf[fi], slen;
6043 long n;
6044 if (af == '*') af = argf[--fi];
6045 switch (argf[fi]) {
6046 case 't':
6047 fintGetByte(n)((n) = tape[ip++]);
6048 break;
6049 case 'o':
6050#if SMALL_BVAL_TAGS
6051 fintGetByte(n)((n) = tape[ip++]);
6052#else
6053 fintGetHInt(n){ String _s = fintGetn(2); (n) = ((((ULong) _s[0])&((1<<
8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<8)); }
;
6054#endif
6055 break;
6056 case 'p':
6057 fintGetByte(n)((n) = tape[ip++]);
6058 break;
6059 case 'b':
6060 fintGetByte(n)((n) = tape[ip++]);
6061 break;
6062 case 'D':
6063 fintGetByte(n)((n) = tape[ip++]);
6064 break;
6065 case 'h':
6066 fintGetHInt(n){ String _s = fintGetn(2); (n) = ((((ULong) _s[0])&((1<<
8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<8)); }
;
6067 break;
6068 case 'w':
6069 fintGetSInt(n){ String _s = fintGetn(4); (n) = (int) (((((ULong) _s[0])&
((1<<8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<
8))|(((((ULong) _s[2])&((1<<8)-1)) | ((((ULong) _s[
3])&((1<<8)-1))<<8))<<(2*8))); }
;
6070 break;
6071 case 'X':
6072 fintGetInt(int0, n){ switch (((int) 0)) { case 0: { String _s = fintGetn(4); (n)
= (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (((int) 0)) - 2; break; } }
;
6073 break;
6074 case 'F':
6075 fintGetInt(int0, n){ switch (((int) 0)) { case 0: { String _s = fintGetn(4); (n)
= (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (((int) 0)) - 2; break; } }
;
6076 labelFmt = FOAM_FORMAT_FOR(n)((long)(n) <= ((1<<(1*8))-1) ? 1 : 0);
6077 break;
6078 case 'L':
6079 fintGetInt(labelFmt, n){ switch (labelFmt) { case 0: { String _s = fintGetn(4); (n) =
(int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (labelFmt) - 2; break; } }
;
6080 break;
6081 case 'i':
6082 fintGetInt(format, n){ switch (format) { case 0: { String _s = fintGetn(4); (n) = (
int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong) _s
[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((n) = tape[ip++]); break
; default: (n) = (format) - 2; break; } }
;
6083 break;
6084 case 's':
6085 fintGetInt(format, slen){ switch (format) { case 0: { String _s = fintGetn(4); (slen)
= (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slen) = tape[ip++]); break
; default: (slen) = (format) - 2; break; } }
;
6086 ip += slen;
6087 break;
6088 case 'f':
6089 /* foamToSFlo(foam) = fintRdSFloat();*/
6090 ip += XSFLOAT_BYTES6;
6091 break;
6092 case 'd':
6093 /* foamToDFlo(foam) = fintRdDFloat();*/
6094 ip += XDFLOAT_BYTES10;
6095 break;
6096 case 'n': {
6097 fintGetByte(neg)((neg) = tape[ip++]);
6098 fintGetInt(format, slen){ switch (format) { case 0: { String _s = fintGetn(4); (slen)
= (int) (((((ULong) _s[0])&((1<<8)-1)) | ((((ULong
) _s[1])&((1<<8)-1))<<8))|(((((ULong) _s[2])&
((1<<8)-1)) | ((((ULong) _s[3])&((1<<8)-1))<<
8))<<(2*8))); }; break; case 1: ((slen) = tape[ip++]); break
; default: (slen) = (format) - 2; break; } }
;
6099 for (bi = 0; bi < slen; bi++)
6100 fintGetHInt(n){ String _s = fintGetn(2); (n) = ((((ULong) _s[0])&((1<<
8)-1)) | ((((ULong) _s[1])&((1<<8)-1))<<8)); }
;
6101
6102 break;
6103 }
6104 case 'C':
6105 skipProg(pLabels, pLabelsCount);
6106 break;
6107 default:
6108 bugBadCase(argf[fi])bug("Bad case %d (line %d in file %s).", (int) argf[fi], 6108
, "fint.c")
;
6109 }
6110 }
6111 return;
6112}
6113
6114/****************************************************************************
6115 *
6116 * General utility
6117 *
6118 ***************************************************************************/
6119
6120localstatic SFloat
6121fintRdSFloat(void)
6122{
6123 XSFloat * pxs;
6124 SFloat s;
6125
6126 pxs = (XSFloat *) fintGetn(XSFLOAT_BYTES6);
6127 xsfToNative(pxs, &s);
6128
6129 return s;
6130}
6131
6132localstatic DFloat
6133fintRdDFloat(void)
6134{
6135 XDFloat * pxd;
6136 DFloat d;
6137
6138 pxd = (XDFloat *) fintGetn(XDFLOAT_BYTES10);
6139 xdfToNative(pxd, &d);
6140
6141 return d;
6142}
6143
6144localstatic String
6145fintRdChars(int cc)
6146{
6147 String s;
6148
6149 s = strAlloc(cc);
6150 (void)fintGetChars(s, cc)strncpy(s, fintGetn(cc), cc);
6151
6152 return s;
6153}
6154
6155localstatic String
6156fintGetn(Length n)
6157{
6158 UByte *s = tape + ip;
6159 ip += n;
6160 return (String) s;
6161}
6162
6163localstatic void
6164fintPushFluids(int nFluids)
6165{
6166 int i, fluidNo;
6167
6168 stackAlloc(fluidValues, nFluids + 1){ if (sp + nFluids + 1 >= stack + 3000 - 11) stackChain(nFluids
+ 1); (fluidValues) = sp; sp += (nFluids + 1); }
;
6169 fluidValues[nFluids].ptr = (DataObj) fiGlobalFluidStack;
6170
6171 for (i = 0; i < nFluids; i++) {
6172 fluidNo = progInfoDFluid(prog)((prog)->dfluid)[i];
6173 fluidValue(i)(fluidValues[(i)].fiFluid) = fiAddFluid(fluidId(fluidNo)(((unit)->fmtFluids)[(fluidNo)].id));
6174 }
6175}
6176/****************************************************************************
6177 *
6178 * Aldor interface
6179 *
6180 ***************************************************************************/
6181
6182
6183/* Ask confirmation if confirm is on
6184 * Return: true if (the answer is 'y' || confimation is off)
6185 * $$ TODO: change the parameter: must be a compiler message
6186 */
6187Bool
6188fintYesOrNo(String t)
6189{
6190 char c0;
6191
6192 if (!fintConfirm) return true1;
6193
6194 while (true1) {
6195 (void)fprintf(osStdout, "%s", t);
6196 c0 = getchar();
6197 while(getchar() != '\n')
6198 ;
6199
6200 if (c0 == 'y' || c0 == 'Y')
6201 return true1;
6202 else if (c0 == 'n' || c0 == 'N')
6203 return false((int) 0);
6204 else
6205 (void)comsgFPrintf(osStdout, ALDOR_M_FintYesOrNo245);
6206 }
6207 return false((int) 0);
6208}
6209
6210/****************************************************************************
6211 *
6212 * Internal debugging
6213 *
6214 ***************************************************************************/
6215
6216/* Print the backtrace of all stack frames (similar to gdb)
6217 * With a 0 argument prints all the stack
6218 */
6219void
6220fintWhere(int level)
6221{
6222 int n = 0,
6223 l = 1;
6224 DataObj bp0 = bp;
6225
6226 if (level < 0) return;
6227 if (level == 0) level = -1;
6228
6229 if (prog)
6230 (void)fprintf(dbOut, "#%d %8p in <%s> at unit [%s]\n", int0((int) 0),
6231 (void*) bp, prog->name, prog->unit->name);
6232 else
6233 (void)fprintf(dbOut, "(Unknown current prog)\n");
6234
6235 while (n != level && bp0 != stackBase) {
6236 (void)fprintf(dbOut, "#%d %lx in <%s> at unit [%s]\n",
6237 l++,
6238 (ULong)stackFrameIp(bp0)((bp0)[1].fiProgPos),
6239 stackFrameProg(bp0)((bp0)[6].progInfo)->name,
6240 stackFrameProg(bp0)((bp0)[6].progInfo)->unit->name);
6241 bp0 = stackFrameBp(bp0)((bp0)[0].ptr);
6242 n += 1;
6243 }
6244
6245 if (bp != stack)
6246 (void)fprintf(dbOut, "...\n");
6247
6248 return;
6249}
6250
6251
6252void
6253fintCheckCallStack(void)
6254{
6255 DataObj bp0;
6256 bp0 = bp;
6257 while (bp0 != stackBase) {
6258 DataObj bp1;
6259 bp1 = stackFrameBp(bp0)((bp0)[0].ptr);
6260 while (bp1 != stackBase) {
6261 if (bp1 == bp0) bug("Stack is a mess");
6262 bp1 = stackFrameBp(bp1)((bp1)[0].ptr);
6263 }
6264 bp0 = stackFrameBp(bp0)((bp0)[0].ptr);
6265 }
6266}
6267
6268
6269void
6270fintSoftAssert(char * ass, char * filename, int line_num)
6271{
6272 (void)fprintf(dbOut, "Warning: soft assertion failed, file %s line %d: %s\n",
6273 filename, line_num, ass);
6274 return;
6275}
6276
6277void
6278fintHardAssert(char * ass, char * filename, int line_num)
6279{
6280 (void)fprintf(dbOut, "Warning: hard assertion failed, file %s line %d: %s\n",
6281 filename, line_num, ass);
6282 return;
6283}
6284
6285/****************************************************************************
6286 *
6287 * fintExecMainUnit
6288 *
6289 ***************************************************************************/
6290
6291void (*defaultBreakHandler)(int) = 0;
6292void (*defaultFaultHandler)(int) = 0;
6293
6294localstatic Bool
6295fintExecMainUnit(void)
6296{
6297 union dataObj expr;
6298 dataType type = 0;
6299 UByte denv;
6300 int nFluids;
6301 FiBool ok;
6302
6303 OsSignalHandler oldCompFintBreakHandler = NULL((void*)0);
6304 OsSignalHandler oldCompFintFaultHandler = NULL((void*)0);
6305 extern void compFintBreakHandler(int);
6306 extern void compFintFaultHandler(int);
6307
6308 if (fintMode == FINT_LOOP2) {
6309 oldCompFintBreakHandler = defaultBreakHandler;
6310 oldCompFintFaultHandler = defaultFaultHandler;
6311 }
6312
6313 /* This group of statements is needed because might be the case
6314 * that the previous execution has been interrupted from the user
6315 * (Ctrl-C, in example), therefore stack, bp and sp have the values
6316 * that they had when the interrupt occurred.
6317 */
6318
6319 stack = headStack;
6320 bp = headStack;
6321 sp = headStack + 1;
6322 ip = 0;
6323 stackBase = sp;
6324
6325 fintCurrentFormat = emptyFormatSlot4;
6326
6327 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "Starting with bp = %p, sp = %p\n", bp, sp);
6328
6329 unit = mainUnit;
6330
6331 fintEnvPush(lexEnv, NULL, NULL){ lexEnv = (FiEnv) ((DataObj) memset(stoAlloc(0, sizeof(struct
_FiEnv) * (1)), 0, sizeof(struct _FiEnv) * (1))); lexEnv->
level = (Ptr) ((void*)0); lexEnv->next = (((void*)0)); lexEnv
->info = (FiWord) ((void*)0); }
;
6332 stackFrameAlloc(int0){ if (sp + 10 + ((int) 0) >= stack + 3000 - 11) stackChain
(((int) 0)+10); sp->ptr = bp; bp = sp; sp += 2; (sp++)->
labels = labels; (sp++)->fiChar = (char) labelFmt; (sp++)->
ptr = locValues; (sp++)->fiEnv = lexEnv; (sp++)->progInfo
= prog; (sp++)->fiUnit = unit; (sp++)->ptr = fluidValues
; (sp++)->fiGenIter = currGenIter; sp += ((int) 0) + 1; }
;
6333
6334 tape = fintUnitTape(unit)((unit)->tape);
6335 prog = constValue(int0)((unit)->constValues[(((int) 0))]).progInfo;
6336 ip = progInfoSeq(prog)((prog)->fiProgPos);
6337 labels = progInfoLabels(prog)((prog)->labels);
6338 labelFmt = progInfoLabelFmt(prog)((prog)->labelFmt);
6339
6340 denv = progInfoDEnv(prog)((prog)->denv)[0];
6341
6342 if (fintUnitLexsCount(unit, denv)(((unit)->lexLevels[(denv)]).fmtLexsCount))
6343 lev0 = fintAlloc(union dataObj, fintUnitLexsCount(unit, denv))((DataObj) memset(stoAlloc(0, sizeof(union dataObj) * ((((unit
)->lexLevels[(denv)]).fmtLexsCount))), 0, sizeof(union dataObj
) * ((((unit)->lexLevels[(denv)]).fmtLexsCount))))
;
6344 else
6345 lev0 = NULL((void*)0);
6346
6347 fintEnvPush(lexEnv, lev0, NULL){ lexEnv = (FiEnv) ((DataObj) memset(stoAlloc(0, sizeof(struct
_FiEnv) * (1)), 0, sizeof(struct _FiEnv) * (1))); lexEnv->
level = (Ptr) lev0; lexEnv->next = (((void*)0)); lexEnv->
info = (FiWord) ((void*)0); }
;
6348
6349 if (progInfoLocsCount(prog)((prog)->locsCount))
6350 stackAlloc(locValues, progInfoLocsCount(prog)){ if (sp + ((prog)->locsCount) >= stack + 3000 - 11) stackChain
(((prog)->locsCount)); (locValues) = sp; sp += (((prog)->
locsCount)); }
;
6351
6352
6353 nFluids = progInfoDFluidsCount(prog)((prog)->dfluidsCount);
6354
6355 if (nFluids)
6356 fintPushFluids(nFluids);
6357
6358 /* **************************** */
6359
6360 {
6361 FiWord exn = 0;
6362
6363 fintBlock(ok, type, exn, fintStmt(&expr)){ int __fmt = fintCurrentFormat; { FiStateBox frobnitz; FiState
state = &frobnitz;; if (!(fiSaveState0(state), _setjmp (
state->machineState))) { type = fintStmt(&expr); fiRestoreState0
(state); ok = 1; } else { fiRestoreState0(state); if (state->
target != (FiWord) state) { fiUnwind(state->target, state->
value); } exn = state->value; ok = 0; } }; fintCurrentFormat
= __fmt; }
;
6364
6365 if (!ok) {
6366 ShDataObj handler;
6367 union dataObj ret, dexn;
6368 lazyLibGet("rtexns");
6369 (void)loadOtherUnits();
6370 /* * hack 03450 */
6371 handler = shDataObjFindBis((AInt) FOAM_Clos,
6372 "aldorUnhandledException",
6373 FOAM_Proto_Foam);
6374 if (handler) {
6375 if (fintExntraceMode == 1 ) {
6376 FILE *oldDbOut = dbOut;
6377 dbOut = osStderr;
6378 fprintf(dbOut, "Aldor runtime (interpreter): backtrace:\n");
6379 fintWhere(FINT_BACKTRACE_CUTOFF23);
6380 fprintf(dbOut, "\n");
6381 dbOut = oldDbOut;
6382 };
6383
6384 dexn.fiWord = exn;
6385 (void)fintDoCall1(&handler->dataObj, &ret, &dexn);
6386 }
6387 }
6388 }
6389 /* **************************** */
6390
6391 if (nFluids)
6392 fiGlobalFluidStack = (FiFluidStack) fluidValue(nFluids)(fluidValues[(nFluids)].fiFluid);
6393
6394 stackFrameFree(){ ip = bp[1].fiProgPos; labels = bp[2].labels; labelFmt = (int
) bp[3].fiChar; locValues = bp[4].ptr; lexEnv = bp[5].fiEnv; prog
= bp[6].progInfo; unit = bp[7].fiUnit; fluidValues = bp[8].ptr
; currGenIter = bp[9].fiGenIter; tape = ((unit)->tape); if
(bp < stack || bp >= stack + 3000) { sp = stack[1].ptr
; stack = stack[0].ptr; } else sp = bp; bp = bp->ptr; lev0
= (DataObj) lexEnv->level; }
; /* This used to cause grief on suns... */
6395
6396 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "Finished with bp = %p, sp = %p\n", bp, sp);
6397
6398 fintDEBUGif (!fintDebug) { } else afprintf(dbOut, "Program returned with value %ld of type %ld\n\n",
6399 expr.fiSInt, type);
6400
6401 if (fintMode == FINT_LOOP2) {
6402 (void)osSetBreakHandler(oldCompFintBreakHandler);
6403 (void)osSetBreakHandler(oldCompFintFaultHandler);
6404 }
6405 fflush(dbOut);
6406 fflush(osStderr);
6407 fflush(osStdout);
6408 return (Bool) ok;
6409}
6410
6411/****************************************************************************
6412 *
6413 * Main external entry point
6414 *
6415 * Takes a foam tree from Aldor and evaluates it.
6416 * fintInit() must be called before any call to fint()
6417 * All used structures must be released with fintFini()
6418 *
6419 ***************************************************************************/
6420
6421Bool
6422fint(Foam foam)
6423{
6424 FiBool ok;
6425
6426 hardAssert(fintInitialized)do { if (!(fintInitialized)) fintHardAssert("fintInitialized"
, "fint.c", 6426); } while (0)
;
6427
6428 fintGetInitInterpTime();
6429
6430 instrCounter = 0;
6431
6432 (void)loadMainUnit(foam);
6433
6434 (void)loadOtherUnits();
6435
6436 /* Need a _much_ better handler than this... */
6437 ok = fintExecMainUnit();
6438
6439 /* !! We should close the archive files */
6440
6441 if (DEBUG(fintSto)fintStoDebug) {stoAudit();}
6442
6443 fintGetEndInterpTime();
6444 return (Bool) ok;
6445}
6446
6447void
6448fintRaiseException(char *reason, void *stuff)
6449{
6450 ShDataObj exceptionThrower;
6451 union dataObj ret, arg1, arg2;
6452
6453
6454
6455 lazyLibGet("rtexns");
6456 (void)loadOtherUnits();
6457 /* * hack 03450 */
6458 exceptionThrower = shDataObjFindBis(FOAM_Clos,
6459 "aldorRuntimeException",
6460 FOAM_Proto_Foam);
6461 /* Could munge into better format */
6462 if (!exceptionThrower) {
6463 (void)fprintf(stdoutstdout,
6464"Aldor runtime (interpreter): An Aldor runtime error occurred : %s\n\
6465Note: there seems to be no aldorRuntimeException function defined\n\
6466so it is not possible to throw an exception.\n",
6467 reason);
6468
6469 /* The interpreter will exit due to an error, give backtrace if requested */
6470
6471 if (fintExntraceMode == 1 ) {
6472 FILE *oldDbOut = dbOut;
6473 dbOut = osStderr;
6474 fprintf(dbOut, "Aldor runtime (interpreter): backtrace:\n");
6475 fintWhere(FINT_BACKTRACE_CUTOFF23);
6476 fprintf(dbOut, "\n");
6477 dbOut = oldDbOut;
6478 };
6479 exit(1);
6480 }
6481 else {
6482 arg1.fiWord = (FiWord) reason;
6483 arg2.fiWord = (FiWord) stuff;
6484 (void) fintDoCall(&exceptionThrower->dataObj, &ret, 2, &arg1, &arg2);
6485 exit(1);
6486 /* Won't get past here */
6487 }
6488}
6489
6490/* Assumes that the file exists */
6491Bool
6492fintFile(FileName fname)
6493{
6494 FintUnit u;
6495 Lib lib;
6496 int result;
6497 fintInit();
6498
6499 lib = libGetHeader(libNew(fname, false((int) 0), fileRbOpen(fname)fileMustOpen(fname,osIoRbMode),
6500 (Offset) 0));
6501 loadUnitFrLib(lib);
6502
6503 u = car(fintUnitList)((fintUnitList)->first);
6504
6505 /* Copy shared structures in mainUnit */
6506
6507 fintUnitGlobs(mainUnit)((mainUnit)->fmtGlobs) = fintUnitGlobs(u)((u)->fmtGlobs);
6508 fintUnitConsts(mainUnit)((mainUnit)->fmtConsts) = fintUnitConsts(u)((u)->fmtConsts);
6509 fintUnitFluids(mainUnit)((mainUnit)->fmtFluids) = fintUnitFluids(u)((u)->fmtFluids);
6510 fintUnitLexLevels(mainUnit)((mainUnit)->lexLevels) = fintUnitLexLevels(u)((u)->lexLevels);
6511
6512 fintUnitGlobsCount(mainUnit)((mainUnit)->globsCount) = fintUnitGlobsCount(u)((u)->globsCount);
6513 fintUnitConstsCount(mainUnit)((mainUnit)->constsCount) = fintUnitConstsCount(u)((u)->constsCount);
6514 fintUnitFluidsCount(mainUnit)((mainUnit)->fluidsCount) = fintUnitFluidsCount(u)((u)->fluidsCount);
6515 fintUnitLexLevelsCount(mainUnit)((mainUnit)->lexLevelsCount) = fintUnitLexLevelsCount(u)((u)->lexLevelsCount);
6516
6517 fintUnitGlobValues(mainUnit)((mainUnit)->globValues) = fintUnitGlobValues(u)((u)->globValues);
6518 fintUnitConstValues(mainUnit)((mainUnit)->constValues) = fintUnitConstValues(u)((u)->constValues);
6519
6520 fintUnitId(mainUnit)((mainUnit)->unitId) = fintUnitId(u)((u)->unitId);
6521 fintUnitTape(mainUnit)((mainUnit)->tape) = fintUnitTape(u)((u)->tape);
6522 fintUnitBuffer(mainUnit)((mainUnit)->buf) = fintUnitBuffer(u)((u)->buf);
6523
6524 (void)loadOtherUnits();
6525
6526 result = fintExecMainUnit();
6527
6528 /* !! We should close the archive files */
6529 libClose(lib);
6530
6531 fintFini();
6532
6533 if (DEBUG(fintSto)fintStoDebug) {stoAudit();}
6534
6535 return result;
6536}
6537
6538
6539/****************************************************************************
6540 *
6541 * :: Dynamic State
6542 *
6543 ***************************************************************************/
6544
6545typedef struct {
6546 Buffer evalBuf;
6547
6548 UByte * tape; /* interpreted string */
6549 FiProgPos ip;
6550 DataObj stack; /* current stack */
6551 DataObj sp; /* First free cell on the top of the stack. */
6552 DataObj bp; /* Bottom of the current frame; refers to a
6553 * dataObj containing the old bp.
6554 */
6555 DataObj locValues; /* local values in the current stack frame */
6556 DataObj fluidValues; /* fluid values in the current stack frame */
6557 FiEnv lexEnv; /* current lexical environment */
6558 DataObj lev0; /* lexEnv->level, used to speed up lex(0,n) */
6559 ProgInfo prog; /* progInfo for the current program */
6560 FiProgPos * labels;
6561 FiGenIter currIter;
6562 int labelFmt;
6563 FintUnit unit;
6564} fintState;
6565
6566localstatic void *
6567fintSaveState(void)
6568{
6569 fintState *state = (fintState*) stoAlloc(OB_Other0, sizeof(*state));
6570 state->evalBuf = evalBuf;
6571 state->tape = tape;
6572 state->ip = ip;
6573 state->stack = stack;
6574 state->sp = sp;
6575 state->bp = bp;
6576 state->locValues = locValues;
6577 state->fluidValues = fluidValues;
6578 state->lexEnv = lexEnv;
6579 state->lev0 = lev0;
6580 state->prog = prog;
6581 state->labels = labels;
6582 state->labelFmt = labelFmt;
6583 state->unit = unit;
6584
6585 return state;
6586}
6587
6588localstatic void
6589fintRestoreState(void *s0)
6590{
6591 fintState *state = (fintState *) s0;
6592
6593 evalBuf = state-> evalBuf;
6594 tape = state-> tape;
6595 ip = state-> ip;
6596 stack = state-> stack;
6597 sp = state-> sp;
6598 bp = state-> bp;
6599 locValues = state-> locValues;
6600 fluidValues = state-> fluidValues;
6601 lexEnv = state-> lexEnv;
6602 lev0 = state-> lev0;
6603 prog = state-> prog;
6604 labels = state-> labels;
6605 labelFmt = state-> labelFmt;
6606 unit = state-> unit;
6607
6608 stoFree(state);
6609}
6610
6611
6612/****************************************************************************
6613 *
6614 * :: Timings
6615 *
6616 ***************************************************************************/
6617
6618
6619localstatic Millisec fintCompTime, fintInterpTime;
6620
6621void
6622fintDisplayTimings(void)
6623{
6624 if (!fintTimings) return;
6625
6626 (void)comsgFPrintf(osStdout, ALDOR_M_FintTimings250, fintCompTime, fintInterpTime);
6627}
6628
6629
6630void
6631fintGetInitCompTime(void)
6632{
6633 if (!fintTimings) return;
6634
6635 fintCompTime = osCpuTime();
6636}
6637
6638localstatic void
6639fintGetInitInterpTime(void)
6640{
6641 Millisec curCpuTime;
6642
6643 if (!fintTimings) return;
6644
6645 curCpuTime = osCpuTime();
6646
6647 fintCompTime = curCpuTime - fintCompTime;
6648 fintInterpTime = curCpuTime;
6649}
6650
6651
6652localstatic void
6653fintGetEndInterpTime(void)
6654{
6655 if (!fintTimings) return;
6656
6657 fintInterpTime = osCpuTime() - fintInterpTime;
6658}