Bug Summary

File:src/genlisp.c
Warning:line 398, column 12
Value stored to 'sx' during its initialization 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 genlisp.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 genlisp.c
1/*****************************************************************************
2 *
3 * genlisp.c: Foam-to-Lisp translation.
4 *
5 * Copyright (c) 1990-2007 Aldor Software Organization Ltd (Aldor.org).
6 *
7 ****************************************************************************/
8
9#include "gencr.h"
10#include "gf_util.h"
11#include "sexpr.h"
12#include "strops.h"
13#include "util.h"
14
15/*
16 * The following naming conventions are used in this file:
17 * gli -- function: Foam -> SExpr
18 * gl0 -- utility function
19 * glv -- variable associated with genlisp
20 */
21/* Output:
22 * By default Common ie. package directives are used.
23 *
24 * Alternative is scheme which puts
25 * a call to Foam-Header and Foam-footer at the extremes of the file.
26 *
27 * Problems:
28 * Non-local returns
29 * labels + Seqs
30 */
31
32/*
33 * Global variables used for lisp generation
34 */
35static Foam glvDGlo; /* Unit globals */
36static Foam glvDConst; /* Unit constants */
37static Foam glvDFmt; /* Unit formats */
38static Foam glvDPar; /* Unit/Prog parameters */
39static Foam glvDLoc; /* Unit/Prog locals */
40static Foam glvLexFormats; /* Prog lex format stack */
41static Foam glvProg; /* Prog being translated */
42static int glvIsLeaf; /* Prog is a leaf proc */
43static int glvIsCoroutine; /* Prog is a coroutine */
44static int glvHasGoto; /* true iff prog has goto */
45static int glvLabelNum; /* temp label number */
46static SExpr glvFunName; /* name of function */
47static String glvFileName; /* name of .as file */
48static Foam glvActualLexFormats; /* Lex Fomats used */
49
50/*
51 * Declaration of local functions.
52 * For comments, see the functions themselves.
53 */
54localstatic SExpr gliUnit (Foam);
55localstatic SExpr gliDef (Foam);
56localstatic SExpr gliPushEnv (Foam);
57localstatic SExpr gliEInfo (Foam);
58localstatic SExpr gliEEnv (Foam);
59localstatic SExpr gliPRef (Foam);
60localstatic SExpr gliGlo (Foam);
61localstatic SExpr gliPlainGlo (Foam);
62localstatic SExpr gliConst (Foam);
63localstatic SExpr gliPar (Foam);
64localstatic SExpr gliLoc (Foam);
65localstatic SExpr gliLex (Foam);
66localstatic SExpr gliEnv (Foam);
67localstatic SExpr gliPCall (Foam);
68localstatic SExpr gliArr (Foam);
69localstatic SExpr gliANew (Foam);
70localstatic SExpr gliRNew (Foam);
71localstatic SExpr gliRElt (Foam);
72localstatic SExpr gliAElt (Foam);
73localstatic SExpr gliEElt (Foam);
74localstatic SExpr gliSelect (Foam);
75
76localstatic SExpr gliExpr (Foam);
77localstatic SExpr gliSet (Foam);
78localstatic SExpr gl0SetForm (SExpr, SExpr);
79localstatic SExpr gliId (Foam);
80localstatic SExpr gliIf (Foam);
81
82localstatic SExpr gliGener (Foam);
83localstatic SExpr gliGenIter (Foam);
84localstatic SExpr gliGenIter (Foam);
85localstatic SExpr gliGenerStep (Foam);
86localstatic SExpr gliGenerValue (Foam);
87
88localstatic SExpr gl0MakeUnitHeader (void);
89localstatic SExpr gl0MakeUnitIface (Foam, Foam);
90localstatic SExpr gl0ExprOf (SExpr, int, Foam);
91localstatic SExpr gl0ListOf (Foam);
92localstatic Foam gl0GetDecl (Foam);
93localstatic SExpr gl0Prog (Foam, Foam);
94localstatic SExpr gl0MakeDeclare (Foam);
95localstatic SExpr gl0MakeSpecial (Foam, SExpr);
96localstatic SExpr gl0DeclareDefun (Foam, Foam);
97localstatic SExpr gl0DeclareVar (Foam, int);
98localstatic SExpr gl0ProgType (Foam, Foam);
99localstatic SExpr gl0typeName (String);
100localstatic SExpr gl0IdName (Foam);
101localstatic SExpr gl0IdCRProgName (Foam);
102localstatic SExpr gl0IdPlainName (Foam);
103localstatic SExpr gl0Id (FoamTag t, int, String);
104localstatic SExpr gl0OpenCall (Foam);
105localstatic SExpr gl0MakeDDecl (int);
106localstatic SExpr gl0FieldName (String, int);
107localstatic SExpr gl0StructName (int);
108localstatic SExpr gl0MakeKeyword (String);
109localstatic SExpr gl0MakeLevel (int);
110localstatic SExpr gl0VarNum (String, int);
111localstatic SExpr gl0EnvInit (Foam);
112/* local SExpr gl0InitCode (Foam, SExpr); */
113localstatic SExpr gl0EnvRef (int, SExpr);
114localstatic SExpr gl0FlattenProgn (SExpr);
115localstatic SExpr gl0FlattenProg1 (SExpr);
116localstatic SExpr gl0FlattenProgn (SExpr);
117localstatic String gl0ExtractFileName (void);
118localstatic SExpr gl0EEnv (SExpr, int);
119localstatic Foam gl0InitFormats (Foam);
120localstatic void gl0UseEnv (Foam);
121
122/*
123 * Macros for Lisp expressions
124 */
125#define lispId(s)sxiFrSymbol(symProbe(s, 1)) sxiFrSymbol(symInternConst(s)symProbe(s, 1))
126#define lisp0(f)sxiList(1, f) sxiList(1, f)
127#define lisp1(f,a)sxiList(2, f, a) sxiList(2, f, a)
128#define lisp2(f,a,b)sxiList(3, f, a, b) sxiList(3, f, a, b)
129#define lisp3(f,a,b,c)sxiList(4, f, a, b, c) sxiList(4, f, a, b, c)
130#define lisp4(f,a,b,c,d)sxiList(5, f, a, b, c, d) sxiList(5, f, a, b, c, d)
131
132/*
133 * foam types
134 */
135#define GL_BoolsxiFrSymbol(symProbe("Bool", 1)) lispId("Bool")sxiFrSymbol(symProbe("Bool", 1))
136#define GL_SIntsxiFrSymbol(symProbe("SInt", 1)) lispId("SInt")sxiFrSymbol(symProbe("SInt", 1))
137#define GL_HIntsxiFrSymbol(symProbe("HInt", 1)) lispId("HInt")sxiFrSymbol(symProbe("HInt", 1))
138#define GL_BIntsxiFrSymbol(symProbe("BInt", 1)) lispId("BInt")sxiFrSymbol(symProbe("BInt", 1))
139#define GL_SFlosxiFrSymbol(symProbe("SFlo", 1)) lispId("SFlo")sxiFrSymbol(symProbe("SFlo", 1))
140#define GL_CharsxiFrSymbol(symProbe("Char", 1)) lispId("Char")sxiFrSymbol(symProbe("Char", 1))
141#define GL_BytesxiFrSymbol(symProbe("Byte", 1)) lispId("Byte")sxiFrSymbol(symProbe("Byte", 1))
142#define GL_DFlosxiFrSymbol(symProbe("DFlo", 1)) lispId("DFlo")sxiFrSymbol(symProbe("DFlo", 1))
143
144/*
145 * foam instructions
146 */
147#define GL_CCallsxiFrSymbol(symProbe("CCall", 1)) lispId("CCall")sxiFrSymbol(symProbe("CCall", 1))
148#define GL_ClossxiFrSymbol(symProbe("Clos", 1)) lispId("Clos")sxiFrSymbol(symProbe("Clos", 1))
149#define GL_ClosFunsxiFrSymbol(symProbe("ClosFun", 1)) lispId("ClosFun")sxiFrSymbol(symProbe("ClosFun", 1))
150#define GL_ClosEnvsxiFrSymbol(symProbe("ClosEnv", 1)) lispId("ClosEnv")sxiFrSymbol(symProbe("ClosEnv", 1))
151#define GL_DDeclsxiFrSymbol(symProbe("DDecl", 1)) lispId("DDecl")sxiFrSymbol(symProbe("DDecl", 1))
152#define GL_EnvsxiFrSymbol(symProbe("Env", 1)) lispId("Env")sxiFrSymbol(symProbe("Env", 1))
153#define GL_LexsxiFrSymbol(symProbe("Lex", 1)) lispId("Lex")sxiFrSymbol(symProbe("Lex", 1))
154#define GL_REltsxiFrSymbol(symProbe("RElt", 1)) lispId("RElt")sxiFrSymbol(symProbe("RElt", 1))
155#define GL_RNewsxiFrSymbol(symProbe("RNew", 1)) lispId("RNew")sxiFrSymbol(symProbe("RNew", 1))
156#define GL_EEltsxiFrSymbol(symProbe("EElt", 1)) lispId("EElt")sxiFrSymbol(symProbe("EElt", 1))
157#define GL_AEltsxiFrSymbol(symProbe("AElt", 1)) lispId("AElt")sxiFrSymbol(symProbe("AElt", 1))
158#define GL_ANewsxiFrSymbol(symProbe("ANew", 1)) lispId("ANew")sxiFrSymbol(symProbe("ANew", 1))
159#define GL_EnvInfosxiFrSymbol(symProbe("EnvInfo", 1)) lispId("EnvInfo")sxiFrSymbol(symProbe("EnvInfo", 1))
160#define GL_SetEnvInfosxiFrSymbol(symProbe("SetEnvInfo", 1)) lispId("SetEnvInfo")sxiFrSymbol(symProbe("SetEnvInfo", 1))
161#define GL_ProgHashsxiFrSymbol(symProbe("ProgHashCode", 1)) lispId("ProgHashCode")sxiFrSymbol(symProbe("ProgHashCode", 1))
162#define GL_SetProgHashsxiFrSymbol(symProbe("SetProgHashCode", 1)) lispId("SetProgHashCode")sxiFrSymbol(symProbe("SetProgHashCode", 1))
163#define GL_SetClosEnvsxiFrSymbol(symProbe("SetClosEnv", 1)) lispId("SetClosEnv")sxiFrSymbol(symProbe("SetClosEnv", 1))
164#define GL_SetClosFunsxiFrSymbol(symProbe("SetClosFun", 1)) lispId("SetClosFun")sxiFrSymbol(symProbe("SetClosFun", 1))
165#define GL_FoamFunctionsxiFrSymbol(symProbe("foamfun", 1)) lispId("foamfun")sxiFrSymbol(symProbe("foamfun", 1))
166#define GL_FoamFreesxiFrSymbol(symProbe("FoamFree", 1)) lispId("FoamFree")sxiFrSymbol(symProbe("FoamFree", 1))
167#define GL_FoamEEnsuresxiFrSymbol(symProbe("FoamEnvEnsure", 1)) lispId("FoamEnvEnsure")sxiFrSymbol(symProbe("FoamEnvEnsure", 1))
168
169/*
170 * other foam support
171 */
172#define GL_e0sxiFrSymbol(symProbe("e0", 1)) lispId("e0")sxiFrSymbol(symProbe("e0", 1))
173#define GL_e1sxiFrSymbol(symProbe("e1", 1)) lispId("e1")sxiFrSymbol(symProbe("e1", 1))
174#define GL_EnvLevelsxiFrSymbol(symProbe("EnvLevel", 1)) lispId("EnvLevel")sxiFrSymbol(symProbe("EnvLevel", 1))
175#define GL_EnvNextsxiFrSymbol(symProbe("EnvNext", 1)) lispId("EnvNext")sxiFrSymbol(symProbe("EnvNext", 1))
176#define GL_MakeEnvsxiFrSymbol(symProbe("MakeEnv", 1)) lispId("MakeEnv")sxiFrSymbol(symProbe("MakeEnv", 1))
177#define GL_MakeLevelsxiFrSymbol(symProbe("MakeLevel", 1)) lispId("MakeLevel")sxiFrSymbol(symProbe("MakeLevel", 1))
178#define GL_MakeLitsxiFrSymbol(symProbe("MakeLit", 1)) lispId("MakeLit")sxiFrSymbol(symProbe("MakeLit", 1))
179#define GL_SetLexsxiFrSymbol(symProbe("SetLex", 1)) lispId("SetLex")sxiFrSymbol(symProbe("SetLex", 1))
180#define GL_SetAEltsxiFrSymbol(symProbe("SetAElt", 1)) lispId("SetAElt")sxiFrSymbol(symProbe("SetAElt", 1))
181#define GL_SetREltsxiFrSymbol(symProbe("SetRElt", 1)) lispId("SetRElt")sxiFrSymbol(symProbe("SetRElt", 1))
182#define GL_SetEEltsxiFrSymbol(symProbe("SetEElt", 1)) lispId("SetEElt")sxiFrSymbol(symProbe("SetEElt", 1))
183
184#define GL_GenersxiFrSymbol(symProbe("Gener", 1)) lispId("Gener")sxiFrSymbol(symProbe("Gener", 1))
185#define GL_GenItersxiFrSymbol(symProbe("GenIter", 1)) lispId("GenIter")sxiFrSymbol(symProbe("GenIter", 1))
186#define GL_GenerValuesxiFrSymbol(symProbe("GenerValue", 1)) lispId("GenerValue")sxiFrSymbol(symProbe("GenerValue", 1))
187#define GL_GenerStepsxiFrSymbol(symProbe("GenerStep", 1)) lispId("GenerStep")sxiFrSymbol(symProbe("GenerStep", 1))
188
189#define GL_FileExportssxiFrSymbol(symProbe("FILE-EXPORTS", 1)) lispId("FILE-EXPORTS")sxiFrSymbol(symProbe("FILE-EXPORTS", 1))
190#define GL_FileImportssxiFrSymbol(symProbe("FILE-IMPORTS", 1)) lispId("FILE-IMPORTS")sxiFrSymbol(symProbe("FILE-IMPORTS", 1))
191#define GL_IgnoreVarsxiFrSymbol(symProbe("IGNORE-VAR", 1)) lispId("IGNORE-VAR")sxiFrSymbol(symProbe("IGNORE-VAR", 1))
192#define GL_DefProgsxiFrSymbol(symProbe("DEFPROG", 1)) lispId("DEFPROG")sxiFrSymbol(symProbe("DEFPROG", 1))
193#define GL_DefCoroutinesxiFrSymbol(symProbe("DEFCOROUTINE", 1)) lispId("DEFCOROUTINE")sxiFrSymbol(symProbe("DEFCOROUTINE", 1))
194#define GL_SeqsxiFrSymbol(symProbe("TAGBODY", 1)) lispId("TAGBODY")sxiFrSymbol(symProbe("TAGBODY", 1))
195#define GL_DefSpecialssxiFrSymbol(symProbe("DEFSPECIALS", 1)) lispId("DEFSPECIALS")sxiFrSymbol(symProbe("DEFSPECIALS", 1))
196#define GL_DeclareTypesxiFrSymbol(symProbe("DECLARE-TYPE", 1)) lispId("DECLARE-TYPE")sxiFrSymbol(symProbe("DECLARE-TYPE", 1))
197#define GL_DeclareFunctionsxiFrSymbol(symProbe("DECLARE-PROG", 1)) lispId("DECLARE-PROG")sxiFrSymbol(symProbe("DECLARE-PROG", 1))
198#define GL_UnitHeadsxiFrSymbol(symProbe("UNIT-HEADER", 1)) lispId("UNIT-HEADER")sxiFrSymbol(symProbe("UNIT-HEADER", 1))
199#define GL_ReturnBlocksxiFrSymbol(symProbe("BLOCK-RETURN", 1)) lispId("BLOCK-RETURN")sxiFrSymbol(symProbe("BLOCK-RETURN", 1))
200
201#define GL_NULsxiFrSymbol(symProbe("CharCode0", 1)) lispId("CharCode0")sxiFrSymbol(symProbe("CharCode0", 1))
202/*
203 * Common Lisp/Scheme words
204 */
205#define GL_AndsxiFrSymbol(symProbe("AND", 1)) lispId("AND")sxiFrSymbol(symProbe("AND", 1))
206#define GL_BlocksxiFrSymbol(symProbe("BLOCK", 1)) lispId("BLOCK")sxiFrSymbol(symProbe("BLOCK", 1))
207#define GL_CasesxiFrSymbol(symProbe("CASES", 1)) lispId("CASES")sxiFrSymbol(symProbe("CASES", 1))
208#define GL_CompilesxiFrSymbol(symProbe("COMPILE", 1)) lispId("COMPILE")sxiFrSymbol(symProbe("COMPILE", 1))
209#define GL_DeclaresxiFrSymbol(symProbe("DECLARE", 1)) lispId("DECLARE")sxiFrSymbol(symProbe("DECLARE", 1))
210#define GL_DeclaimsxiFrSymbol(symProbe("DECLAIM", 1)) lispId("DECLAIM")sxiFrSymbol(symProbe("DECLAIM", 1))
211#define GL_DefconstantsxiFrSymbol(symProbe("DEFCONSTANT", 1)) lispId("DEFCONSTANT")sxiFrSymbol(symProbe("DEFCONSTANT", 1))
212#define GL_DefstructsxiFrSymbol(symProbe("DEFSTRUCT", 1)) lispId("DEFSTRUCT")sxiFrSymbol(symProbe("DEFSTRUCT", 1))
213#define GL_DefunsxiFrSymbol(symProbe("DEFUN", 1)) lispId("DEFUN")sxiFrSymbol(symProbe("DEFUN", 1))
214#define GL_EvalsxiFrSymbol(symProbe("EVAL", 1)) lispId("EVAL")sxiFrSymbol(symProbe("EVAL", 1))
215#define GL_EvalWhensxiFrSymbol(symProbe("EVAL-WHEN", 1)) lispId("EVAL-WHEN")sxiFrSymbol(symProbe("EVAL-WHEN", 1))
216#define GL_FtypesxiFrSymbol(symProbe("FTYPE", 1)) lispId("FTYPE")sxiFrSymbol(symProbe("FTYPE", 1))
217#define GL_FuncallsxiFrSymbol(symProbe("FUNCALL", 1)) lispId("FUNCALL")sxiFrSymbol(symProbe("FUNCALL", 1))
218#define GL_FunctionsxiFrSymbol(symProbe("FUNCTION", 1)) lispId("FUNCTION")sxiFrSymbol(symProbe("FUNCTION", 1))
219#define GL_GosxiFrSymbol(symProbe("GO", 1)) lispId("GO")sxiFrSymbol(symProbe("GO", 1))
220#define GL_IfsxiFrSymbol(symProbe("IF", 1)) lispId("IF")sxiFrSymbol(symProbe("IF", 1))
221#define GL_WhensxiFrSymbol(symProbe("WHEN", 1)) lispId("WHEN")sxiFrSymbol(symProbe("WHEN", 1))
222#define GL_IgnoresxiFrSymbol(symProbe("IGNORE", 1)) lispId("IGNORE")sxiFrSymbol(symProbe("IGNORE", 1))
223#define GL_InPackagesxiFrSymbol(symProbe("IN-PACKAGE", 1)) lispId("IN-PACKAGE")sxiFrSymbol(symProbe("IN-PACKAGE", 1))
224#define GL_IntegersxiFrSymbol(symProbe("INTEGER", 1)) lispId("INTEGER")sxiFrSymbol(symProbe("INTEGER", 1))
225#define GL_LambdasxiFrSymbol(symProbe("LAMBDA", 1)) lispId("LAMBDA")sxiFrSymbol(symProbe("LAMBDA", 1))
226#define GL_LoadsxiFrSymbol(symProbe("LOAD", 1)) lispId("LOAD")sxiFrSymbol(symProbe("LOAD", 1))
227#define GL_LoopsxiFrSymbol(symProbe("LOOP", 1)) lispId("LOOP")sxiFrSymbol(symProbe("LOOP", 1))
228#define GL_LetsxiFrSymbol(symProbe("LET", 1)) lispId("LET")sxiFrSymbol(symProbe("LET", 1))
229#define GL_MVSetqsxiFrSymbol(symProbe("MULTIPLE-VALUE-SETQ", 1)) lispId("MULTIPLE-VALUE-SETQ")sxiFrSymbol(symProbe("MULTIPLE-VALUE-SETQ", 1))
230#define GL_NilsxiFrSymbol(symProbe("NIL", 1)) lispId("NIL")sxiFrSymbol(symProbe("NIL", 1))
231#define GL_OrsxiFrSymbol(symProbe("OR", 1)) lispId("OR")sxiFrSymbol(symProbe("OR", 1))
232#define GL_ProclaimsxiFrSymbol(symProbe("PROCLAIM", 1)) lispId("PROCLAIM")sxiFrSymbol(symProbe("PROCLAIM", 1))
233#define GL_PrognsxiFrSymbol(symProbe("PROGN", 1)) lispId("PROGN")sxiFrSymbol(symProbe("PROGN", 1))
234#define GL_QuotesxiFrSymbol(symProbe("QUOTE", 1)) lispId("QUOTE")sxiFrSymbol(symProbe("QUOTE", 1))
235#define GL_ReturnsxiFrSymbol(symProbe("RETURN", 1)) lispId("RETURN")sxiFrSymbol(symProbe("RETURN", 1))
236#define GL_ReturnFromsxiFrSymbol(symProbe("RETURN-FROM", 1)) lispId("RETURN-FROM")sxiFrSymbol(symProbe("RETURN-FROM", 1))
237#define GL_SetqsxiFrSymbol(symProbe("SETQ", 1)) lispId("SETQ")sxiFrSymbol(symProbe("SETQ", 1))
238#define GL_TLSetqsxiFrSymbol(symProbe("top-level-define", 1)) lispId("top-level-define")sxiFrSymbol(symProbe("top-level-define", 1))
239#define GL_SetfsxiFrSymbol(symProbe("SETF", 1)) lispId("SETF")sxiFrSymbol(symProbe("SETF", 1))
240#define GL_SpecialsxiFrSymbol(symProbe("SPECIAL", 1)) lispId("SPECIAL")sxiFrSymbol(symProbe("SPECIAL", 1))
241#define GL_TsxiFrSymbol(symProbe("T", 1)) lispId("T")sxiFrSymbol(symProbe("T", 1))
242#define GL_ThesxiFrSymbol(symProbe("THE", 1)) lispId("THE")sxiFrSymbol(symProbe("THE", 1))
243#define GL_TypesxiFrSymbol(symProbe("TYPE", 1)) lispId("TYPE")sxiFrSymbol(symProbe("TYPE", 1))
244#define GL_ValuessxiFrSymbol(symProbe("VALUES", 1)) lispId("VALUES")sxiFrSymbol(symProbe("VALUES", 1))
245
246/* Make a new label for goto */
247#define gl0GenLabel()sxiFrSymbol(symProbe(strPrintf("G_%d", glvLabelNum++), 1)) lispId(strPrintf("G_%d", glvLabelNum++))sxiFrSymbol(symProbe(strPrintf("G_%d", glvLabelNum++), 1))
248
249#define gl0GlobalInfo(f,x,y,z)genGlobalInfo(f,x,y,z) genGlobalInfo(f,x,y,z)
250
251#define SOPT_COMMON"common" "common"
252#define SOPT_SCHEME"scheme" "scheme"
253#define SOPT_FTYPE"ftype=" "ftype="
254#define SOPT_CASE"mixedcase" "mixedcase"
255
256enum gllangOpt { GLLANG_COMMON, GLLANG_SCHEME };
257static enum gllangOpt langOpt = GLLANG_COMMON; /* by default */
258
259ULong glWriteMode = 0;
260static int glimixedCase;
261
262int
263genLispOption(String opt)
264{
265 String s;
266
267 if (strEqual(opt, SOPT_COMMON"common")) langOpt = GLLANG_COMMON;
268 else if (strEqual(opt, SOPT_SCHEME"scheme")) langOpt = GLLANG_SCHEME;
269 else if (strEqual(opt, SOPT_CASE"mixedcase")) glimixedCase = true1;
270 else if (s = strIsPrefix(SOPT_FTYPE"ftype=", opt), s) sxiLispFileType = s;
271 else return -1;
272
273 return 0;
274}
275
276/*
277 * Top level entry point for lisp generation.
278 */
279
280SExpr
281genLisp(Foam foam)
282{
283 glWriteMode = glimixedCase ? SXRW_MixedCase(1L<<0) : SXRW_FoldCase(1L<<1);
284 glWriteMode |= (langOpt == GLLANG_COMMON) ? SXRW_Packages(1L<<4) : 0;
285 return gliUnit(foam);
286}
287
288/*
289 * Generate lisp for a single file.
290 */
291localstatic SExpr
292gliUnit(Foam foam)
293{
294 SExpr defl, sx, exports;
295 Foam defs, initDef, initProg, initSeq;
296 int i;
297
298 assert(foamTag(foam) == FOAM_Unit)do { if (!(((foam)->hdr.tag) == FOAM_Unit)) _do_assert(("foamTag(foam) == FOAM_Unit"
),"genlisp.c",298); } while (0);
299
300 if (foamUnitHasCoroutine(foam)) {
301 foam = gcrRewriteUnit(foam);
302 }
303
304 glvDGlo = foamUnitGlobals(foam)((((foam)->foamUnit.formats)->foamGen.argv)[0].code);
305 glvDConst = foamUnitConstants(foam)((((foam)->foamUnit.formats)->foamGen.argv)[1].code);
306 glvDFmt = foam->foamUnit.formats;
307
308
309 glvHasGoto = 0;
310 glvLabelNum = 0;
311 glvFunName = sxNil;
312 glvFileName = gl0ExtractFileName();
313 glvLexFormats= 0;
314
315 defs = foam->foamUnit.defs;
316 assert(foamTag(defs) == FOAM_DDef)do { if (!(((defs)->hdr.tag) == FOAM_DDef)) _do_assert(("foamTag(defs) == FOAM_DDef"
),"genlisp.c",316); } while (0);
317
318 defl = sxCons(gl0MakeUnitHeader(), sxNil);
319 exports = sxNil;
320
321 /* collect defun names in a list and make proclaims. */
322 for (i = 0; i < foamArgc(defs)((defs)->hdr.argc); i++) {
323 sx = gl0MakeDeclare(foamArgv(defs)((defs)->foamGen.argv)[i].code);
324 if (!sxiNull(sx)(((sx)->sxHdr.tag) == SX_Nil)) defl = sxCons(sx, defl);
325 }
326
327 initDef = foamArgv(defs)((defs)->foamGen.argv)[0].code;
328 assert(foamTag(initDef) == FOAM_Def)do { if (!(((initDef)->hdr.tag) == FOAM_Def)) _do_assert((
"foamTag(initDef) == FOAM_Def"),"genlisp.c",328); } while (0);
329 initProg = initDef->foamDef.rhs;
330 assert(foamTag(initProg) == FOAM_Prog)do { if (!(((initProg)->hdr.tag) == FOAM_Prog)) _do_assert
(("foamTag(initProg) == FOAM_Prog"),"genlisp.c",330); } while
(0);
331 initSeq = initProg->foamProg.body;
332 /*!! this may not always be a valid assumption. */
333 assert(foamTag(initSeq) == FOAM_Seq)do { if (!(((initSeq)->hdr.tag) == FOAM_Seq)) _do_assert((
"foamTag(initSeq) == FOAM_Seq"),"genlisp.c",333); } while (0);
334
335 /* proclaim defs in initialization program. */
336 for (i = 0; i < foamArgc(initSeq)((initSeq)->hdr.argc); i++) {
337 sx = gl0MakeDeclare(foamArgv(initSeq)((initSeq)->foamGen.argv)[i].code);
338 if (!sxiNull(sx)(((sx)->sxHdr.tag) == SX_Nil)) defl = sxCons(sx, defl);
339 }
340
341
342 /* proclaim specials for globals. */
343 sx = sxNil;
344 for (i = 0; i < foamArgc(initSeq)((initSeq)->hdr.argc); i++)
345 sx = gl0MakeSpecial(foamArgv(initSeq)((initSeq)->foamGen.argv)[i].code, sx);
346 if (!sxiNull(sx)(((sx)->sxHdr.tag) == SX_Nil)) { /* Warning: Untested! */
347 sx = sxCons(GL_DefSpecialssxiFrSymbol(symProbe("DEFSPECIALS", 1)), sx);
348 defl = sxCons(sx, defl);
349 }
350
351 /* make defstructs for formats */
352 for(i=lexesSlot2; i < foamArgc(glvDFmt)((glvDFmt)->hdr.argc); i++) {
353 sx = gl0MakeDDecl(i);
354 if (!sxiNull(sx)(((sx)->sxHdr.tag) == SX_Nil)) defl = sxCons(sx, defl);
355 }
356
357 /* first, make program definitions. */
358 for (i = 1; i < foamArgc(defs)((defs)->hdr.argc); i++)
359 if (foamTag(foamArgv(defs)[i].code)((((defs)->foamGen.argv)[i].code)->hdr.tag) == FOAM_Prog)
360 defl = sxCons(gliDef(foamArgv(defs)((defs)->foamGen.argv)[i].code), defl);
361 defl = sxCons(gliDef(initDef), defl);
362
363 /* next, make other definitions. */
364 for (i = 1; i < foamArgc(defs)((defs)->hdr.argc); i++)
365 if (foamTag(foamArgv(defs)[i].code)((((defs)->foamGen.argv)[i].code)->hdr.tag) != FOAM_Prog)
366 defl = sxCons(gliDef(foamArgv(defs)((defs)->foamGen.argv)[i].code), defl);
367
368 defl = sxNConc(gl0MakeUnitIface(defs, glvDFmt->foamDFmt.argv[globalsSlot0]), defl);
369
370 defl = sxNReverse(defl);
371
372 return defl;
373}
374
375
376/*
377 * Form an "in-package" expression for the generated code.
378 */
379
380localstatic SExpr
381gl0MakeUnitHeader(void)
382{
383 if (langOpt==GLLANG_COMMON)
384 return lisp1(GL_InPackage,sxiList(2, sxiFrSymbol(symProbe("IN-PACKAGE", 1)), sxiFrString
("FOAM-USER"))
385 sxiFrString("FOAM-USER"))sxiList(2, sxiFrSymbol(symProbe("IN-PACKAGE", 1)), sxiFrString
("FOAM-USER"));
386 else
387 return lisp0(GL_UnitHead)sxiList(1, sxiFrSymbol(symProbe("UNIT-HEADER", 1)));
388}
389
390
391/*
392 * Generate lisp for an arbitrary Foam expression.
393 */
394
395localstatic SExpr
396gliExpr(Foam foam)
397{
398 SExpr sx = sxNil;
Value stored to 'sx' during its initialization is never read
399
400 switch (foamTag(foam)((foam)->hdr.tag)) {
401 case FOAM_Prog:
402 bugBadCase(FOAM_Prog)bug("Bad case %d (line %d in file %s).", (int) FOAM_Prog, 402
, "genlisp.c");
403 break;
404
405 case FOAM_NOp:
406 case FOAM_Nil:
407 sx = GL_NilsxiFrSymbol(symProbe("NIL", 1));
408 break;
409 case FOAM_CCall: {
410 sx = gl0ExprOf(GL_CCallsxiFrSymbol(symProbe("CCall", 1)), 1, foam);
411 break;
412 }
413 case FOAM_OCall: {
414 sx = gl0OpenCall(foam);
415 break;
416 }
417 case FOAM_BVal: {
418 FoamTag op = foam->foamBVal.builtinTag;
419 sx = gl0ExprOf(foamBValSExpr(op)((foamBValInfoTable[(int)(op)-(int)FOAM_BVAL_START]).sxsym), 1, foam);
420 break;
421 }
422 case FOAM_BCall: {
423 FoamTag op = foam->foamBCall.op;
424 sx = gl0ExprOf(foamBValSExpr(op)((foamBValInfoTable[(int)(op)-(int)FOAM_BVAL_START]).sxsym), 1, foam);
425 break;
426 }
427 case FOAM_PCall:
428 sx = gliPCall(foam);
429 break;
430 case FOAM_If:
431 sx = gliIf(foam);
432 break;
433 case FOAM_Set:
434 sx = gliSet(foam);
435 break;
436 case FOAM_Def:
437 sx = gliDef(foam);
438 break;
439 case FOAM_PushEnv:
440 sx = gliPushEnv(foam);
441 break;
442 case FOAM_PopEnv:
443 sx = GL_NilsxiFrSymbol(symProbe("NIL", 1));
444 break;
445 case FOAM_EEnv:
446 sx = gliEEnv(foam);
447 break;
448 case FOAM_Seq:
449 sx = gl0ExprOf(GL_PrognsxiFrSymbol(symProbe("PROGN", 1)), int0((int) 0), foam);
450 break;
451 case FOAM_Par:
452 case FOAM_Loc:
453 case FOAM_Glo:
454 case FOAM_Const:
455 sx = gliId(foam);
456 break;
457 case FOAM_Lex:
458 sx = gliLex(foam);
459 break;
460 case FOAM_Return:
461 sx = lisp2(GL_ReturnBlock, glvFunName,sxiList(3, sxiFrSymbol(symProbe("BLOCK-RETURN", 1)), glvFunName
, gliExpr(foam->foamReturn.value))
462 gliExpr(foam->foamReturn.value))sxiList(3, sxiFrSymbol(symProbe("BLOCK-RETURN", 1)), glvFunName
, gliExpr(foam->foamReturn.value));
463 break;
464 case FOAM_Cast:
465 sx = gliExpr(foam->foamCast.expr);
466 break;
467 case FOAM_Clos:
468 sx = gl0ExprOf(GL_ClossxiFrSymbol(symProbe("Clos", 1)), int0((int) 0), foam);
469 break;
470 case FOAM_Env:
471 sx = gliEnv(foam);
472 break;
473 case FOAM_EInfo:
474 sx = gliEInfo(foam);
475 break;
476 case FOAM_PRef:
477 sx = gliPRef(foam);
478 break;
479 case FOAM_Arr:
480 sx = gliArr(foam);
481 break;
482 case FOAM_CEnv:
483 sx = gl0ExprOf(GL_ClosEnvsxiFrSymbol(symProbe("ClosEnv", 1)), int0((int) 0), foam);
484 break;
485 case FOAM_CProg:
486 sx = gl0ExprOf(GL_ClosFunsxiFrSymbol(symProbe("ClosFun", 1)), int0((int) 0), foam);
487 break;
488 case FOAM_Values:
489 if (foamArgc(foam)((foam)->hdr.argc) == 0)
490 sx = sxNil;
491 else
492 sx = gl0ExprOf(GL_ValuessxiFrSymbol(symProbe("VALUES", 1)), int0((int) 0), foam);
493 break;
494 case FOAM_MFmt:
495 sx = gliExpr(foam->foamMFmt.value);
496 break;
497 case FOAM_EElt:
498 sx = gliEElt(foam);
499 break;
500 case FOAM_Char: /* XXX: Should be fixed elsewhere */
501 sx = lisp2(GL_The, GL_Char,sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("Char", 1)), (foam->foamChar.CharData=='\0') ? sxiFrSymbol
(symProbe("CharCode0", 1)) : sxiFrChar(foam->foamChar.CharData
))
502 (foam->foamChar.CharData=='\0')sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("Char", 1)), (foam->foamChar.CharData=='\0') ? sxiFrSymbol
(symProbe("CharCode0", 1)) : sxiFrChar(foam->foamChar.CharData
))
503 ? GL_NULsxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("Char", 1)), (foam->foamChar.CharData=='\0') ? sxiFrSymbol
(symProbe("CharCode0", 1)) : sxiFrChar(foam->foamChar.CharData
))
504 : sxiFrChar(foam->foamChar.CharData))sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("Char", 1)), (foam->foamChar.CharData=='\0') ? sxiFrSymbol
(symProbe("CharCode0", 1)) : sxiFrChar(foam->foamChar.CharData
));
505 break;
506 case FOAM_Bool:
507 sx = lisp2(GL_The, GL_Bool, (foam->foamBool.BoolData ?sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("Bool", 1)), (foam->foamBool.BoolData ? sxiFrSymbol(symProbe
("T", 1)) : sxiFrSymbol(symProbe("NIL", 1))))
508 GL_T : GL_Nil))sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("Bool", 1)), (foam->foamBool.BoolData ? sxiFrSymbol(symProbe
("T", 1)) : sxiFrSymbol(symProbe("NIL", 1))));
509 break;
510 case FOAM_Byte:
511 sx = lisp2(GL_The, GL_Byte,sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("Byte", 1)), sxiFrInteger(foam->foamByte.ByteData))
512 sxiFrInteger(foam->foamByte.ByteData))sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("Byte", 1)), sxiFrInteger(foam->foamByte.ByteData));
513 break;
514 case FOAM_SInt:
515 sx = lisp2(GL_The, GL_SInt,sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("SInt", 1)), sxiFrInteger(foam->foamSInt.SIntData))
516 sxiFrInteger(foam->foamSInt.SIntData))sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("SInt", 1)), sxiFrInteger(foam->foamSInt.SIntData));
517 break;
518 case FOAM_HInt:
519 sx = lisp2(GL_The, GL_HInt,sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("HInt", 1)), sxiFrInteger(foam->foamHInt.HIntData))
520 sxiFrInteger(foam->foamHInt.HIntData))sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("HInt", 1)), sxiFrInteger(foam->foamHInt.HIntData));
521 break;
522 case FOAM_BInt:
523 sx = lisp2(GL_The, GL_BInt,sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("BInt", 1)), sxiFrBigInteger(foam->foamBInt.BIntData))
524 sxiFrBigInteger(foam->foamBInt.BIntData))sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("BInt", 1)), sxiFrBigInteger(foam->foamBInt.BIntData));
525 break;
526 case FOAM_SFlo:
527 sx = lisp2(GL_The, GL_SFlo, sxiFrSFloat(foamToSFlo(foam)))sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("SFlo", 1)), sxiFrFloat(((foam)->foamSFlo.SFloData), 's')
);
528 break;
529 case FOAM_DFlo:
530 sx = lisp2(GL_The, GL_DFlo, sxiFrDFloat(foamToDFlo(foam)))sxiList(3, sxiFrSymbol(symProbe("THE", 1)), sxiFrSymbol(symProbe
("DFlo", 1)), sxiFrFloat(((foam)->foamDFlo.DFloData), 'e')
);
531 break;
532 case FOAM_Goto:
533 sx = lisp1(GL_Go,sxiList(2, sxiFrSymbol(symProbe("GO", 1)), sxiFrSymbol(symProbe
(strPrintf("Lab%d", foam->foamGoto.label), 1)))
534 lispId(strPrintf("Lab%d", foam->foamGoto.label)))sxiList(2, sxiFrSymbol(symProbe("GO", 1)), sxiFrSymbol(symProbe
(strPrintf("Lab%d", foam->foamGoto.label), 1)));
535 glvHasGoto = 1;
536 break;
537 case FOAM_Label:
538 sx = lispId(strPrintf("Lab%d", foam->foamGoto.label))sxiFrSymbol(symProbe(strPrintf("Lab%d", foam->foamGoto.label
), 1));
539 break;
540 case FOAM_Select:
541 sx = gliSelect(foam);
542 break;
543 case FOAM_ANew:
544 sx = gliANew(foam);
545 break;
546 case FOAM_RNew:
547 sx = gliRNew(foam);
548 break;
549 case FOAM_AElt:
550 sx = gliAElt(foam);
551 break;
552 case FOAM_RElt:
553 sx = gliRElt(foam);
554 break;
555 case FOAM_Free:
556 sx = lisp1(GL_FoamFree, gliExpr(foam->foamFree.place))sxiList(2, sxiFrSymbol(symProbe("FoamFree", 1)), gliExpr(foam
->foamFree.place));
557 break;
558 case FOAM_EEnsure:
559 sx = lisp1(GL_FoamEEnsure, gliExpr(foam->foamEEnsure.env))sxiList(2, sxiFrSymbol(symProbe("FoamEnvEnsure", 1)), gliExpr
(foam->foamEEnsure.env));
560 break;
561 case FOAM_Gener:
562 sx = gliGener(foam);
563 break;
564 case FOAM_GenIter:
565 sx = gliGenIter(foam);
566 break;
567 case FOAM_GenerValue:
568 sx = gliGenerValue(foam);
569 break;
570 case FOAM_GenerStep:
571 sx = gliGenerStep(foam);
572 break;
573 default:
574 printf("unhandled foamTag = %s\n",
575 foamInfo(foamTag(foam))(foamInfoTable [(int)(((foam)->hdr.tag))-(int)FOAM_START]).str);
576 sx = lispId("unhandled!")sxiFrSymbol(symProbe("unhandled!", 1));
577 break;
578 }
579 return sx;
580}
581
582localstatic SExpr
583gliSet(Foam foam)
584{
585 SExpr lhs,rhs;
586
587 if (foamTag(foam->foamSet.lhs)((foam->foamSet.lhs)->hdr.tag) == FOAM_Values)
588 return lisp2(GL_MVSetq, gl0ListOf(foam->foamSet.lhs),sxiList(3, sxiFrSymbol(symProbe("MULTIPLE-VALUE-SETQ", 1)), gl0ListOf
(foam->foamSet.lhs), gliExpr(foam->foamSet.rhs))
589 gliExpr(foam->foamSet.rhs))sxiList(3, sxiFrSymbol(symProbe("MULTIPLE-VALUE-SETQ", 1)), gl0ListOf
(foam->foamSet.lhs), gliExpr(foam->foamSet.rhs));
590
591 lhs=gliExpr(foam->foamSet.lhs);
592 rhs=gliExpr(foam->foamSet.rhs);
593 return gl0SetForm(lhs,rhs);
594}
595
596/*
597 * convert reader form to a writer form
598 * Could make this into a switch..
599 * Currently - a -> (setq a ..)
600 * (aref x) -> (setaref x)
601 * (RElt x) -> (setrelt x)
602 * destructive on rdr form in last 2 cases
603 */
604localstatic SExpr
605gl0SetForm(SExpr rdr, SExpr value)
606{
607 if (sxSymbolP(rdr)((((rdr)->sxHdr.tag) == SX_Symbol) ? sxT : sxNil)==sxT)
608 return lisp2(GL_Setq, rdr, value)sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), rdr, value);
609
610 assert(sxSymbolP(sxCar(rdr))==sxT)do { if (!(((((((rdr)->sxCons.sxCarField))->sxHdr.tag) ==
SX_Symbol) ? sxT : sxNil)==sxT)) _do_assert(("sxSymbolP(sxCar(rdr))==sxT"
),"genlisp.c",610); } while (0);
611
612 if (sxCar(rdr)((rdr)->sxCons.sxCarField)==GL_AEltsxiFrSymbol(symProbe("AElt", 1))) {
613 sxCar(rdr)((rdr)->sxCons.sxCarField)=GL_SetAEltsxiFrSymbol(symProbe("SetAElt", 1));
614 sxNConc(rdr,lisp0(value)sxiList(1, value));
615 return rdr;
616 }
617 if (sxCar(rdr)((rdr)->sxCons.sxCarField)==GL_REltsxiFrSymbol(symProbe("RElt", 1))) {
618 sxCar(rdr)((rdr)->sxCons.sxCarField)=GL_SetREltsxiFrSymbol(symProbe("SetRElt", 1));
619 sxNConc(rdr,lisp0(value)sxiList(1, value));
620 return rdr;
621 }
622 if (sxCar(rdr)((rdr)->sxCons.sxCarField)==GL_EEltsxiFrSymbol(symProbe("EElt", 1))) {
623 sxCar(rdr)((rdr)->sxCons.sxCarField)=GL_SetEEltsxiFrSymbol(symProbe("SetEElt", 1));
624 sxNConc(rdr,lisp0(value)sxiList(1, value));
625 return rdr;
626 }
627 if (sxCar(rdr)((rdr)->sxCons.sxCarField)==GL_LexsxiFrSymbol(symProbe("Lex", 1))) {
628 sxCar(rdr)((rdr)->sxCons.sxCarField)=GL_SetLexsxiFrSymbol(symProbe("SetLex", 1));
629 sxNConc(rdr,lisp0(value)sxiList(1, value));
630 return rdr;
631 }
632 if (sxCar(rdr)((rdr)->sxCons.sxCarField)==GL_EnvInfosxiFrSymbol(symProbe("EnvInfo", 1))) {
633 sxCar(rdr)((rdr)->sxCons.sxCarField)=GL_SetEnvInfosxiFrSymbol(symProbe("SetEnvInfo", 1));
634 sxNConc(rdr,lisp0(value)sxiList(1, value));
635 return rdr;
636 }
637 if (sxCar(rdr)((rdr)->sxCons.sxCarField)==GL_ClosEnvsxiFrSymbol(symProbe("ClosEnv", 1))) {
638 sxCar(rdr)((rdr)->sxCons.sxCarField)=GL_SetClosEnvsxiFrSymbol(symProbe("SetClosEnv", 1));
639 sxNConc(rdr,lisp0(value)sxiList(1, value));
640 return rdr;
641 }
642 if (sxCar(rdr)((rdr)->sxCons.sxCarField)==GL_ClosFunsxiFrSymbol(symProbe("ClosFun", 1))) {
643 sxCar(rdr)((rdr)->sxCons.sxCarField)=GL_SetClosFunsxiFrSymbol(symProbe("SetClosFun", 1));
644 sxNConc(rdr,lisp0(value)sxiList(1, value));
645 return rdr;
646 }
647 if (sxCar(rdr)((rdr)->sxCons.sxCarField) == GL_ProgHashsxiFrSymbol(symProbe("ProgHashCode", 1))) {
648 sxCar(rdr)((rdr)->sxCons.sxCarField) = GL_SetProgHashsxiFrSymbol(symProbe("SetProgHashCode", 1));
649 sxNConc(rdr, lisp0(value)sxiList(1, value));
650 return rdr;
651 }
652 NotReached(return 0){(void)bug("Not supposed to reach line %d in file: %s\n",652,
"genlisp.c");};
653}
654
655/* generate lisp for a name, appropriately quoting functions */
656localstatic SExpr
657gliId(Foam foam)
658{
659 SExpr sx = gl0IdName(foam);
660
661 return sx;
662}
663
664/* generate lisp for a name. */
665localstatic SExpr
666gl0IdName(Foam foam)
667{
668 switch (foamTag(foam)((foam)->hdr.tag)) {
669 default: bugBadCase(foamTag(foam))bug("Bad case %d (line %d in file %s).", (int) ((foam)->hdr
.tag), 669, "genlisp.c");
670 case FOAM_Glo: return gliGlo(foam);
671 case FOAM_Const: return gliConst(foam);
672 case FOAM_Par: return gliPar(foam);
673 case FOAM_Loc: return gliLoc(foam);
674 case FOAM_Lex: return gliLex(foam);
675 }
676}
677
678localstatic SExpr
679gl0IdCRProgName(Foam foam)
680{
681 Foam decl = gl0GetDecl(foam);
682 int ix = foam->foamConst.index;
683 SExpr val;
684
685 val = gl0Id(FOAM_Const, ix, strPrintf("CR-Prog-%s-%s", glvFileName,
686 decl->foamDecl.id));
687 return val;
688}
689
690localstatic SExpr
691gl0IdInfo(Foam decl, int ix)
692{
693 String name, exporter;
694 int hash;
695 SExpr sxTypeId;
696
697 gl0GlobalInfo(decl, &name, &exporter, &hash)genGlobalInfo(decl,&name,&exporter,&hash);
698
699 if (decl->foamGDecl.protocol == FOAM_Proto_Init)
700 sxTypeId = lispId("initializer")sxiFrSymbol(symProbe("initializer", 1));
701 else
702 sxTypeId = sxiFrInteger(hash);
703
704 return sxCons(gl0Id(FOAM_Glo, ix, decl->foamGDecl.id),
705 sxCons(sxiFrString(name),
706 sxCons(sxTypeId,
707 sxCons(sxiFrString(exporter),
708 sxNil))));
709}
710
711localstatic SExpr
712gl0IdPlainName(Foam foam)
713{
714 if (foamTag(foam)((foam)->hdr.tag) != FOAM_Glo) bugBadCase(foamTag(foam))bug("Bad case %d (line %d in file %s).", (int) ((foam)->hdr
.tag), 714, "genlisp.c");
715 return gliPlainGlo(foam);
716}
717
718localstatic SExpr
719gliConst(Foam foam)
720{
721 Foam decl = gl0GetDecl(foam);
722 int ix = foam->foamConst.index;
723 SExpr val;
724
725 val = gl0Id(FOAM_Const, ix, strPrintf("%s-%s", glvFileName,
726 decl->foamDecl.id));
727 return val;
728}
729
730localstatic SExpr
731gliGlo(Foam foam)
732{
733 Foam decl = gl0GetDecl(foam);
734 int ix = foam->foamGlo.index;
735
736 if (decl->foamGDecl.protocol == FOAM_Proto_Lisp)
737 return gl0IdPlainName(foam);
738
739 return gl0Id(FOAM_Glo, ix, decl->foamGDecl.id);
740}
741
742localstatic SExpr
743gliPlainGlo(Foam foam)
744{
745 Foam decl = gl0GetDecl(foam);
746 String str = decl->foamGDecl.id;
747
748 return sxiFrSymbol(symIntern(str)symProbe(str, 1 | 2));
749}
750
751localstatic SExpr
752gliPar(Foam foam)
753{
754 Foam decl = gl0GetDecl(foam);
755 int ix = foam->foamPar.index;
756
757 return gl0Id(FOAM_Par, ix, decl->foamDecl.id);
758}
759
760localstatic SExpr
761gliLoc(Foam foam)
762{
763 Foam decl = gl0GetDecl(foam);
764 int ix = foam->foamLoc.index;
765
766 return gl0Id(FOAM_Loc, ix, decl->foamDecl.id);
767}
768
769localstatic SExpr
770gliLex(Foam foam)
771{
772 int lv = foam->foamLex.level;
773 int ix = foam->foamLex.index;
774 int fi = glvLexFormats->foamDEnv.argv[lv];
775 Foam ddecl = glvDFmt->foamDFmt.argv[fi];
776 Foam decl = ddecl->foamDDecl.argv[ix];
777 String buf;
778 SExpr access;
779
780 assert (foamTag(ddecl) == FOAM_DDecl)do { if (!(((ddecl)->hdr.tag) == FOAM_DDecl)) _do_assert((
"foamTag(ddecl) == FOAM_DDecl"),"genlisp.c",780); } while (0);
781 assert (foamTag(decl) == FOAM_Decl)do { if (!(((decl)->hdr.tag) == FOAM_Decl)) _do_assert(("foamTag(decl) == FOAM_Decl"
),"genlisp.c",781); } while (0);
782 assert (strlen(decl->foamDecl.id) < 180)do { if (!(strlen(decl->foamDecl.id) < 180)) _do_assert
(("strlen(decl->foamDecl.id) < 180"),"genlisp.c",782); }
while (0);
783
784 gl0UseEnv(foam);
785 buf = strPrintf("Struct-%s-%d-%s-%d", glvFileName,
786 fi, decl->foamDecl.id, ix);
787 access = lispId(buf)sxiFrSymbol(symProbe(buf, 1));
788 return lisp3(GL_Lex, access, sxiFrInteger(ix), gl0VarNum("l", lv))sxiList(4, sxiFrSymbol(symProbe("Lex", 1)), access, sxiFrInteger
(ix), gl0VarNum("l", lv));
789}
790
791
792/*
793 * Construct bindings+types for all locals
794 *
795 */
796
797localstatic SExpr
798gl0MakeLocals(Foam locals, SExpr inits0)
799{
800 SExpr typedVars, liId, inits = inits0;
801 int i, argc = foamDDeclArgc(locals)(((locals)->hdr.argc) - (1));
802 Foam *argv = locals->foamDDecl.argv;
803 String id, typeId;
804
805 assert(foamTag(locals) == FOAM_DDecl)do { if (!(((locals)->hdr.tag) == FOAM_DDecl)) _do_assert(
("foamTag(locals) == FOAM_DDecl"),"genlisp.c",805); } while (
0);
806
807 typedVars = sxNil;
808
809 for (i=0; i<argc; i++) {
810 id = argv[i]->foamDecl.id;
811 liId = gl0Id(FOAM_Loc, i, id);
812 typeId = foamInfo(argv[i]->foamDecl.type)(foamInfoTable [(int)(argv[i]->foamDecl.type)-(int)FOAM_START
]).str;
813 typedVars = sxCons(lisp1(liId, gl0typeName(typeId))sxiList(2, liId, gl0typeName(typeId)),
814 typedVars);
815 }
816
817 if (sxiNull(inits0)(((inits0)->sxHdr.tag) == SX_Nil))
818 return sxNReverse(typedVars);
819
820 for(; inits != sxNil; inits = sxCdr(inits)((inits)->sxCons.sxCdrField)) {
821 liId = sxSecond(sxCar(inits))((((((inits)->sxCons.sxCarField))->sxCons.sxCdrField))->
sxCons.sxCarField); /* Nasty ! */
822 typeId = symString(sxiToSymbol(liId))((((liId)->sxSymbol.sym))->str)[0]=='l'
823 ? "Level" : "Env";
824 typedVars = sxCons(lisp1(liId, gl0typeName(typeId))sxiList(2, liId, gl0typeName(typeId)),
825 typedVars);
826 }
827
828 return sxNReverse(typedVars);
829}
830
831
832localstatic SExpr
833gl0typeName(String str)
834{
835 if (strcmp(str,"Rec")==0)
836 return lispId("Record")sxiFrSymbol(symProbe("Record", 1));
837 else
838 return lispId(str)sxiFrSymbol(symProbe(str, 1));
839}
840
841/*
842 * Form an expression with op and foam[start]..foam[argc-1] as args.
843 */
844localstatic SExpr
845gl0ExprOf(SExpr op, int start, Foam foam)
846{
847 SExpr sx;
848 int foami, sxi;
849
850 sx = sxCons(op, sxNil);
851 for (foami = start, sxi = 1; foami < foamArgc(foam)((foam)->hdr.argc); foami++, sxi++)
852 sx = sxCons(gliExpr(foamArgv(foam)((foam)->foamGen.argv)[foami].code), sx);
853 sx = sxNReverse(sx);
854
855 return sx;
856}
857
858localstatic SExpr
859gl0ListOf(Foam foam)
860{
861 SExpr sx;
862 int i;
863
864 sx = sxNil;
865 for (i = 0; i < foamArgc(foam)((foam)->hdr.argc); i++)
866 sx = sxCons(gliExpr(foamArgv(foam)((foam)->foamGen.argv)[i].code), sx);
867 sx = sxNReverse(sx);
868
869 return sx;
870}
871
872/*
873 * Get the declaration object for a global, parameter or local.
874 */
875localstatic Foam
876gl0GetDecl(Foam foam)
877{
878 int ix;
879 Foam decl;
880
881 switch (foamTag(foam)((foam)->hdr.tag)) {
882 case FOAM_Glo:
883 ix = foam->foamGlo.index;
884 decl = glvDGlo->foamDDecl.argv[ix];
885 break;
886 case FOAM_Const:
887 ix = foam->foamConst.index;
888 decl = glvDConst->foamDDecl.argv[ix];
889 break;
890 case FOAM_Par:
891 ix = foam->foamPar.index;
892 decl = glvDPar->foamDDecl.argv[ix];
893 break;
894 case FOAM_Loc:
895 ix = foam->foamLoc.index;
896 decl = glvDLoc->foamDDecl.argv[ix];
897 break;
898 default:
899 bugBadCase(foamTag(foam))bug("Bad case %d (line %d in file %s).", (int) ((foam)->hdr
.tag), 899, "genlisp.c");
900 NotReached(decl = 0){(void)bug("Not supposed to reach line %d in file: %s\n",900,
"genlisp.c");};
901 }
902 assert(foamTag(decl) == FOAM_Decl || foamTag(decl) == FOAM_GDecl)do { if (!(((decl)->hdr.tag) == FOAM_Decl || ((decl)->hdr
.tag) == FOAM_GDecl)) _do_assert(("foamTag(decl) == FOAM_Decl || foamTag(decl) == FOAM_GDecl"
),"genlisp.c",902); } while (0);
903 return decl;
904}
905
906/*
907 * Create the symbol for an identifier, given the level, index and string
908 */
909localstatic SExpr
910gl0Id(FoamTag tag, int idx, String str)
911{
912 String buf;
913
914 if (*str)
915 switch (tag) {
916 case FOAM_Glo: buf = strPrintf("G-%s", str); break;
917 case FOAM_Const: buf = strPrintf("C%d-%s", idx, str); break;
918 case FOAM_Par: buf = strPrintf("P%d-%s", idx, str); break;
919 case FOAM_Loc: buf = strPrintf("T%d-%s", idx, str); break;
920 default: bugBadCase(tag)bug("Bad case %d (line %d in file %s).", (int) tag, 920, "genlisp.c"
); NotReached(buf = 0){(void)bug("Not supposed to reach line %d in file: %s\n",920,
"genlisp.c");};
921 }
922 else
923 switch (tag) {
924 case FOAM_Glo: bugBadCase(tag)bug("Bad case %d (line %d in file %s).", (int) tag, 924, "genlisp.c"
); NotReached(buf = 0){(void)bug("Not supposed to reach line %d in file: %s\n",924,
"genlisp.c");}; break;
925 case FOAM_Const: buf = strPrintf("C%d", idx); break;
926 case FOAM_Par: buf = strPrintf("P%d", idx); break;
927 case FOAM_Loc: buf = strPrintf("T%d", idx); break;
928 default: bugBadCase(tag)bug("Bad case %d (line %d in file %s).", (int) tag, 928, "genlisp.c"
); NotReached(buf = 0){(void)bug("Not supposed to reach line %d in file: %s\n",928,
"genlisp.c");};
929 }
930 return sxiFrSymbol(symIntern(buf)symProbe(buf, 1 | 2));
931}
932
933#define gl0Level(i)gl0VarNum("l", i) gl0VarNum("l", i)
934#define gl0Env(i)gl0VarNum("e", i) gl0VarNum("e", i)
935#define gl0MakeEnv(e,l)sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), e, l) lisp2(GL_MakeEnv, e, l)sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), e, l)
936#define gl0EnvLevel(i)sxiList(2, sxiFrSymbol(symProbe("EnvLevel", 1)), gl0VarNum("e"
, i)) lisp1(GL_EnvLevel, gl0Env(i))sxiList(2, sxiFrSymbol(symProbe("EnvLevel", 1)), gl0VarNum("e"
, i))
937#define gl0EnvNext(i)sxiList(2, sxiFrSymbol(symProbe("EnvNext", 1)), gl0VarNum("e"
, i)) lisp1(GL_EnvNext, gl0Env(i))sxiList(2, sxiFrSymbol(symProbe("EnvNext", 1)), gl0VarNum("e"
, i))
938
939#define gl0EmptyEnv(x)((x == 4) || (((glvDFmt->foamDFmt.argv[x])->hdr.argc) ==
0)) ((x == emptyFormatSlot4) || \
940 (foamArgc(glvDFmt->foamDFmt.argv[x])((glvDFmt->foamDFmt.argv[x])->hdr.argc) == 0))
941
942localstatic SExpr
943gliEnv(Foam foam)
944{
945 int level = foam->foamEnv.level;
946 gl0UseEnv(foam);
947 if (!glvLexFormats) return GL_NilsxiFrSymbol(symProbe("NIL", 1)); /* if at top level */
948 if (glvIsLeaf && level == 0 &&
949 (glvLexFormats->foamDEnv.argv[level] == emptyFormatSlot4
950 || glvLexFormats->foamDEnv.argv[level] == envUsedSlot0))
951 return gl0MakeEnv(gl0VarNum("e", level+1), GL_Nil)sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), gl0VarNum("e"
, level+1), sxiFrSymbol(symProbe("NIL", 1)));
952 else
953 return gl0VarNum("e", level);
954}
955
956localstatic SExpr
957gliDef(Foam foam)
958{
959 SExpr lhs,rhs;
960
961 /* see if we have a function defintion */
962 if (foamTag(foam->foamDef.rhs)((foam->foamDef.rhs)->hdr.tag) != FOAM_Prog) {
963 if (foamTag(foam->foamDef.lhs)((foam->foamDef.lhs)->hdr.tag) == FOAM_Values)
964 return lisp2(GL_MVSetq, gl0ListOf(foam->foamDef.lhs),sxiList(3, sxiFrSymbol(symProbe("MULTIPLE-VALUE-SETQ", 1)), gl0ListOf
(foam->foamDef.lhs), gliExpr(foam->foamDef.rhs))
965 gliExpr(foam->foamDef.rhs))sxiList(3, sxiFrSymbol(symProbe("MULTIPLE-VALUE-SETQ", 1)), gl0ListOf
(foam->foamDef.lhs), gliExpr(foam->foamDef.rhs));
966 lhs=gliExpr(foam->foamDef.lhs);
967 rhs=gliExpr(foam->foamDef.rhs);
968 return gl0SetForm(lhs,rhs);
969 }
970 else
971 return gl0Prog(foam->foamDef.lhs, foam->foamDef.rhs);
972}
973
974/* generate lisp for a Foam program */
975localstatic SExpr
976gl0Prog(Foam lhs, Foam prog)
977{
978 Foam params, locals, body;
979 SExpr sx, ei, hdr;
980 Bool isCoroutine;
981
982 assert(foamTag(prog) == FOAM_Prog)do { if (!(((prog)->hdr.tag) == FOAM_Prog)) _do_assert(("foamTag(prog) == FOAM_Prog"
),"genlisp.c",982); } while (0);
983
984 params = prog->foamProg.params;
985 locals = prog->foamProg.locals;
986 body = prog->foamProg.body;
987 isCoroutine = foamProgIsCoroutine(prog)((prog)->foamProg.infoBits & (1 << 7));
988 glvLabelNum = 0;
989 glvHasGoto = 0;
990 glvDPar = params;
991 glvDLoc = locals;
992 glvProg = prog;
993 glvIsLeaf = foamProgIsLeaf(prog)((prog)->foamProg.infoBits & (1 << 1));
994 glvLexFormats= prog->foamProg.levels;
995 glvActualLexFormats = gl0InitFormats(glvLexFormats);
996 glvFunName = isCoroutine ? gl0IdCRProgName(lhs): gl0IdName(lhs);
997
998 glvIsCoroutine = isCoroutine;
999
1000 sx = gliExpr(body);
1001 ei = gl0EnvInit(prog);
1002
1003 if (glvHasGoto) {
1004 sx = gl0FlattenProgn(sx);
1005 }
1006
1007 if (glvIsCoroutine) {
1008 SExpr mkenv = glvActualLexFormats->foamDEnv.argv[0] == emptyFormatSlot4
1009 ? GL_NilsxiFrSymbol(symProbe("NIL", 1))
1010 : gl0MakeEnv(gl0Env(1), gl0MakeLevel(glvActualLexFormats->foamDEnv.argv[0]))sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), gl0VarNum("e"
, 1), gl0MakeLevel(glvActualLexFormats->foamDEnv.argv[0]));
1011 hdr = lisp4(GL_DefCoroutine,sxiList(5, sxiFrSymbol(symProbe("DEFCOROUTINE", 1)), gl0IdName
(lhs), gl0ProgType(lhs, prog), sxiList(2, gl0VarNum("e", 1), mkenv
), gl0MakeLocals(locals, ei))
1012 gl0IdName(lhs),sxiList(5, sxiFrSymbol(symProbe("DEFCOROUTINE", 1)), gl0IdName
(lhs), gl0ProgType(lhs, prog), sxiList(2, gl0VarNum("e", 1), mkenv
), gl0MakeLocals(locals, ei))
1013 gl0ProgType(lhs, prog),sxiList(5, sxiFrSymbol(symProbe("DEFCOROUTINE", 1)), gl0IdName
(lhs), gl0ProgType(lhs, prog), sxiList(2, gl0VarNum("e", 1), mkenv
), gl0MakeLocals(locals, ei))
1014 sxiList(2, gl0Env(1), mkenv),sxiList(5, sxiFrSymbol(symProbe("DEFCOROUTINE", 1)), gl0IdName
(lhs), gl0ProgType(lhs, prog), sxiList(2, gl0VarNum("e", 1), mkenv
), gl0MakeLocals(locals, ei))
1015 gl0MakeLocals(locals, ei))sxiList(5, sxiFrSymbol(symProbe("DEFCOROUTINE", 1)), gl0IdName
(lhs), gl0ProgType(lhs, prog), sxiList(2, gl0VarNum("e", 1), mkenv
), gl0MakeLocals(locals, ei));
1016 }
1017 else {
1018 hdr = sxCons(GL_DefProgsxiFrSymbol(symProbe("DEFPROG", 1)),
1019 sxCons(gl0ProgType(lhs,prog),
1020 lisp0(gl0MakeLocals(locals,ei))sxiList(1, gl0MakeLocals(locals,ei))));
1021 }
1022 if (sxCar(sx)((sx)->sxCons.sxCarField) == GL_PrognsxiFrSymbol(symProbe("PROGN", 1))) sx = sxCdr(sx)((sx)->sxCons.sxCdrField);
1023 else sx = lisp0(sx)sxiList(1, sx);
1024
1025 glvLexFormats = 0;
1026 foamFree(glvActualLexFormats);
1027 glvActualLexFormats = NULL((void*)0);
1028 return(sxNConc(hdr,sxNConc(ei,sx)));
1029}
1030
1031localstatic Foam
1032gl0InitFormats(Foam foam)
1033{
1034 Foam new;
1035 int i;
1036 assert(foamTag(foam) == FOAM_DEnv)do { if (!(((foam)->hdr.tag) == FOAM_DEnv)) _do_assert(("foamTag(foam) == FOAM_DEnv"
),"genlisp.c",1036); } while (0);
1037 new = foamCopy(foam);
1038 for (i=0; i<foamArgc(foam)((foam)->hdr.argc); i++)
1039 new->foamDEnv.argv[i] = (AInt) emptyFormatSlot4;
1040
1041 return new;
1042}
1043
1044/* make lexical environment initializations */
1045localstatic SExpr
1046gl0EnvInit(Foam prog)
1047{
1048 Foam levels = glvActualLexFormats;
1049 SExpr sx = sxNil;
1050 SExpr chain;
1051 int index = foamProgIndex(prog)((prog)->foamProg.levels->foamDEnv.argv[0]);
1052
1053 int i, level, maxLevel = -1;
1054
1055 if (foamProgIsCoroutine(prog)((prog)->foamProg.infoBits & (1 << 7)) && !foamProgIsLeaf(prog)((prog)->foamProg.infoBits & (1 << 1))) {
1056 sx = sxCons(lisp2(GL_Setq, gl0Level(int0), gl0EnvLevel(0))sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), gl0VarNum("l", (
(int) 0)), sxiList(2, sxiFrSymbol(symProbe("EnvLevel", 1)), gl0VarNum
("e", 0))), sx);
1057 }
1058 else if (!foamProgIsLeaf(prog)((prog)->foamProg.infoBits & (1 << 1))) {
1059 sx = sxCons(lisp2(GL_Setq, gl0Level(int0),sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), gl0VarNum("l", (
(int) 0)), gl0MakeLevel(index))
1060 gl0MakeLevel(index))sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), gl0VarNum("l", (
(int) 0)), gl0MakeLevel(index)), sx);
1061 sx = sxCons(lisp2(GL_Setq, gl0Env(int0),sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), gl0VarNum("e", (
(int) 0)), sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), gl0VarNum
("e", 1), gl0VarNum("l", ((int) 0))))
1062 gl0MakeEnv(gl0Env(1), gl0Level(int0)))sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), gl0VarNum("e", (
(int) 0)), sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), gl0VarNum
("e", 1), gl0VarNum("l", ((int) 0)))), sx);
1063 }
1064 /* compute highest lex level used */
1065
1066 for (i=1; i< foamArgc(levels)((levels)->hdr.argc); i++) {
1067 level = levels->foamDEnv.argv[i];
1068 if (!gl0EmptyEnv(level)((level == 4) || (((glvDFmt->foamDFmt.argv[level])->hdr
.argc) == 0)) || level == envUsedSlot0) maxLevel = i;
1069 }
1070
1071 /* Construct initialiser block */
1072 chain = sxNil;
1073 for (i=1; i <= maxLevel; i++) {
1074 level = levels->foamDEnv.argv[i];
1075
1076 if (i == 1)
1077 chain = gl0EnvNext(i)sxiList(2, sxiFrSymbol(symProbe("EnvNext", 1)), gl0VarNum("e"
, i));
1078 else if (level == envUsedSlot0 || !gl0EmptyEnv(level)((level == 4) || (((glvDFmt->foamDFmt.argv[level])->hdr
.argc) == 0))) {
1079 sx = sxCons(lisp2(GL_Setq, gl0Env(i), chain)sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), gl0VarNum("e", i
), chain),
1080 sx);
1081 chain = gl0EnvNext(i)sxiList(2, sxiFrSymbol(symProbe("EnvNext", 1)), gl0VarNum("e"
, i));
1082 }
1083 else
1084 chain = lisp1(GL_EnvNext, chain)sxiList(2, sxiFrSymbol(symProbe("EnvNext", 1)), chain);
1085
1086 if (!gl0EmptyEnv(level)((level == 4) || (((glvDFmt->foamDFmt.argv[level])->hdr
.argc) == 0)) && level != envUsedSlot0)
1087 sx = sxCons(lisp2(GL_Setq, gl0Level(i),sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), gl0VarNum("l", i
), sxiList(2, sxiFrSymbol(symProbe("EnvLevel", 1)), gl0VarNum
("e", i)))
1088 gl0EnvLevel(i))sxiList(3, sxiFrSymbol(symProbe("SETQ", 1)), gl0VarNum("l", i
), sxiList(2, sxiFrSymbol(symProbe("EnvLevel", 1)), gl0VarNum
("e", i))), sx);
1089 }
1090 if (chain != sxNil) sxiFree(chain);
1091 return sxNReverse(sx);
1092}
1093
1094localstatic SExpr
1095gl0MakeLevel(int i)
1096{
1097 String buf;
1098
1099 if (gl0EmptyEnv(i)((i == 4) || (((glvDFmt->foamDFmt.argv[i])->hdr.argc) ==
0)) || i == envUsedSlot0) return GL_NilsxiFrSymbol(symProbe("NIL", 1));
1100
1101 buf = strPrintf("MAKE-Struct-%s-%d", glvFileName, i);
1102 return lisp2(GL_MakeLevel,lispId(buf), lispId(buf+strlen("MAKE-")))sxiList(3, sxiFrSymbol(symProbe("MakeLevel", 1)), sxiFrSymbol
(symProbe(buf, 1)), sxiFrSymbol(symProbe(buf+strlen("MAKE-"),
1)));
1103}
1104
1105localstatic void
1106gl0UseEnv(Foam foam)
1107{
1108 AInt val;
1109 int level;
1110
1111 switch(foamTag(foam)((foam)->hdr.tag)) {
1112 case FOAM_Lex:
1113 level = foam->foamLex.level;
1114 val = glvLexFormats->foamDEnv.argv[level];
1115 break;
1116 case FOAM_Env:
1117 level = foam->foamEnv.level;
1118 val = 0;
1119 break;
1120 default:
1121 level = 0;
1122 val = 0;
1123 bug("Use Env called with non-lex instr");
1124 break;
1125 }
1126
1127 if (glvLexFormats == NULL((void*)0)) {
1128#if 0
1129 printf("Internal warning: Use Env called outside gl0Prog (glvLexFormats is NULL)\n");
1130#endif
1131 return;
1132 }
1133 if (glvActualLexFormats->foamDEnv.argv[level] == emptyFormatSlot4
1134 || glvActualLexFormats->foamDEnv.argv[level] == 0)
1135 glvActualLexFormats->foamDEnv.argv[level] = val;
1136
1137}
1138
1139localstatic SExpr
1140gl0VarNum(String s, int i)
1141{
1142 String buf;
1143 buf = strPrintf("%s%d", s, i);
1144 return lispId(buf)sxiFrSymbol(symProbe(buf, 1));
1145}
1146
1147/* make proclaim for each define and add name to defun list. */
1148localstatic SExpr
1149gl0MakeDeclare(Foam foam)
1150{
1151 int tag;
1152 Foam rhs, lhs;
1153
1154 if (foamTag(foam)((foam)->hdr.tag) != FOAM_Def) return sxNil;
1155
1156 rhs = foam->foamDef.rhs;
1157 lhs = foam->foamDef.lhs;
1158 tag = foamTag(rhs)((rhs)->hdr.tag);
1159
1160 if (foamTag(lhs)((lhs)->hdr.tag) != FOAM_Glo && foamTag(lhs)((lhs)->hdr.tag) != FOAM_Const)
1161 return sxNil;
1162
1163 switch (tag) {
1164 case FOAM_OCall:
1165 return gl0DeclareVar(lhs,rhs->foamOCall.type);
1166 case FOAM_CCall:
1167 return gl0DeclareVar(lhs,rhs->foamCCall.type);
1168 case FOAM_BCall:
1169 return gl0DeclareVar(lhs,foamBValRetType(rhs->foamBCall.op)((foamBValInfoTable[(int)(rhs->foamBCall.op)-(int)FOAM_BVAL_START
]).retType));
1170 case FOAM_Clos:
1171 return gl0DeclareVar(lhs, FOAM_Clos);
1172 case FOAM_Prog:
1173 return gl0DeclareDefun(lhs, rhs);
1174 default:
1175 return sxNil;
1176 }
1177}
1178
1179
1180localstatic SExpr
1181gl0MakeUnitIface(Foam defs, Foam globals)
1182{
1183 SExpr imports = sxNil;
1184 SExpr exports = sxNil;
1185 Foam gdecl;
1186 int i;
1187
1188 assert(foamTag(defs) == FOAM_DDef)do { if (!(((defs)->hdr.tag) == FOAM_DDef)) _do_assert(("foamTag(defs) == FOAM_DDef"
),"genlisp.c",1188); } while (0);
1189 assert(foamTag(globals) == FOAM_DDecl)do { if (!(((globals)->hdr.tag) == FOAM_DDecl)) _do_assert
(("foamTag(globals) == FOAM_DDecl"),"genlisp.c",1189); } while
(0);
1190
1191 for (i=0; i<foamDDeclArgc(globals)(((globals)->hdr.argc) - (1)); i++) {
1192 gdecl = globals->foamDDecl.argv[i];
1193 if (gdecl->foamGDecl.protocol != FOAM_Proto_Foam
1194 && gdecl->foamGDecl.protocol != FOAM_Proto_Init)
1195 continue;
1196 else if (gdecl->foamGDecl.dir == FOAM_GDecl_Import)
1197 imports = sxCons(gl0IdInfo(gdecl, i),
1198 imports);
1199 else if (gdecl->foamGDecl.dir == FOAM_GDecl_Export)
1200 exports = sxCons(gl0IdInfo(gdecl, i),
1201 exports);
1202 else
1203 bug("odd value for gdecl direction");
1204 }
1205 exports = lisp1(GL_FileExports, lisp1(GL_Quote, exports))sxiList(2, sxiFrSymbol(symProbe("FILE-EXPORTS", 1)), sxiList(
2, sxiFrSymbol(symProbe("QUOTE", 1)), exports));
1206 imports = lisp1(GL_FileImports, lisp1(GL_Quote, imports))sxiList(2, sxiFrSymbol(symProbe("FILE-IMPORTS", 1)), sxiList(
2, sxiFrSymbol(symProbe("QUOTE", 1)), imports));
1207
1208 exports = lisp1(exports, imports)sxiList(2, exports, imports);
1209 return exports;
1210}
1211
1212
1213/* make proclaim for each define and add name to defun list. */
1214localstatic SExpr
1215gl0MakeSpecial(Foam foam, SExpr specList)
1216{
1217 Foam lhs;
1218
1219 if (foamTag(foam)((foam)->hdr.tag) != FOAM_Def) return specList;
1220 lhs = foam->foamDef.lhs;
1221 if (foamTag(lhs)((lhs)->hdr.tag) != FOAM_Glo) return specList;
1222 return sxCons(gl0IdName(lhs), specList);
1223
1224}
1225
1226localstatic SExpr
1227gliPushEnv(Foam foam)
1228{
1229 SExpr sx;
1230 int fmt = foam->foamPushEnv.format;
1231
1232 if (fmt == emptyFormatSlot4 || fmt == envUsedSlot0)
1233 sx = gl0MakeEnv(gliExpr(foam->foamPushEnv.parent), GL_Nil)sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), gliExpr(foam->
foamPushEnv.parent), sxiFrSymbol(symProbe("NIL", 1)));
1234 else
1235 sx = gl0MakeEnv(gliExpr(foam->foamPushEnv.parent),sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), gliExpr(foam->
foamPushEnv.parent), gl0MakeLevel(fmt))
1236 gl0MakeLevel(fmt))sxiList(3, sxiFrSymbol(symProbe("MakeEnv", 1)), gliExpr(foam->
foamPushEnv.parent), gl0MakeLevel(fmt));
1237 return sx;
1238}
1239
1240localstatic SExpr
1241gliEInfo(Foam foam)
1242{
1243 return lisp1(GL_EnvInfo, gliExpr(foam->foamEInfo.env))sxiList(2, sxiFrSymbol(symProbe("EnvInfo", 1)), gliExpr(foam->
foamEInfo.env));
1244}
1245
1246localstatic SExpr
1247gliPRef(Foam foam)
1248{
1249 return lisp1(GL_ProgHash, gliExpr(foam->foamPRef.prog))sxiList(2, sxiFrSymbol(symProbe("ProgHashCode", 1)), gliExpr(
foam->foamPRef.prog));
1250}
1251
1252localstatic SExpr
1253gliEEnv(Foam foam)
1254{
1255 return gl0EEnv(gliExpr(foam->foamEEnv.env), foam->foamEEnv.level);
1256}
1257
1258localstatic SExpr
1259gl0EEnv(SExpr env, int level)
1260{
1261 SExpr sx = env;
1262
1263 while (level-- > 0)
1264 sx = lisp1(GL_EnvNext, sx)sxiList(2, sxiFrSymbol(symProbe("EnvNext", 1)), sx);
1265 return sx;
1266}
1267
1268#define typeIdentifier(type)(gl0typeName((foamInfoTable [(int)(type)-(int)FOAM_START]).str
)) (gl0typeName(foamInfo(type)(foamInfoTable [(int)(type)-(int)FOAM_START]).str))
1269
1270localstatic SExpr
1271gl0DeclareVar(Foam lhs, int type)
1272{
1273 SExpr name = gl0IdName(lhs);
1274 SExpr ltype = typeIdentifier(type)(gl0typeName((foamInfoTable [(int)(type)-(int)FOAM_START]).str
));
1275 return lisp2(GL_DeclareType, name, ltype)sxiList(3, sxiFrSymbol(symProbe("DECLARE-TYPE", 1)), name, ltype
);
1276}
1277
1278localstatic SExpr
1279gl0DeclareDefun(Foam lhs, Foam rhs)
1280{
1281 return sxCons(GL_DeclareFunctionsxiFrSymbol(symProbe("DECLARE-PROG", 1)), gl0ProgType(lhs,rhs));
1282}
1283
1284
1285localstatic SExpr
1286gl0ProgType(Foam lhs, Foam rhs)
1287{
1288 SExpr name, argTypes, retTypes, sx;
1289 Foam params, *argv, format, decl;
1290 AInt type;
1291 int i;
1292
1293 name = glvIsCoroutine ? gl0IdCRProgName(lhs) : gl0IdName(lhs);
1294 params = rhs->foamProg.params;
1295 argv = params->foamDDecl.argv;
1296 argTypes = sxNil;
1297
1298 /* parameters..*/
1299 for (i = 0; i < foamDDeclArgc(params)(((params)->hdr.argc) - (1)); i++)
1300 argTypes = sxCons(lisp1(gl0Id(FOAM_Par,i,argv[i]->foamDecl.id),sxiList(2, gl0Id(FOAM_Par,i,argv[i]->foamDecl.id), (gl0typeName
((foamInfoTable [(int)(argv[i]->foamDecl.type)-(int)FOAM_START
]).str)))
1301 typeIdentifier(argv[i]->foamDecl.type))sxiList(2, gl0Id(FOAM_Par,i,argv[i]->foamDecl.id), (gl0typeName
((foamInfoTable [(int)(argv[i]->foamDecl.type)-(int)FOAM_START
]).str))),
1302 argTypes);
1303
1304 argTypes = sxCons(lisp1( GL_e1, GL_Env)sxiList(2, sxiFrSymbol(symProbe("e1", 1)), sxiFrSymbol(symProbe
("Env", 1))), argTypes);
1305 if (foamProgIsCoroutine(rhs)((rhs)->foamProg.infoBits & (1 << 7))) {
1306 argTypes = sxCons(lisp1( GL_e0, GL_Env)sxiList(2, sxiFrSymbol(symProbe("e0", 1)), sxiFrSymbol(symProbe
("Env", 1))), argTypes);
1307 }
1308
1309 argTypes = sxNReverse(argTypes);
1310
1311 /* Return type */
1312 type = rhs->foamProg.retType;
1313 retTypes = sxNil;
1314 if (type == FOAM_NOp){
1315 /* multiple value return case */
1316 int fmt=rhs->foamProg.format;
1317 if (fmt==0)
1318 retTypes=sxNil;
1319 else {
1320 format = glvDFmt->foamDFmt.argv[fmt];
1321 for (i = 0; i < foamDDeclArgc(format)(((format)->hdr.argc) - (1)); i++){
1322 decl = format->foamDDecl.argv[i];
1323 retTypes =
1324 sxCons(typeIdentifier(decl->foamDecl.type)(gl0typeName((foamInfoTable [(int)(decl->foamDecl.type)-(int
)FOAM_START]).str)),
1325 retTypes);
1326 }
1327 }
1328 retTypes = sxNReverse(retTypes);
1329 }
1330 /* single value return case */
1331 else retTypes = sxCons(typeIdentifier(type)(gl0typeName((foamInfoTable [(int)(type)-(int)FOAM_START]).str
)), sxNil);
1332
1333 sx = lisp1(sxCons(name, retTypes), argTypes)sxiList(2, sxCons(name, retTypes), argTypes);
1334 return sx;
1335}
1336
1337localstatic SExpr
1338gliPCall(Foam foam)
1339{
1340 SExpr sx;
1341 int foami;
1342
1343 /*!! check for lisp protocol */
1344 sx = sxCons(gl0IdPlainName(foam->foamPCall.op), sxNil);
1345 /* slot 3 is the first function argument. */
1346 for (foami = 3; foami < foamArgc(foam)((foam)->hdr.argc); foami++)
1347 sx = sxCons(gliExpr(foamArgv(foam)((foam)->foamGen.argv)[foami].code), sx);
1348 sx = sxNReverse(sx);
1349
1350 return sx;
1351}
1352
1353localstatic SExpr
1354gl0OpenCall(Foam foam)
1355{
1356 SExpr sx;
1357 int foami;
1358
1359 sx = sxCons(gl0IdName(foam->foamOCall.op), sxNil);
1360 /* slot 3 is the first function argument. */
1361 for (foami = 3; foami < foamArgc(foam)((foam)->hdr.argc); foami++)
1362 sx = sxCons(gliExpr(foamArgv(foam)((foam)->foamGen.argv)[foami].code), sx);
1363 /* slot 2 is the environment. */
1364 sx = sxCons(gliExpr(foamArgv(foam)((foam)->foamGen.argv)[2].code), sx);
1365 sx = sxNReverse(sx);
1366
1367 return sx;
1368}
1369
1370/* create a lisp DEFSTRUCT for a given Foam format */
1371localstatic SExpr
1372gl0MakeDDecl(int formatIndex)
1373{
1374 Foam decl, format = glvDFmt->foamDFmt.argv[formatIndex];
1375 int i;
1376 SExpr def, field, type;
1377 String typeId;
1378
1379 assert(foamTag(format) == FOAM_DDecl)do { if (!(((format)->hdr.tag) == FOAM_DDecl)) _do_assert(
("foamTag(format) == FOAM_DDecl"),"genlisp.c",1379); } while (
0);
1380
1381 if (formatIndex == envUsedSlot0) return sxNil;
1382 if (foamDDeclArgc(format)(((format)->hdr.argc) - (1)) == 0) return sxNil;
1383
1384 def = sxNil;
1385
1386 for (i=foamDDeclArgc(format)(((format)->hdr.argc) - (1))-1; i>=0; i--) {
1387 decl = format->foamDDecl.argv[i];
1388 assert(foamTag(decl) == FOAM_Decl)do { if (!(((decl)->hdr.tag) == FOAM_Decl)) _do_assert(("foamTag(decl) == FOAM_Decl"
),"genlisp.c",1388); } while (0);
1389 field = gl0FieldName(decl->foamDecl.id, i);
1390 typeId = foamStr(decl->foamDecl.type)((foamInfoTable [(int)(decl->foamDecl.type)-(int)FOAM_START
]).str);
1391 type = gl0typeName(typeId);
1392 def = sxCons(lisp1(field, type)sxiList(2, field, type), def);
1393 }
1394
1395 SExpr name = gl0StructName(formatIndex);
1396 return sxCons(GL_DDeclsxiFrSymbol(symProbe("DDecl", 1)), sxCons(name, def));
1397}
1398
1399localstatic SExpr
1400gl0FieldName(String field, int i)
1401{
1402 String buf;
1403 buf = strPrintf("%s-%d", field, i);
1404 return lispId(buf)sxiFrSymbol(symProbe(buf, 1));
1405}
1406
1407/*!! give it a unique name */
1408localstatic SExpr
1409gl0StructName(int i)
1410{
1411 String buf;
1412 buf = strPrintf("Struct-%s-%d", glvFileName, i);
1413 return lispId(buf)sxiFrSymbol(symProbe(buf, 1));
1414}
1415
1416localstatic SExpr
1417gl0EnvStructName(int i)
1418{
1419 String buf;
1420 buf = strPrintf("EnvStruct-%s-%d", glvFileName, i);
1421 return lispId(buf)sxiFrSymbol(symProbe(buf, 1));
1422}
1423
1424localstatic SExpr
1425gl0MakeKeyword(String s)
1426{
1427 return sx0InternInFrString(s, sx0KeywordPackage);
1428}
1429
1430#if 0
1431/* generate file initialization code */
1432localstatic SExpr
1433gl0InitCode(Foam foam, SExpr defl)
1434{
1435 SExpr code, forms = sxNil, initFn, initEnv;
1436 String initName;
1437
1438 assert (foamTag(foam) == FOAM_Unit)do { if (!(((foam)->hdr.tag) == FOAM_Unit)) _do_assert(("foamTag(foam) == FOAM_Unit"
),"genlisp.c",1438); } while (0);
1439
1440 initFn = sxSecond(sxCar(defl))((((((defl)->sxCons.sxCarField))->sxCons.sxCdrField))->
sxCons.sxCarField);
1441 initName = sxiToString(sxSymbolName(initFn))strCopy(((sxiFrString(((((initFn)->sxSymbol.sym))->str)
))->sxString.val));
1442 initName[0] = 'E';
1443 initEnv = lispId(initName)sxiFrSymbol(symProbe(initName, 1));
1444
1445 /* set up call to initialization program. */
1446 code = lisp1(GL_CCall, initFn)sxiList(2, sxiFrSymbol(symProbe("CCall", 1)), initFn);
1447 forms = sxNReverse(sxCons(code, forms));
1448 code = sxCons(GL_EvalWhensxiFrSymbol(symProbe("EVAL-WHEN", 1)), sxCons(lisp1(GL_Load, GL_Eval)sxiList(2, sxiFrSymbol(symProbe("LOAD", 1)), sxiFrSymbol(symProbe
("EVAL", 1))), forms));
1449 return sxCons(code, defl);
1450}
1451#endif
1452
1453/* generate lisp strings for arrays. */
1454localstatic SExpr
1455gliArr(Foam foam)
1456{
1457 String s;
1458 int i;
1459 assert(foamTag(foam) == FOAM_Arr)do { if (!(((foam)->hdr.tag) == FOAM_Arr)) _do_assert(("foamTag(foam) == FOAM_Arr"
),"genlisp.c",1459); } while (0);
1460 assert(foam->foamArr.baseType == FOAM_Char)do { if (!(foam->foamArr.baseType == FOAM_Char)) _do_assert
(("foam->foamArr.baseType == FOAM_Char"),"genlisp.c",1460)
; } while (0);
1461
1462 s = strAlloc(foamArgc(foam)((foam)->hdr.argc));
1463 for(i=0; i < foamArgc(foam)((foam)->hdr.argc)-1; i++) s[i] = foam->foamArr.eltv[i];
1464 s[i] = 0;
1465 return lisp1(GL_MakeLit,sxiFrString(s))sxiList(2, sxiFrSymbol(symProbe("MakeLit", 1)), sxiFrString(s
));
1466}
1467
1468localstatic SExpr
1469gliEElt(Foam foam)
1470{
1471 int lv = foam->foamEElt.level;
1472 int ix = foam->foamEElt.lex;
1473 int fi = foam->foamEElt.env;
1474 Foam ddecl = glvDFmt->foamDFmt.argv[fi];
1475 Foam decl = ddecl->foamDDecl.argv[ix];
1476 SExpr envRef = gl0EnvRef(lv, gliExpr(foam->foamEElt.ref));
1477 String buf;
1478 SExpr access;
1479
1480 assert (foamTag(ddecl) == FOAM_DDecl)do { if (!(((ddecl)->hdr.tag) == FOAM_DDecl)) _do_assert((
"foamTag(ddecl) == FOAM_DDecl"),"genlisp.c",1480); } while (0
);
1481 assert (foamTag(decl) == FOAM_Decl)do { if (!(((decl)->hdr.tag) == FOAM_Decl)) _do_assert(("foamTag(decl) == FOAM_Decl"
),"genlisp.c",1481); } while (0);
1482 assert (strlen(decl->foamDecl.id) < 180)do { if (!(strlen(decl->foamDecl.id) < 180)) _do_assert
(("strlen(decl->foamDecl.id) < 180"),"genlisp.c",1482);
} while (0);
1483
1484 buf = strPrintf("Struct-%s-%d-%s-%d", glvFileName,
1485 fi, decl->foamDecl.id, ix);
1486 access = lispId(buf)sxiFrSymbol(symProbe(buf, 1));
1487 return lisp3(GL_EElt,access,sxiFrInteger(ix),envRef)sxiList(4, sxiFrSymbol(symProbe("EElt", 1)), access, sxiFrInteger
(ix), envRef);
1488}
1489
1490localstatic SExpr
1491gl0EnvRef(int level, SExpr env)
1492{
1493 int i;
1494 for(i=0; i< level; i++)
1495 env = lisp1(GL_EnvNext, env)sxiList(2, sxiFrSymbol(symProbe("EnvNext", 1)), env);
1496 return lisp1(GL_EnvLevel, env)sxiList(2, sxiFrSymbol(symProbe("EnvLevel", 1)), env);
1497}
1498
1499localstatic SExpr
1500gliIf(Foam foam)
1501{
1502 glvHasGoto = 1;
1503 return lisp2(GL_When, gliExpr(foam->foamIf.test),sxiList(3, sxiFrSymbol(symProbe("WHEN", 1)), gliExpr(foam->
foamIf.test), sxiList(2, sxiFrSymbol(symProbe("GO", 1)), sxiFrSymbol
(symProbe(strPrintf("Lab%d", foam->foamIf.label), 1))))
1504 lisp1(GL_Go,sxiList(3, sxiFrSymbol(symProbe("WHEN", 1)), gliExpr(foam->
foamIf.test), sxiList(2, sxiFrSymbol(symProbe("GO", 1)), sxiFrSymbol
(symProbe(strPrintf("Lab%d", foam->foamIf.label), 1))))
1505 lispId(strPrintf("Lab%d", foam->foamIf.label))))sxiList(3, sxiFrSymbol(symProbe("WHEN", 1)), gliExpr(foam->
foamIf.test), sxiList(2, sxiFrSymbol(symProbe("GO", 1)), sxiFrSymbol
(symProbe(strPrintf("Lab%d", foam->foamIf.label), 1))));
1506}
1507
1508localstatic SExpr
1509gl0FlattenProgn(SExpr sx)
1510{
1511 SExpr r;
1512 if (sxCar(sx)((sx)->sxCons.sxCarField) != GL_PrognsxiFrSymbol(symProbe("PROGN", 1))) return sx;
1513 r = sxCons(GL_SeqsxiFrSymbol(symProbe("TAGBODY", 1)), sxNReverse(gl0FlattenProg1(sxCdr(sx)((sx)->sxCons.sxCdrField))));
1514 return r;
1515}
1516
1517localstatic SExpr
1518gl0FlattenProg1(SExpr sx)
1519{
1520 SExpr stmts = sxNil;
1521 if (sxiNull(sx)(((sx)->sxHdr.tag) == SX_Nil)) return stmts;
1522 for(; !sxiNull(sx)(((sx)->sxHdr.tag) == SX_Nil); sx = sxCdr(sx)((sx)->sxCons.sxCdrField)) {
1523 if (sxiConsP(sxCar(sx))(((((sx)->sxCons.sxCarField))->sxHdr.tag) == SX_Cons) && sxCar(sxCar(sx))((((sx)->sxCons.sxCarField))->sxCons.sxCarField) == GL_PrognsxiFrSymbol(symProbe("PROGN", 1))) {
1524 stmts = sxNConc(gl0FlattenProg1(sxCdr(sxCar(sx))((((sx)->sxCons.sxCarField))->sxCons.sxCdrField)),
1525 stmts);
1526 }
1527 else
1528 stmts = sxCons(sxCar(sx)((sx)->sxCons.sxCarField), stmts);
1529 }
1530 return stmts;
1531}
1532
1533localstatic SExpr
1534gliSelect(Foam foam)
1535{
1536 int i, n = foamArgc(foam)((foam)->hdr.argc) - 1;
1537 SExpr branches = sxNil, key;
1538
1539 glvHasGoto = 1;
1540 key = gliExpr(foam->foamSelect.op);
1541 for(i=0; i < n; i++)
1542 branches = sxCons(lisp1(sxiFrInteger(i),sxiList(2, sxiFrInteger(i), sxiList(2, sxiFrSymbol(symProbe("GO"
, 1)), sxiFrSymbol(symProbe(strPrintf("Lab%d", foam->foamSelect
.argv[i]), 1))))
1543 lisp1(GL_Go,sxiList(2, sxiFrInteger(i), sxiList(2, sxiFrSymbol(symProbe("GO"
, 1)), sxiFrSymbol(symProbe(strPrintf("Lab%d", foam->foamSelect
.argv[i]), 1))))
1544 lispId(strPrintf("Lab%d", foam->foamSelect.argv[i]))))sxiList(2, sxiFrInteger(i), sxiList(2, sxiFrSymbol(symProbe("GO"
, 1)), sxiFrSymbol(symProbe(strPrintf("Lab%d", foam->foamSelect
.argv[i]), 1)))),
1545 branches);
1546 return sxCons(GL_CasesxiFrSymbol(symProbe("CASES", 1)), sxCons(key, branches));
1547}
1548
1549localstatic SExpr
1550gliANew(Foam foam)
1551{
1552 return sxiList(3,
1553 GL_ANewsxiFrSymbol(symProbe("ANew", 1)),
1554 gl0typeName(foamInfo(foam->foamANew.eltType)(foamInfoTable [(int)(foam->foamANew.eltType)-(int)FOAM_START
]).str),
1555 gliExpr(foam->foamANew.size));
1556}
1557
1558localstatic SExpr
1559gliRNew(Foam foam)
1560{
1561 SExpr name = gl0StructName(foam->foamRNew.format);
1562 return lisp1(GL_RNew, name)sxiList(2, sxiFrSymbol(symProbe("RNew", 1)), name);
1563}
1564
1565localstatic SExpr
1566gliAElt(Foam foam)
1567{
1568 return lisp2(GL_AElt, gliExpr(foam->foamAElt.expr),sxiList(3, sxiFrSymbol(symProbe("AElt", 1)), gliExpr(foam->
foamAElt.expr), gliExpr(foam->foamAElt.index))
1569 gliExpr(foam->foamAElt.index))sxiList(3, sxiFrSymbol(symProbe("AElt", 1)), gliExpr(foam->
foamAElt.expr), gliExpr(foam->foamAElt.index));
1570}
1571
1572localstatic SExpr
1573gliRElt(Foam foam)
1574{
1575 int ix = foam->foamRElt.field;
1576 int fi = foam->foamRElt.format;
1577 Foam ddecl = glvDFmt->foamDFmt.argv[fi];
1578 Foam decl = ddecl->foamDDecl.argv[ix];
1579
1580 assert (foamTag(ddecl) == FOAM_DDecl)do { if (!(((ddecl)->hdr.tag) == FOAM_DDecl)) _do_assert((
"foamTag(ddecl) == FOAM_DDecl"),"genlisp.c",1580); } while (0
);
1581 assert (foamTag(decl) == FOAM_Decl)do { if (!(((decl)->hdr.tag) == FOAM_Decl)) _do_assert(("foamTag(decl) == FOAM_Decl"
),"genlisp.c",1581); } while (0);
1582 assert (strlen(decl->foamDecl.id) < 180)do { if (!(strlen(decl->foamDecl.id) < 180)) _do_assert
(("strlen(decl->foamDecl.id) < 180"),"genlisp.c",1582);
} while (0);
1583
1584 return lisp4(GL_RElt,sxiList(5, sxiFrSymbol(symProbe("RElt", 1)), gl0StructName(fi
), sxiFrSymbol(symProbe(decl->foamDecl.id, 1)), sxiFrInteger
(ix), gliExpr(foam->foamRElt.expr))
1585 gl0StructName(fi),sxiList(5, sxiFrSymbol(symProbe("RElt", 1)), gl0StructName(fi
), sxiFrSymbol(symProbe(decl->foamDecl.id, 1)), sxiFrInteger
(ix), gliExpr(foam->foamRElt.expr))
1586 lispId(decl->foamDecl.id),sxiList(5, sxiFrSymbol(symProbe("RElt", 1)), gl0StructName(fi
), sxiFrSymbol(symProbe(decl->foamDecl.id, 1)), sxiFrInteger
(ix), gliExpr(foam->foamRElt.expr))
1587 sxiFrInteger(ix),sxiList(5, sxiFrSymbol(symProbe("RElt", 1)), gl0StructName(fi
), sxiFrSymbol(symProbe(decl->foamDecl.id, 1)), sxiFrInteger
(ix), gliExpr(foam->foamRElt.expr))
1588 gliExpr(foam->foamRElt.expr))sxiList(5, sxiFrSymbol(symProbe("RElt", 1)), gl0StructName(fi
), sxiFrSymbol(symProbe(decl->foamDecl.id, 1)), sxiFrInteger
(ix), gliExpr(foam->foamRElt.expr));
1589}
1590
1591localstatic SExpr
1592gliGener(Foam foam)
1593{
1594 return lisp3(GL_Gener,sxiList(4, sxiFrSymbol(symProbe("Gener", 1)), gliExpr(foam->
foamGener.env), gl0StructName(foam->foamGener.fmt), gliExpr
(foam->foamGener.prog))
1595 gliExpr(foam->foamGener.env),sxiList(4, sxiFrSymbol(symProbe("Gener", 1)), gliExpr(foam->
foamGener.env), gl0StructName(foam->foamGener.fmt), gliExpr
(foam->foamGener.prog))
1596 gl0StructName(foam->foamGener.fmt),sxiList(4, sxiFrSymbol(symProbe("Gener", 1)), gliExpr(foam->
foamGener.env), gl0StructName(foam->foamGener.fmt), gliExpr
(foam->foamGener.prog))
1597 gliExpr(foam->foamGener.prog))sxiList(4, sxiFrSymbol(symProbe("Gener", 1)), gliExpr(foam->
foamGener.env), gl0StructName(foam->foamGener.fmt), gliExpr
(foam->foamGener.prog));
1598}
1599
1600localstatic SExpr
1601gliGenIter(Foam foam)
1602{
1603 // TODO: Multi-argument
1604 return lisp1(GL_GenIter, gliExpr(foam->foamGenIter.gener))sxiList(2, sxiFrSymbol(symProbe("GenIter", 1)), gliExpr(foam->
foamGenIter.gener));
1605}
1606
1607localstatic SExpr
1608gliGenerValue(Foam foam)
1609{
1610 return lisp1(GL_GenerValue, gliExpr(foam->foamGenerValue.gener))sxiList(2, sxiFrSymbol(symProbe("GenerValue", 1)), gliExpr(foam
->foamGenerValue.gener));
1611}
1612
1613localstatic SExpr
1614gliGenerStep(Foam foam)
1615{
1616 glvHasGoto = 1;
1617 return lisp2(GL_GenerStep,sxiList(3, sxiFrSymbol(symProbe("GenerStep", 1)), gliExpr(foam
->foamGenerStep.gener), sxiList(2, sxiFrSymbol(symProbe("GO"
, 1)), sxiFrSymbol(symProbe(strPrintf("Lab%d", foam->foamGenerStep
.label), 1))))
1618 gliExpr(foam->foamGenerStep.gener),sxiList(3, sxiFrSymbol(symProbe("GenerStep", 1)), gliExpr(foam
->foamGenerStep.gener), sxiList(2, sxiFrSymbol(symProbe("GO"
, 1)), sxiFrSymbol(symProbe(strPrintf("Lab%d", foam->foamGenerStep
.label), 1))))
1619 lisp1(GL_Go, lispId(strPrintf("Lab%d", foam->foamGenerStep.label))))sxiList(3, sxiFrSymbol(symProbe("GenerStep", 1)), gliExpr(foam
->foamGenerStep.gener), sxiList(2, sxiFrSymbol(symProbe("GO"
, 1)), sxiFrSymbol(symProbe(strPrintf("Lab%d", foam->foamGenerStep
.label), 1))));
1620}
1621
1622/********************************************
1623 *
1624 * :: Utils
1625 *
1626 */
1627
1628localstatic String
1629gl0ExtractFileName()
1630{
1631 Foam decl = glvDConst->foamDDecl.argv[0];
1632 return strCopy(decl->foamDecl.id);
1633}