Anubis / Anubis

Commit e69a7543b3621b27488f8ff554a4d4b57349f0b9

Authored by David René
1 parent ed86675c

Nouveau compilo sans djed ni ankh

Showing 34 changed files with 4620 additions and 4709 deletions   Show diff stats
Inline Side-by-side
anubis_dev/compiler/proj/linux/Makefile
  Show/Hide comments   View file @e69a754
... ... @@ -23,19 +23,19 @@ INCLUDE = -I$(DEVDIR)/include -I$(SRCDIR)
23 23 # Object files
24 24 #
25 25 main_objs = new_var.o grammar.tab.o lex.yy.o interp.o globals.o mallocz.o opdef.o\
26   - unify.o show.o msgtexts.o predef.o typedef.o rectype.o typewidth.o implem.o\
  26 + unify.o show.o msgtexts.o typedef.o rectype.o typewidth.o implem.o\
27 27 determin.o unknowns.o eqcode.o typecmp.o dumpct.o typetools.o destruct.o\
28 28 compile.o delcode.o symcode.o vminstr.o rwcode.o index.o\
29 29 checkexpr.o dlm.o polish.o grammar_tools.o
30 30  
31   -special_objs = expr.o output.o main.o
  31 +special_objs = expr.o output.o main.o predef.o
32 32  
33 33 cipher_objs = blowfish.o sha1.o
34 34  
35 35 #
36 36 # Making the several versions of the Anubis compiler
37 37 #
38   -all: myanubis $(SRCDIR)/predef.aux anubis anubis_perso
  38 +all: myanubis $(SRCDIR)/predef.aux anubis anubis_perso anubis_npd
39 39  
40 40 #
41 41 # The 'standard' Anubis compiler
... ... @@ -57,12 +57,24 @@ anubis_perso: dependancies_p $(main_objs) $(special_objs:.o=.perso.o) $(cipher_o
57 57 # The 'private' Anubis compiler (used only by the developers)
58 58 # It is used for compiling 'predefined.anubis'
59 59 #
60   -myanubis: dependancies_my $(main_objs) $(special_objs:.o=.my.o) $(cipher_objs) $(SRCDIR)/predef.aux
  60 +#
  61 +#
  62 +myanubis: $(main_objs) $(special_objs:.o=.my.o) $(cipher_objs)
61 63 gcc -o $(HOME)/bin/myanubis $(main_objs) $(special_objs:.o=.my.o) $(cipher_objs)\
62 64 -static -lm
63 65 $(strip) $(HOME)/bin/myanubis
64 66  
65 67 #
  68 +# The Anubis compiler without predef.dat nor ankh/djed
  69 +#
  70 +anubis_npd: dependancies_my $(main_objs) $(special_objs:.o=.npd.o) $(cipher_objs) $(SRCDIR)/predef_npd.aux
  71 + gcc -o $(HOME)/bin/anubis_npd $(main_objs) $(special_objs:.o=.npd.o) $(cipher_objs)\
  72 + -static -lm
  73 + $(strip) $(HOME)/bin/anubis_npd
  74 +
  75 +
  76 +
  77 +#
66 78 # Getting the right dependancies requires making the *.d files
67 79 #
68 80 dependancies: $(main_objs:.o=.d) $(special_objs:.o=.d) $(cipher_objs:.o=.d)
... ... @@ -78,6 +90,9 @@ dependancies_my: $(main_objs:.o=.d) $(special_objs:.o=.my.d) $(cipher_objs:.o=.d
78 90 %.my.d: $(SRCDIR)/%.c
79 91 gcc $(INCLUDE) -MM $< > $@
80 92  
  93 +%.npd.d: $(SRCDIR)/%.c
  94 + gcc $(INCLUDE) -MM $< > $@
  95 +
81 96 %.perso.d: $(SRCDIR)/%.c
82 97 gcc $(INCLUDE) -MM $< > $@
83 98  
... ... @@ -99,6 +114,9 @@ dependancies_my: $(main_objs:.o=.d) $(special_objs:.o=.my.d) $(cipher_objs:.o=.d
99 114 %.my.o: $(SRCDIR)/%.c
100 115 gcc $(INCLUDE) $(OPTIMIZE) -o $@ -c -Wall -Wstrict-prototypes -D_LINUX_ -Dmyanubis $<
101 116  
  117 +%.npd.o: $(SRCDIR)/%.c
  118 + gcc $(INCLUDE) $(OPTIMIZE) -o $@ -c -Wall -Wstrict-prototypes -D_LINUX_ -D_no_predef_dat_ $<
  119 +
102 120 %.perso.o: $(SRCDIR)/%.c
103 121 gcc $(INCLUDE) $(OPTIMIZE) -o $@ -c -Wall -Wstrict-prototypes -D_LINUX_ -D_CRYPTADM_ $<
104 122  
... ... @@ -118,12 +136,12 @@ $(SRCDIR)/lex.yy.c: $(SRCDIR)/lexer.y $(SRCDIR)/grammar.tab.h $(SRCDIR)/compil.h
118 136 #
119 137 # predef.c depends on (and #includes) the file predef.aux
120 138 #
121   -$(SRCDIR)/predef.c: $(SRCDIR)/predef.aux
  139 +$(SRCDIR)/predef.c: $(SRCDIR)/predef.aux $(SRCDIR)/predef_npd.aux
122 140  
123 141 #
124   -# predef.aux and predef.dat are produced using myanubis
  142 +# predef.aux, predef_npd.aux and predef.dat are produced using myanubis
125 143 #
126   -$(SRCDIR)/predef.aux $(SRCDIR)/construc.h.out $(SRCDIR)/construc.c.out:\
  144 +$(SRCDIR)/predef.aux $(SRCDIR)/predef_npd.aux $(SRCDIR)/construc.h.out $(SRCDIR)/construc.c.out:\
127 145 $(LIBDIR)/predefined.anubis $(SRCDIR)/predef.anubis
128 146 # cd $(SRCDIR) && myanubis -predef -dct
129 147 # cp -f $(SRCDIR)/predef*.dat $(HOME)/my_anubis/web_sites/www.anubis-language.com/secret
... ... @@ -132,6 +150,7 @@ $(SRCDIR)/predef.aux $(SRCDIR)/construc.h.out $(SRCDIR)/construc.c.out:\
132 150 # cp -f $(HOME)/www_dev/anubis-language/Anubis_1_*.* $(HOME)/my_anubis
133 151 # cp $(SRCDIR)/predef* $(DEVDIR)
134 152  
  153 +
135 154 $(DEVDIR)/include/constructors.h: $(SRCDIR)/predef.aux
136 155 mv $(SRCDIR)/construc.h.out $(DEVDIR)/include/constructors.h
137 156  
... ...
anubis_dev/compiler/src/checkexpr.c
  Show/Hide comments   View file @e69a754
... ... @@ -53,7 +53,7 @@ void check_head(Expr head)
53 53 {
54 54 case avm: /* (avm <lc> <instr> ...) */
55 55 case string: /* (string <lc> . <string>) */
56   - case int32: /* (int32 <lc> . <Cint>) */
  56 + case anb_int32: /* (int32 <lc> . <Cint>) */
57 57 case fpnum: /* (fpnum <lc> <int32 mantissa> . <int32 exponent>) */
58 58 return;
59 59  
... ...
anubis_dev/compiler/src/compil.h
  Show/Hide comments   View file @e69a754
... ... @@ -11,7 +11,7 @@
11 11  
12 12 */
13 13  
14   -#include "general.h"
  14 +#include "AnubisSupport.h"
15 15  
16 16 #define _DEBUG_
17 17  
... ... @@ -47,6 +47,7 @@ extern int par_seen;
47 47 extern int reading_predef;
48 48 extern int no_preemption;
49 49 extern FILE * predef_aux;
  50 +extern FILE * predef_npd_aux; /* version of predef.aux that avoids the use of predef.dat */
50 51 extern FILE * predef_dat;
51 52 extern int tab_seen;
52 53 extern int tab_width;
... ... @@ -235,7 +236,7 @@ extern Expr linecol(void);
235 236 item(symbol)\
236 237 item(integer)\
237 238 item(fpnum)\
238   - item(int32)\
  239 + item(anb_int32)\
239 240 item(glue)\
240 241 item(glue_index)\
241 242 item(push)\
... ... @@ -900,7 +901,7 @@ extern int max_tpair_load;
900 901 case terminal: goto terminal_##name;\
901 902 case operation: goto operation_##name;\
902 903 case string: goto string_##name;\
903   - case int32: goto int32_##name;\
  904 + case anb_int32: goto int32_##name;\
904 905 case small_datum: goto small_datum_##name;\
905 906 case fpnum: goto fpnum_##name;\
906 907 case local: goto local_##name;\
... ... @@ -932,10 +933,10 @@ extern Expr merge_lists(Expr, Expr);
932 933 extern Expr hard_reverse(Expr list);
933 934  
934 935 extern Expr append(Expr list_1,
935   - Expr list_2);
  936 + Expr list_2);
936 937  
937 938 extern Expr rappend(Expr list_1,
938   - Expr list_2);
  939 + Expr list_2);
939 940  
940 941 extern Expr nth(Expr rank, Expr l);
941 942  
... ... @@ -944,26 +945,26 @@ extern Expr nth(Expr rank, Expr l);
944 945 extern void put32(FILE *fp, U32 n);
945 946  
946 947 extern int member(Expr element, /* true if element belongs to list */
947   - Expr list);
  948 + Expr list);
948 949  
949 950 extern int find(Expr x, Expr t); /* find atom x in tree t */
950 951  
951 952 extern int has_repetition(Expr list);
952 953  
953 954 extern Expr assoc(Expr key, /* returns value associated to key */
954   - Expr A_list);
  955 + Expr A_list);
955 956  
956 957 extern int is_key_of(Expr A_list,
957   - Expr key);
  958 + Expr key);
958 959  
959 960 extern void print_expr(FILE *fp,
960   - Expr expr);
  961 + Expr expr);
961 962  
962 963 extern int sprint_expr(char *fp,
963   - Expr expr);
  964 + Expr expr);
964 965  
965 966 extern int have_common_element(Expr list1,
966   - Expr llist2);
  967 + Expr llist2);
967 968  
968 969 extern int equal(Expr,Expr);
969 970 extern Expr substitute(Expr expr, Expr a_list);
... ... @@ -973,11 +974,11 @@ extern Expr mapcdrcdr(Expr);
973 974  
974 975 extern int same_type(Expr type1, Expr env1, Expr type2, Expr env2);
975 976 extern int same_op_instance(int opid1,
976   - Expr types1,
977   - Expr u_env1,
978   - int opid2,
979   - Expr types2,
980   - Expr u_env2);
  977 + Expr types1,
  978 + Expr u_env1,
  979 + int opid2,
  980 + Expr types2,
  981 + Expr u_env2);
981 982  
982 983  
983 984 /* type representation */
... ... @@ -1119,8 +1120,8 @@ extern int next_mctxt_del_code;
1119 1120  
1120 1121 extern Expr get_del_code_addr(Expr type, Expr env);
1121 1122 extern Expr get_del_stack_instr(Expr type,
1122   - Expr env,
1123   - Expr depth);
  1123 + Expr env,
  1124 + Expr depth);
1124 1125  
1125 1126 extern Expr read_code(Expr type, Expr env, Expr ctxt);
1126 1127 extern Expr write_code(Expr type, Expr env, Expr ctxt);
... ... @@ -1192,11 +1193,11 @@ extern void print_symbolic_code(FILE *fp, Expr code, U32 *offa,
1192 1193 extern Expr op_comment(int opid);
1193 1194  
1194 1195 extern void new_type_scheme (Expr line, /* <lc> */
1195   - int C_dump,
1196   - Expr name, /* <type name> */
1197   - Expr parms, /* <user type variables> */
1198   - Expr alts, /* <alternatives 1> */
1199   - int more,
  1196 + int C_dump,
  1197 + Expr name, /* <type name> */
  1198 + Expr parms, /* <user type variables> */
  1199 + Expr alts, /* <alternatives 1> */
  1200 + int more,
1200 1201 int public);
1201 1202  
1202 1203 extern void make_C_constr (Expr line, Expr file_name, Expr name, Expr type);
... ... @@ -1205,9 +1206,9 @@ extern void binary_print_expr(FILE *,Expr);
1205 1206 extern void binary_print_def(FILE *fp, int opid, Expr def);
1206 1207  
1207 1208 extern void new_type_name (Expr lc,
1208   - int C_dump,
1209   - Expr name,
1210   - Expr def); /* <type> */
  1209 + int C_dump,
  1210 + Expr name,
  1211 + Expr def); /* <type> */
1211 1212  
1212 1213 extern int has_recursive_equality(Expr implem);
1213 1214  
... ... @@ -1217,11 +1218,11 @@ extern char * normalize_filepath(Expr lc,
1217 1218 extern Expr drop_RW_WO(Expr type);
1218 1219  
1219 1220 extern void new_op_scheme (Expr line, /* <lc> */
1220   - int global,
1221   - Expr ttype, /* <type> */
1222   - Expr name, /* <operation name> */
1223   - Expr args, /* <operation arguments> */
1224   - Expr body); /* <term> */
  1221 + int global,
  1222 + Expr ttype, /* <type> */
  1223 + Expr name, /* <operation name> */
  1224 + Expr args, /* <operation arguments> */
  1225 + Expr body); /* <term> */
1225 1226  
1226 1227 extern void check_operation(int opid);
1227 1228  
... ... @@ -1240,21 +1241,21 @@ extern Expr get_micro_ctxt(Expr lc,
1240 1241 extern void make_destructors(Expr, int global, int tid);
1241 1242  
1242 1243 extern Expr refresh (Expr expr,
1243   - Expr *already_refreshed);
  1244 + Expr *already_refreshed);
1244 1245  
1245 1246 extern void collect_type_variables(Expr *result,
1246   - Expr expr);
  1247 + Expr expr);
1247 1248  
1248 1249 extern int check_explicit_type (Expr line, /* <lc> */
1249   - Expr expr, /* <type> */
1250   - Expr tvs); /* <user type variables> */
  1250 + Expr expr, /* <type> */
  1251 + Expr tvs); /* <user type variables> */
1251 1252  
1252 1253 extern void check_incomplete_types(void);
1253 1254  
1254 1255 extern struct Type_struct *type_description(Expr name_of_type, Expr current_file_name, Expr lc);
1255 1256  
1256 1257 extern int has_unknowns (Expr expr,
1257   - Expr env); /* <environment> */
  1258 + Expr env); /* <environment> */
1258 1259  
1259 1260 extern void must_be_non_ambiguous (Expr interps); /* <term interpretations> */
1260 1261  
... ... @@ -1264,8 +1265,8 @@ extern Expr join_envs(Expr, Expr);
1264 1265  
1265 1266 extern Expr term_interpretations(Expr target,
1266 1267 Expr term,
1267   - Expr ctxt,
1268   - Expr env,
  1268 + Expr ctxt,
  1269 + Expr env,
1269 1270 Expr tvs);
1270 1271  
1271 1272 extern Expr name_of_type(Expr type);
... ... @@ -1276,9 +1277,9 @@ extern Expr type_from_interpretation(Expr interp, Expr env);
1276 1277 #define unify(x,ex,y,ey) (_unify(x,ex,y,ey))
1277 1278  
1278 1279 extern Expr _unify (Expr x,
1279   - Expr ex, /* <environment> */
1280   - Expr y,
1281   - Expr ey); /* <environment> */
  1280 + Expr ex, /* <environment> */
  1281 + Expr y,
  1282 + Expr ey); /* <environment> */
1282 1283  
1283 1284 extern void _internal_error(char *msg, Expr expr, char *, int);
1284 1285 #define internal_error(msg,expr) _internal_error(msg,expr,__FILE__,__LINE__)
... ... @@ -1369,9 +1370,9 @@ extern void dump_dynamic_modules(void);
1369 1370 extern void dump_C_types(void);
1370 1371  
1371 1372 extern Expr compile_term(Expr head,
1372   - Expr ctxt,
1373   - Expr env,
1374   - Expr end_code);
  1373 + Expr ctxt,
  1374 + Expr env,
  1375 + Expr end_code);
1375 1376  
1376 1377  
1377 1378  
... ... @@ -1450,12 +1451,12 @@ extern Expr _new_addr_name(LabelSort sort, int index);
1450 1451 extern int new_addr_count;
1451 1452  
1452 1453 extern Expr make_sha1_digest(Expr names,
1453   - Expr target_type,
1454   - Expr signature,
1455   - Expr parms,
1456   - Expr parms_values,
1457   - Expr env,
1458   - U8 *destination);
  1454 + Expr target_type,
  1455 + Expr signature,
  1456 + Expr parms,
  1457 + Expr parms_values,
  1458 + Expr env,
  1459 + U8 *destination);
1459 1460  
1460 1461  
1461 1462  
... ...
anubis_dev/compiler/src/compile.c
  Show/Hide comments   View file @e69a754
... ... @@ -68,7 +68,7 @@ Expr mixed_copy_mask(Expr implem)
68 68 while (consp(implem))
69 69 {
70 70 if (car(car(implem)) == mixed_alt)
71   - mask |= 1<<bit;
  71 + mask |= 1<<bit;
72 72 bit++;
73 73 implem = cdr(implem);
74 74 }
... ... @@ -87,9 +87,9 @@ Expr mixed_copy_mask(Expr implem)
87 87 symbols which have been pushed. */
88 88  
89 89 static Expr get_push_rvs(Expr descr, /* description of type */
90   - Expr type,
91   - Expr env,
92   - Expr resurg_mask)
  90 + Expr type,
  91 + Expr env,
  92 + Expr resurg_mask)
93 93 {
94 94 Expr result = nil;
95 95 Expr alt_sort = car(descr);
... ... @@ -112,15 +112,15 @@ static Expr get_push_rvs(Expr descr, /* description of type */
112 112  
113 113 case small_alt:
114 114 {
115   - /* components are unglued and pushed in reverse order */
116   - while(consp(descr))
117   - {
118   - if (car(resurg_mask) == used)
119   - result = cons(mcons3(unglue,cdr2(car(descr)),second(car(descr))),result);
120   - descr = cdr(descr);
121   - resurg_mask = cdr(resurg_mask);
122   - }
123   - return cons(cons(check_stack,new_integer(n)),
  115 + /* components are unglued and pushed in reverse order */
  116 + while(consp(descr))
  117 + {
  118 + if (car(resurg_mask) == used)
  119 + result = cons(mcons3(unglue,cdr2(car(descr)),second(car(descr))),result);
  120 + descr = cdr(descr);
  121 + resurg_mask = cdr(resurg_mask);
  122 + }
  123 + return cons(cons(check_stack,new_integer(n)),
124 124 result);
125 125 }
126 126 break;
... ... @@ -129,57 +129,57 @@ static Expr get_push_rvs(Expr descr, /* description of type */
129 129 case mixed_alt:
130 130 case large_alt:
131 131 {
132   - while(consp(descr))
133   - {
134   - /* for a mixed alternative, data begin at offset 4. For a
135   - large alternative, data begin at offset 5 */
136   - int depl = (alt_sort == mixed_alt ? 4 : 5);
137   -
138   - /* get implementation of component */
139   - Expr comp_implem =
140   - implems[integer_value(car(car(descr)))].implem;
141   -
142   - if (car(resurg_mask) == used)
143   - {
144   - /* string component: (unstore_copy_ptr . <offset>) */
145   - if (comp_implem == type_String)
146   - result = cons(cons(unstore_copy_ptr,
147   - second(car(descr))+new_integer(depl)),
148   - result);
149   - else if (comp_implem == type_ByteArray)
150   - result = cons(cons(unstore_copy_ptr,
151   - second(car(descr))+new_integer(depl)),
152   - result);
153   - else if (comp_implem == type_Float)
154   - result = cons(cons(unstore_copy_ptr,
155   - second(car(descr))+new_integer(depl)),
156   - result);
157   -
158   - else if (is_struct_ptr_type(comp_implem))
159   - result = cons(cons(unstore_copy_ptr,
160   - second(car(descr))+new_integer(depl)),
161   - result);
162   -
163   - else if (is_functional_type(comp_implem))
164   - result = cons(cons(unstore_copy_function,
165   - second(car(descr))+new_integer(depl)),
166   - result);
167   -
168   - else if (is_address_type(comp_implem))
169   - switch(car(comp_implem))
170   - {
171   - case type_RAddr:
172   - case type_WAddr:
173   - case type_RWAddr:
174   - result = cons(cons(unstore_copy_ptr,
175   - second(car(descr))+new_integer(depl)),
176   - result);
177   - break;
  132 + while(consp(descr))
  133 + {
  134 + /* for a mixed alternative, data begin at offset 4. For a
  135 + large alternative, data begin at offset 5 */
  136 + int depl = (alt_sort == mixed_alt ? 4 : 5);
  137 +
  138 + /* get implementation of component */
  139 + Expr comp_implem =
  140 + implems[integer_value(car(car(descr)))].implem;
  141 +
  142 + if (car(resurg_mask) == used)
  143 + {
  144 + /* string component: (unstore_copy_ptr . <offset>) */
  145 + if (comp_implem == type_String)
  146 + result = cons(cons(unstore_copy_ptr,
  147 + second(car(descr))+new_integer(depl)),
  148 + result);
  149 + else if (comp_implem == type_ByteArray)
  150 + result = cons(cons(unstore_copy_ptr,
  151 + second(car(descr))+new_integer(depl)),
  152 + result);
  153 + else if (comp_implem == type_Float)
  154 + result = cons(cons(unstore_copy_ptr,
  155 + second(car(descr))+new_integer(depl)),
  156 + result);
  157 +
  158 + else if (is_struct_ptr_type(comp_implem))
  159 + result = cons(cons(unstore_copy_ptr,
  160 + second(car(descr))+new_integer(depl)),
  161 + result);
  162 +
  163 + else if (is_functional_type(comp_implem))
  164 + result = cons(cons(unstore_copy_function,
  165 + second(car(descr))+new_integer(depl)),
  166 + result);
  167 +
  168 + else if (is_address_type(comp_implem))
  169 + switch(car(comp_implem))
  170 + {
  171 + case type_RAddr:
  172 + case type_WAddr:
  173 + case type_RWAddr:
  174 + result = cons(cons(unstore_copy_ptr,
  175 + second(car(descr))+new_integer(depl)),
  176 + result);
  177 + break;
178 178 case type_Var:
179   - result = cons(cons(unstore_copy_ptr,
180   - second(car(descr))+new_integer(depl)),
181   - result);
182   - break;
  179 + result = cons(cons(unstore_copy_ptr,
  180 + second(car(descr))+new_integer(depl)),
  181 + result);
  182 + break;
183 183  
184 184 case type_MVar:
185 185 result = cons(cons(unstore_copy_ptr,
... ... @@ -187,67 +187,67 @@ static Expr get_push_rvs(Expr descr, /* description of type */
187 187 result);
188 188 break;
189 189  
190   - case type_GAddr:
191   - result = cons(mcons3(unstore,
192   - second(car(descr))+new_integer(depl),
193   - new_integer(4)),
194   - result);
195   - break;
196   -
197   - default:
198   - assert(0);
199   - }
200   -
201   - else if(comp_implem == type_Listener)
202   - result = cons(cons(unstore_copy_ptr,
203   - second(car(descr))+new_integer(depl)),
204   - result);
205   -
206   - /* large component: (unstore_copy . <offset>) */
207   - else if (consp(comp_implem) && car(comp_implem) == large_type )
208   - result = cons(cons(unstore_copy,
209   - second(car(descr))+new_integer(depl)),
210   - result);
211   - /* mixed component: (unstore_copy_mixed <offset> . <mask>) */
212   - else if (consp(comp_implem) && car(comp_implem) == mixed_type)
213   - result = cons(mcons3(unstore_copy_mixed,
214   - second(car(descr))+new_integer(depl),
215   - mixed_copy_mask(comp_implem)),
216   - result);
217   - /* small component: (unstore <offset> . <width>) */
218   - else if (consp(comp_implem) && car(comp_implem) == small_type)
219   - result = cons(mcons3(unstore,second(car(descr))+new_integer(depl),cdr2(car(descr))),
220   - result);
  190 + case type_GAddr:
  191 + result = cons(mcons3(unstore,
  192 + second(car(descr))+new_integer(depl),
  193 + new_integer(4)),
  194 + result);
  195 + break;
  196 +
  197 + default:
  198 + assert(0);
  199 + }
  200 +
  201 + else if(comp_implem == type_Listener)
  202 + result = cons(cons(unstore_copy_ptr,
  203 + second(car(descr))+new_integer(depl)),
  204 + result);
  205 +
  206 + /* large component: (unstore_copy . <offset>) */
  207 + else if (consp(comp_implem) && car(comp_implem) == large_type )
  208 + result = cons(cons(unstore_copy,
  209 + second(car(descr))+new_integer(depl)),
  210 + result);
  211 + /* mixed component: (unstore_copy_mixed <offset> . <mask>) */
  212 + else if (consp(comp_implem) && car(comp_implem) == mixed_type)
  213 + result = cons(mcons3(unstore_copy_mixed,
  214 + second(car(descr))+new_integer(depl),
  215 + mixed_copy_mask(comp_implem)),
  216 + result);
  217 + /* small component: (unstore <offset> . <width>) */
  218 + else if (consp(comp_implem) && car(comp_implem) == small_type)
  219 + result = cons(mcons3(unstore,second(car(descr))+new_integer(depl),cdr2(car(descr))),
  220 + result);
221 221  
222 222 /* Int32 */
223 223 else if (comp_implem == type_Int32)
224   - result = cons(mcons3(unstore,second(car(descr))+new_integer(depl),cdr2(car(descr))),
225   - result);
  224 + result = cons(mcons3(unstore,second(car(descr))+new_integer(depl),cdr2(car(descr))),
  225 + result);
226 226  
227 227  
228 228 else internal_error("'get_push_rvs' cannot handle component implementation",comp_implem);
229   - }
230   - /* do for next component */
231   - descr = cdr(descr);
232   - resurg_mask = cdr(resurg_mask);
233   - }
234   -
235   - /* now we must delete the original */
236   - type_implem = implems[type_implementation_id(type,env)].implem;
237   -
238   - /* large type: (del . <del code addr>) */
239   - if (car(type_implem) == large_type)
240   - result =
241   - cons(cons(check_stack,new_integer(n)),
  229 + }
  230 + /* do for next component */
  231 + descr = cdr(descr);
  232 + resurg_mask = cdr(resurg_mask);
  233 + }
  234 +
  235 + /* now we must delete the original */
  236 + type_implem = implems[type_implementation_id(type,env)].implem;
  237 +
  238 + /* large type: (del . <del code addr>) */
  239 + if (car(type_implem) == large_type)
  240 + result =
  241 + cons(cons(check_stack,new_integer(n)),
242 242 append(result,list1(cons(del,get_del_code_addr(type,env)))));
243   - /* mixed type: (del_mixed <mask> . <del code addr>) */
244   - else
245   - result =
246   - cons(cons(check_stack,new_integer(n)),
247   - append(result,list1(mcons3(del_mixed,
  243 + /* mixed type: (del_mixed <mask> . <del code addr>) */
  244 + else
  245 + result =
  246 + cons(cons(check_stack,new_integer(n)),
  247 + append(result,list1(mcons3(del_mixed,
248 248 mixed_copy_mask(type_implem),
249 249 get_del_code_addr(type,env)))));
250   - return result;
  250 + return result;
251 251 }
252 252 break;
253 253  
... ... @@ -273,124 +273,124 @@ static Expr get_del_rvs(Expr descr, Expr resurg_mask)
273 273 {
274 274 case small_alt:
275 275 while (consp(descr))
276   - {
277   - /* small alternative: all component are small. Generate a
278   - (collapse . 0) for each component */
279   - if (car(resurg_mask) == used)
280   - result = cons(cons(collapse,new_integer(0)),result);
281   - descr = cdr(descr);
282   - resurg_mask = cdr(resurg_mask);
283   - }
  276 + {
  277 + /* small alternative: all component are small. Generate a
  278 + (collapse . 0) for each component */
  279 + if (car(resurg_mask) == used)
  280 + result = cons(cons(collapse,new_integer(0)),result);
  281 + descr = cdr(descr);
  282 + resurg_mask = cdr(resurg_mask);
  283 + }
284 284 /* put them in natural order */
285 285 return hard_reverse(result);
286 286  
287 287 case mixed_alt:
288 288 case large_alt:
289 289 while(consp(descr))
290   - {
291   - /* for each component, get the implementation and deletion
292   - code */
  290 + {
  291 + /* for each component, get the implementation and deletion
  292 + code */
293 293  
294   - int comp_implem_id = integer_value(car(car(descr)));
295   - Expr del_code =
  294 + int comp_implem_id = integer_value(car(car(descr)));
  295 + Expr del_code =
296 296 get_del_code_addr(implems[comp_implem_id].type,implems[comp_implem_id].env);
297   - Expr comp_implem = implems[comp_implem_id].implem;
298   -
299   - if (car(resurg_mask) == used)
300   - {
301   - /* if string generate a del_stack_ptr instruction */
302   - if (comp_implem == type_String)
303   - result = cons(cons(del_stack_ptr,
304   - new_integer(0)),
305   - result);
306   - else if (comp_implem == type_ByteArray)
307   - result = cons(cons(del_stack_ptr,
308   - new_integer(0)),
309   - result);
310   - else if (comp_implem == type_Float)
311   - result = cons(cons(del_stack_ptr,
312   - new_integer(0)),
313   - result);
314   - else if (is_struct_ptr_type(comp_implem))
315   - result = cons(mcons3(del_stack_struct_ptr,
  297 + Expr comp_implem = implems[comp_implem_id].implem;
  298 +
  299 + if (car(resurg_mask) == used)
  300 + {
  301 + /* if string generate a del_stack_ptr instruction */
  302 + if (comp_implem == type_String)
  303 + result = cons(cons(del_stack_ptr,
  304 + new_integer(0)),
  305 + result);
  306 + else if (comp_implem == type_ByteArray)
  307 + result = cons(cons(del_stack_ptr,
  308 + new_integer(0)),
  309 + result);
  310 + else if (comp_implem == type_Float)
  311 + result = cons(cons(del_stack_ptr,
  312 + new_integer(0)),
  313 + result);
  314 + else if (is_struct_ptr_type(comp_implem))
  315 + result = cons(mcons3(del_stack_struct_ptr,
316 316 cdr(comp_implem),
317   - new_integer(0)),
318   - result);
  317 + new_integer(0)),
  318 + result);
319 319 else if (is_functional_type(comp_implem))
320   - result = cons(cons(del_stack_function,
321   - new_integer(0)),
322   - result);
323   - else if (comp_implem == type_Listener)
324   - result = cons(cons(del_stack_conn,
325   - new_integer(0)),
326   - result);
327   -
328   - else if (is_address_type(comp_implem))
329   - switch (car(comp_implem))
330   - {
331   - case type_RAddr:
332   - case type_WAddr:
333   - case type_RWAddr:
334   - result = cons(cons(del_stack_conn,
335   - new_integer(0)),
336   - result);
337   - break;
338   - case type_Var:
339   - {
340   - Expr var_del_code_addr =
341   - get_del_code_addr(implems[comp_implem_id].type,
342   - implems[comp_implem_id].env);
343   - result = cons(mcons3(del_stack,
344   - new_integer(0),
345   - var_del_code_addr),
346   - result);
347   - }
348   - break;
349   - case type_MVar:
350   - {
351   - Expr var_del_code_addr =
352   - get_del_code_addr(implems[comp_implem_id].type,
353   - implems[comp_implem_id].env);
354   - result = cons(mcons3(del_stack_mvar,
355   - new_integer(0),
356   - var_del_code_addr),
357   - result);
358   - }
359   - break;
360   - case type_GAddr:
361   - {
362   - result = cons(cons(collapse,new_integer(0)),result);
363   - }
364   - break;
365   -
366   - default:
367   - assert(0);
368   - }
369   -
370   - /* mixed component: (del_stack_mixed 0 <mask> . <del code addr>) */
371   - else if (consp(comp_implem) && car(comp_implem) == mixed_type)
372   - result = cons(mcons4(del_stack_mixed,
373   - new_integer(0),
374   - mixed_copy_mask(comp_implem),
375   - del_code),result);
376   -
377   - /* large component: (del_stack 0 . <del code addr>) */
378   - else if (consp(comp_implem) && car(comp_implem) == large_type)
379   - result = cons(mcons3(del_stack,new_integer(0),del_code),result);
380   -
381   - /* if no deletion code, generate a (collapse . 0) */
382   - else if (del_code == nil)
383   - result = cons(cons(collapse,new_integer(0)),result);
  320 + result = cons(cons(del_stack_function,
  321 + new_integer(0)),
  322 + result);
  323 + else if (comp_implem == type_Listener)
  324 + result = cons(cons(del_stack_conn,
  325 + new_integer(0)),
  326 + result);
  327 +
  328 + else if (is_address_type(comp_implem))
  329 + switch (car(comp_implem))
  330 + {
  331 + case type_RAddr:
  332 + case type_WAddr:
  333 + case type_RWAddr:
  334 + result = cons(cons(del_stack_conn,
  335 + new_integer(0)),
  336 + result);
  337 + break;
  338 + case type_Var:
  339 + {
  340 + Expr var_del_code_addr =
  341 + get_del_code_addr(implems[comp_implem_id].type,
  342 + implems[comp_implem_id].env);
  343 + result = cons(mcons3(del_stack,
  344 + new_integer(0),
  345 + var_del_code_addr),
  346 + result);
  347 + }
  348 + break;
  349 + case type_MVar:
  350 + {
  351 + Expr var_del_code_addr =
  352 + get_del_code_addr(implems[comp_implem_id].type,
  353 + implems[comp_implem_id].env);
  354 + result = cons(mcons3(del_stack_mvar,
  355 + new_integer(0),
  356 + var_del_code_addr),
  357 + result);
  358 + }
  359 + break;
  360 + case type_GAddr:
  361 + {
  362 + result = cons(cons(collapse,new_integer(0)),result);
  363 + }
  364 + break;
  365 +
  366 + default:
  367 + assert(0);
  368 + }
  369 +
  370 + /* mixed component: (del_stack_mixed 0 <mask> . <del code addr>) */
  371 + else if (consp(comp_implem) && car(comp_implem) == mixed_type)
  372 + result = cons(mcons4(del_stack_mixed,
  373 + new_integer(0),
  374 + mixed_copy_mask(comp_implem),
  375 + del_code),result);
  376 +
  377 + /* large component: (del_stack 0 . <del code addr>) */
  378 + else if (consp(comp_implem) && car(comp_implem) == large_type)
  379 + result = cons(mcons3(del_stack,new_integer(0),del_code),result);
  380 +
  381 + /* if no deletion code, generate a (collapse . 0) */
  382 + else if (del_code == nil)
  383 + result = cons(cons(collapse,new_integer(0)),result);
384 384  
385 385 else
386 386 internal_error("'get_del_rvs' cannot handle component implementation",comp_implem);
387   - }
  387 + }
388 388  
389   - descr = cdr(descr);
390   - resurg_mask = cdr(resurg_mask);
391   - }
  389 + descr = cdr(descr);
  390 + resurg_mask = cdr(resurg_mask);
  391 + }
392 392  
393   - return hard_reverse(result);
  393 + return hard_reverse(result);
394 394  
395 395 default:
396 396 assert(0);
... ... @@ -418,79 +418,79 @@ static Expr get_del_code_from_ctxt(Expr ctxt, Expr env)
418 418  
419 419 /* if string: (del_stack_ptr . 0) */
420 420 if (implem == type_String)
421   - result = cons(cons(del_stack_ptr,new_integer(0)),result);
  421 + result = cons(cons(del_stack_ptr,new_integer(0)),result);
422 422  
423 423 else if (implem == type_ByteArray)
424   - result = cons(cons(del_stack_ptr,new_integer(0)),result);
  424 + result = cons(cons(del_stack_ptr,new_integer(0)),result);
425 425  
426 426 else if (implem == type_Listener)
427   - result = cons(cons(del_stack_conn,new_integer(0)),result);
  427 + result = cons(cons(del_stack_conn,new_integer(0)),result);
428 428  
429 429 else if (is_address_type(implem))
430   - switch (car(implem))
431   - {
432   - case type_RAddr:
433   - case type_WAddr:
434   - case type_RWAddr:
435   - result = cons(cons(del_stack_conn,new_integer(0)),result);
436   - break;
437   - case type_Var:
438   - {
439   - Expr var_del_code_addr = get_del_code_addr(cdr(car(ctxt)),env);
440   -
441   - result = cons(mcons3(del_stack,
442   - new_integer(0),
443   - var_del_code_addr),
444   - result);
445   - }
446   - break;
  430 + switch (car(implem))
  431 + {
  432 + case type_RAddr:
  433 + case type_WAddr:
  434 + case type_RWAddr:
  435 + result = cons(cons(del_stack_conn,new_integer(0)),result);
  436 + break;
  437 + case type_Var:
  438 + {
  439 + Expr var_del_code_addr = get_del_code_addr(cdr(car(ctxt)),env);
  440 +
  441 + result = cons(mcons3(del_stack,
  442 + new_integer(0),
  443 + var_del_code_addr),
  444 + result);
  445 + }
  446 + break;
447 447 case type_MVar:
448 448 {
449   - Expr var_del_code_addr = get_del_code_addr(cdr(car(ctxt)),env);
  449 + Expr var_del_code_addr = get_del_code_addr(cdr(car(ctxt)),env);
450 450  
451   - result = cons(mcons3(del_stack_mvar,
452   - new_integer(0),
453   - var_del_code_addr),
454   - result);
  451 + result = cons(mcons3(del_stack_mvar,
  452 + new_integer(0),
  453 + var_del_code_addr),
  454 + result);
455 455 }
456 456 break;
457   - case type_GAddr:
458   - {
459   - result = cons(cons(collapse,new_integer(0)),result);
460   - }
461   - break;
462   - default:
463   - assert(0);
464   - }
  457 + case type_GAddr:
  458 + {
  459 + result = cons(cons(collapse,new_integer(0)),result);
  460 + }
  461 + break;
  462 + default:
  463 + assert(0);
  464 + }
465 465 else if (implem == type_Float)
466   - result = cons(cons(del_stack_ptr,new_integer(0)),result);
  466 + result = cons(cons(del_stack_ptr,new_integer(0)),result);
467 467  
468 468 else if (is_struct_ptr_type(implem))
469   - result = cons(mcons3(del_stack_struct_ptr,
  469 + result = cons(mcons3(del_stack_struct_ptr,
470 470 cdr(implem),
471 471 new_integer(0)),
472 472 result);
473 473  
474 474 else if (is_functional_type(implem))
475   - result = cons(cons(del_stack_function,
  475 + result = cons(cons(del_stack_function,
476 476 new_integer(0)),
477 477 result);
478 478  
479 479 /* if argument of mixed type: (del_stack_mixed 0 <mask> . <del
480   - code addr>) */
  480 + code addr>) */
481 481 else if (consp(implem) && car(implem) == mixed_type)
482   - result = cons(mcons4(del_stack_mixed,
483   - new_integer(0),
484   - mixed_copy_mask(implem),
485   - delcode),result);
  482 + result = cons(mcons4(del_stack_mixed,
  483 + new_integer(0),
  484 + mixed_copy_mask(implem),
  485 + delcode),result);
486 486  
487 487 /* if argument of large type: (del_stack 0 . <del code addr>) */
488 488 else if (consp(implem) && car(implem) == large_type)
489   - result = cons(mcons3(del_stack,new_integer(0),delcode),result);
  489 + result = cons(mcons3(del_stack,new_integer(0),delcode),result);
490 490  
491 491 /* if no del code: (collapse . 0) */
492 492 else if (delcode == nil)
493   - result = cons(cons(collapse,new_integer(0)),result);
  493 + result = cons(cons(collapse,new_integer(0)),result);
494 494  
495 495 else
496 496 internal_error("Unknown implementation:",implem);
... ... @@ -506,8 +506,8 @@ static Expr get_del_code_from_ctxt(Expr ctxt, Expr env)
506 506  
507 507  
508 508 Expr get_del_stack_instr(Expr type,
509   - Expr env,
510   - Expr depth)
  509 + Expr env,
  510 + Expr depth)
511 511 {
512 512 Expr implem;
513 513 Expr delcode;
... ... @@ -541,11 +541,11 @@ Expr get_del_stack_instr(Expr type,
541 541  
542 542 else if (is_small_implem(implem)) return cons(collapse,depth);
543 543 else if (is_mixed_implem(implem)) return mcons4(del_stack_mixed,
544   - depth,mixed_copy_mask(implem),
545   - delcode);
  544 + depth,mixed_copy_mask(implem),
  545 + delcode);
546 546 else if (is_large_implem(implem)) return mcons3(del_stack,depth,delcode);
547 547 else return (internal_error("get_del_stack_instr: unknown type",type),
548   - nil);
  548 + nil);
549 549 }
550 550  
551 551  
... ... @@ -555,7 +555,7 @@ Expr get_del_stack_instr(Expr type,
555 555  
556 556 /* getting the copy instruction for a given type */
557 557 Expr get_copy_instr(Expr type,
558   - Expr env)
  558 + Expr env)
559 559 {
560 560 Expr implem;
561 561  
... ... @@ -613,7 +613,7 @@ Expr get_vcopy_instr(Expr type,
613 613  
614 614 /* getting the del instruction for a given type */
615 615 Expr get_del_instr(Expr type,
616   - Expr env)
  616 + Expr env)
617 617 {
618 618 Expr implem;
619 619  
... ... @@ -634,12 +634,12 @@ Expr get_del_instr(Expr type,
634 634 {
635 635 Expr var_del_code_addr = get_del_code_addr(type,env);
636 636  
637   - return cons(del,var_del_code_addr);
  637 + return cons(del,var_del_code_addr);
638 638 }
639 639 else if (is_small_implem(implem)) return no_instr;
640 640 else if (is_mixed_implem(implem)) return mcons3(del_mixed,
641   - mixed_copy_mask(implem),
642   - get_del_code_addr(type,env));
  641 + mixed_copy_mask(implem),
  642 + get_del_code_addr(type,env));
643 643 else if (is_large_implem(implem)) return cons(del,get_del_code_addr(type,env));
644 644 else return internal_error("get_del_instr: unknown type",type), nil;
645 645 }
... ... @@ -663,50 +663,50 @@ Expr get_before_start_code(Expr ctxt, Expr env)
663 663  
664 664 /* if string: (copy_stack_ptr . depth) */
665 665 if (implem == type_String)
666   - result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
  666 + result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
667 667  
668 668 else if (implem == type_ByteArray)
669   - result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
  669 + result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
670 670  
671 671 else if (is_address_type(implem))
672   - switch (car(implem))
673   - {
674   - case type_RAddr:
675   - case type_WAddr:
676   - case type_RWAddr:
677   - case type_Var:
678   - result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
679   - break;
680   - case type_GAddr:
681   - break;
682   - default:
683   - assert(0);
684   - }
  672 + switch (car(implem))
  673 + {
  674 + case type_RAddr:
  675 + case type_WAddr:
  676 + case type_RWAddr:
  677 + case type_Var:
  678 + result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
  679 + break;
  680 + case type_GAddr:
  681 + break;
  682 + default:
  683 + assert(0);
  684 + }
685 685  
686 686 else if (implem == type_Float)
687   - result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
  687 + result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
688 688  
689 689 else if (is_struct_ptr_type(implem))
690   - result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
  690 + result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
691 691  
692 692 else if (implem == type_Listener)
693   - result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
  693 + result = cons(cons(copy_stack_ptr,new_integer(depth)),result);
694 694  
695 695 else if (is_functional_type(implem))
696 696 result = cons(cons(copy_stack_function,new_integer(depth)),result);
697 697  
698 698 /* mixed type */
699 699 else if (consp(implem) && car(implem) == mixed_type)
700   - result = cons(mcons3(copy_stack_mixed,
701   - new_integer(depth),
702   - mixed_copy_mask(implem)),
703   - result);
  700 + result = cons(mcons3(copy_stack_mixed,
  701 + new_integer(depth),
  702 + mixed_copy_mask(implem)),
  703 + result);
704 704  
705 705 /* large type */
706 706 else if (consp(implem) && car(implem) == large_type)
707   - result = cons(cons(copy_stack_ptr,
708   - new_integer(depth)),
709   - result);
  707 + result = cons(cons(copy_stack_ptr,
  708 + new_integer(depth)),
  709 + result);
710 710  
711 711 /* nothing to do for small types and other primitive types */
712 712  
... ... @@ -738,7 +738,7 @@ static Expr get_string_addr(Expr string)
738 738 {
739 739 max_compiled_string += 500;
740 740 compiled_strings = (struct Compiled_string_struct *)reallocz(compiled_strings,
741   - max_compiled_string*sizeof(struct Compiled_string_struct));
  741 + max_compiled_string*sizeof(struct Compiled_string_struct));
742 742 }
743 743  
744 744 compiled_strings[next_compiled_string].string = string;
... ... @@ -753,35 +753,35 @@ static void check_end_code(Expr end_code)
753 753 while (consp(end_code))
754 754 {
755 755 if (consp(car(end_code)))
756   - {
757   - Expr instr = car(car(end_code));
758   - if (!(instr == comment ||
  756 + {
  757 + Expr instr = car(car(end_code));
  758 + if (!(instr == comment ||
759 759 instr == collapse ||
760 760 instr == del_stack ||
761 761 instr == del_stack_mixed ||
762   - instr == del_stack_ptr ||
  762 + instr == del_stack_ptr ||
763 763 instr == del_stack_struct_ptr ||
764 764 instr == del_stack_conn ||
765 765 instr == del_stack_var ||
766 766 instr == del_stack_mvar ||
767 767 instr == del_stack_function ||
768 768 instr == ret))
769   - internal_error("Unacceptable instruction in end_code",car(end_code));
770   - }
  769 + internal_error("Unacceptable instruction in end_code",car(end_code));
  770 + }
771 771 else
772   - {
773   - }
  772 + {
  773 + }
774 774  
775 775 if (cdr(end_code) == nil)
776   - {
777   - if (car(car(end_code)) != ret)
778   - internal_error("End code not ending by 'ret'",end_code);
779   - }
  776 + {
  777 + if (car(car(end_code)) != ret)
  778 + internal_error("End code not ending by 'ret'",end_code);
  779 + }
780 780 else
781   - {
782   - if (car(car(end_code)) == ret)
783   - internal_error("'ret' found in end code, not at the end",end_code);
784   - }
  781 + {
  782 + if (car(car(end_code)) == ret)
  783 + internal_error("'ret' found in end code, not at the end",end_code);
  784 + }
785 785 end_code = cdr(end_code);
786 786 }
787 787 }
... ... @@ -861,47 +861,47 @@ Expr shift_end_code(Expr end_code, Expr k)
861 861 while (consp(end_code))
862 862 {
863 863 switch (car(car(end_code)))
864   - {
865   - case comment:
866   - break;
  864 + {
  865 + case comment:
  866 + break;
867 867  
868   - case collapse: /* (collapse . depth) */
869   - case del_stack_ptr: /* (del_stack_ptr . depth) */
  868 + case collapse: /* (collapse . depth) */
  869 + case del_stack_ptr: /* (del_stack_ptr . depth) */
870 870 case del_stack_function: /* (del_stack_function . depth) */
871   - case del_stack_conn: /* idem */
872   - result = cons(cons(car(car(end_code)),
873   - cdr(car(end_code))+k),
874   - result);
875   - break;
  871 + case del_stack_conn: /* idem */
  872 + result = cons(cons(car(car(end_code)),
  873 + cdr(car(end_code))+k),
  874 + result);
  875 + break;
876 876  
877 877 case del_stack_struct_ptr: /* (del_stack_struct_ptr <struct_id> . <depth>) */
878   - result = cons(mcons3(car(car(end_code)),
  878 + result = cons(mcons3(car(car(end_code)),
879 879 second(car(end_code)),
880   - cdr2(car(end_code))+k),
881   - result);
  880 + cdr2(car(end_code))+k),
  881 + result);
882 882 break;
883 883  
884   - case del_stack: /* (del_stack depth . addr) */
885   - case del_stack_mvar: /* (del_stack_mvar depth . addr) */
886   - case del_stack_var: /* (del_stack_var depth . content_del_code_addr) */
887   - case del_stack_mixed: /* (del_stack_mixed depth mask . addr) */
888   - result = cons(mcons3(car(car(end_code)),
889   - second(car(end_code))+k,
890   - cdr2(car(end_code))),
891   - result);
892   - break;
893   -
894   - case ret:
895   - break;
896   -
897   - default:
898   - assert(0);
899   - }
  884 + case del_stack: /* (del_stack depth . addr) */
  885 + case del_stack_mvar: /* (del_stack_mvar depth . addr) */
  886 + case del_stack_var: /* (del_stack_var depth . content_del_code_addr) */
  887 + case del_stack_mixed: /* (del_stack_mixed depth mask . addr) */
  888 + result = cons(mcons3(car(car(end_code)),
  889 + second(car(end_code))+k,
  890 + cdr2(car(end_code))),
  891 + result);
  892 + break;
  893 +
  894 + case ret:
  895 + break;
  896 +
  897 + default:
  898 + assert(0);
  899 + }
900 900 end_code = cdr(end_code);
901 901 }
902 902  
903 903 result = rappend(result,list2(cons(apply,k),
904   - cons(comment,new_string("this was a terminal call"))));
  904 + cons(comment,new_string("this was a terminal call"))));
905 905  
906 906 result = cons(cons(collapse,k),result);
907 907 result = cons(cons(comment,new_string("shifted end code")),result);
... ... @@ -916,11 +916,11 @@ Expr shift_end_code(Expr end_code, Expr k)
916 916  
917 917 /* Compiling a case of a conditional (general case) *****************************/
918 918 static Expr compile_case(Expr cas,
919   - Expr type_of_test,
920   - Expr alt_implem,
921   - Expr ctxt,
922   - Expr env,
923   - Expr end_code)
  919 + Expr type_of_test,
  920 + Expr alt_implem,
  921 + Expr ctxt,
  922 + Expr env,
  923 + Expr end_code)
924 924 {
925 925  
926 926 Expr code;
... ... @@ -972,21 +972,21 @@ static Expr compile_case(Expr cas,
972 972 compiling the body. */
973 973  
974 974 t_resurg = reverse(cdr(car(cas))); /* ((<var> . <type>) ...)
975   - in reverse order */
  975 + in reverse order */
976 976 resurg_mask = nil;
977 977 new_ctxt = ctxt;
978 978  
979 979 while (consp(t_resurg))
980 980 {
981 981 if (member(car(car(t_resurg)),used_symbols))
982   - {
983   - resurg_mask = cons(used,resurg_mask);
984   - new_ctxt = cons(car(t_resurg),new_ctxt);
985   - }
  982 + {
  983 + resurg_mask = cons(used,resurg_mask);
  984 + new_ctxt = cons(car(t_resurg),new_ctxt);
  985 + }
986 986 else
987   - {
988   - resurg_mask = cons(not_used,resurg_mask);
989   - }
  987 + {
  988 + resurg_mask = cons(not_used,resurg_mask);
  989 + }
990 990 t_resurg = cdr(t_resurg);
991 991 }
992 992  
... ... @@ -1025,7 +1025,7 @@ static Expr compile_case(Expr cas,
1025 1025  
1026 1026 /* put some decoration */
1027 1027 code = cons(mcons3(context,new_ctxt,env),
1028   - code);
  1028 + code);
1029 1029  
1030 1030 //debug(new_ctxt);
1031 1031  
... ... @@ -1290,9 +1290,9 @@ Expr adm_type_description(Expr lc, Expr type, Expr env)
1290 1290  
1291 1291 /* Compiling a term *****************************************************/
1292 1292 Expr compile_term(Expr head,
1293   - Expr ctxt,
1294   - Expr env,
1295   - Expr end_code)
  1293 + Expr ctxt,
  1294 + Expr env,
  1295 + Expr end_code)
1296 1296 {
1297 1297 Expr code;
1298 1298  
... ... @@ -1399,7 +1399,7 @@ Expr compile_term(Expr head,
1399 1399 case debug_avm:
1400 1400 /* compile case: (debug_avm <lc> . <head>) */
1401 1401 {
1402   - /* If <code> is the code generated for <head>,
  1402 + /* If <code> is the code generated for <head>,
1403 1403 we will have:
1404 1404  
1405 1405 start_debug_avm
... ... @@ -1409,25 +1409,25 @@ Expr compile_term(Expr head,
1409 1409  
1410 1410 so that <code> may be debugged. */
1411 1411  
1412   - Expr main_code = compile_term(cdr2(head),ctxt,env,nil);
1413   - code = cons(start_debug_avm,
1414   - append(main_code,
1415   - cons(stop_debug_avm,end_code)));
  1412 + Expr main_code = compile_term(cdr2(head),ctxt,env,nil);
  1413 + code = cons(start_debug_avm,
  1414 + append(main_code,
  1415 + cons(stop_debug_avm,end_code)));
1416 1416 }
1417 1417 break;
1418 1418  
1419 1419  
1420   - case terminal:
  1420 + case terminal:
1421 1421 /* compile case: (terminal <lc> . <head>) */
1422 1422 {
1423 1423 /* Just test the presence of end code */
1424   - if (end_code == nil)
1425   - {
1426   - warn_line_col(second(head));
1427   - fprintf(errfile,msgtext_call_not_terminal[language]);
1428   - }
1429   - head = cdr2(head);
1430   - goto begin;
  1424 + if (end_code == nil)
  1425 + {
  1426 + warn_line_col(second(head));
  1427 + fprintf(errfile,msgtext_call_not_terminal[language]);
  1428 + }
  1429 + head = cdr2(head);
  1430 + goto begin;
1431 1431 }
1432 1432 break;
1433 1433  
... ... @@ -1436,9 +1436,9 @@ Expr compile_term(Expr head,
1436 1436 case type_rep:
1437 1437 /* compile case: (type_rep <lc> . <type>) */
1438 1438 {
1439   - /* replace type by appropriate term */
1440   - head = type_to_term(substitute(cdr2(head),env));
1441   - goto begin;
  1439 + /* replace type by appropriate term */
  1440 + head = type_to_term(substitute(cdr2(head),env));
  1441 + goto begin;
1442 1442 }
1443 1443 break;
1444 1444 #endif
... ... @@ -1449,23 +1449,23 @@ Expr compile_term(Expr head,
1449 1449 case operation:
1450 1450 /* compile case: (operation <lc> <opid> <name> <parms> <type> . <types>) */
1451 1451 {
1452   - int opid = integer_value(third(head)); /* id of operation */
1453   - Expr parms = fifth(head); /* a list of types */
  1452 + int opid = integer_value(third(head)); /* id of operation */
  1453 + Expr parms = fifth(head); /* a list of types */
1454 1454  
1455 1455 /* Note: at that point 'parms' does not contain type parameters nor unknowns, but
1456 1456 actual types. This is because 'head' is an operation instance.
1457 1457 */
1458 1458  
1459   - /* get operation instance id */
1460   - int op_i_id = get_op_instance_id(second(head),opid,parms,env);
  1459 + /* get operation instance id */
  1460 + int op_i_id = get_op_instance_id(second(head),opid,parms,env);
1461 1461  
1462 1462 //debug(parms);
1463 1463  
1464   - if (length(head) == 6) /* zero argument */
1465   - {
1466   - /* If operation has zero arguments, it is implicitly applied to zero
1467   - arguments. We generate the same code as for an
1468   - applicative term:
  1464 + if (length(head) == 6) /* zero argument */
  1465 + {
  1466 + /* If operation has zero arguments, it is implicitly applied to zero
  1467 + arguments. We generate the same code as for an
  1468 + applicative term:
1469 1469  
1470 1470 (check_stack . 1)
1471 1471 (push_addr . e)
... ... @@ -1475,35 +1475,35 @@ Expr compile_term(Expr head,
1475 1475 end_code
1476 1476  
1477 1477 */
1478   - Expr e = new_addr_name(labs_none,0);
1479   - if ((code = compiled_ops[op_i_id].inline_code) != nil)
1480   - {
1481   - code = append(code,end_code);
1482   - }
1483   - else
1484   - {
1485   - if (end_code == nil)
1486   - code = mcons6(cons(check_stack,new_integer(1)),
1487   - cons(push_addr,e),
1488   - cons(address,compiled_ops[op_i_id].addr),
1489   - cons(apply,new_integer(0)),
1490   - cons(ret_point,e),
1491   - end_code);
1492   - else
1493   - code = mcons5(cons(check_stack,new_integer(1)),
  1478 + Expr e = new_addr_name(labs_none,0);
  1479 + if ((code = compiled_ops[op_i_id].inline_code) != nil)
  1480 + {
  1481 + code = append(code,end_code);
  1482 + }
  1483 + else
  1484 + {
  1485 + if (end_code == nil)
  1486 + code = mcons6(cons(check_stack,new_integer(1)),
  1487 + cons(push_addr,e),
  1488 + cons(address,compiled_ops[op_i_id].addr),
  1489 + cons(apply,new_integer(0)),
  1490 + cons(ret_point,e),
  1491 + end_code);
  1492 + else
  1493 + code = mcons5(cons(check_stack,new_integer(1)),
1494 1494 cons(comment,new_string("pushing a dummy address")),
1495   - cons(push_addr,e),
1496   - cons(address,compiled_ops[op_i_id].addr),
1497   - shift_end_code(end_code,new_integer(0)));
1498   - }
1499   -
  1495 + cons(push_addr,e),
  1496 + cons(address,compiled_ops[op_i_id].addr),
  1497 + shift_end_code(end_code,new_integer(0)));
  1498 + }
  1499 +
1500 1500 }
1501   - else /* at least one argument */
1502   - {
1503   - /* otherwise, we just produce the function, and put the end code */
1504   - code = cons(cons(address,compiled_ops[op_i_id].addr),
1505   - end_code);
1506   - }
  1501 + else /* at least one argument */
  1502 + {
  1503 + /* otherwise, we just produce the function, and put the end code */
  1504 + code = cons(cons(address,compiled_ops[op_i_id].addr),
  1505 + end_code);
  1506 + }
1507 1507 }
1508 1508 break;
1509 1509  
... ... @@ -1515,10 +1515,10 @@ Expr compile_term(Expr head,
1515 1515 /*----------------------------------------------------------------------*/
1516 1516 case string:
1517 1517 /* compile case: (string <lc> . <string>) */
1518   - {
1519   - code = cons(cons(string,
1520   - get_string_addr(cdr2(head))),
1521   - end_code);
  1518 + {
  1519 + code = cons(cons(string,
  1520 + get_string_addr(cdr2(head))),
  1521 + end_code);
1522 1522 }
1523 1523 break;
1524 1524  
... ... @@ -1529,12 +1529,12 @@ Expr compile_term(Expr head,
1529 1529  
1530 1530  
1531 1531 /*----------------------------------------------------------------------*/
1532   - case int32:
  1532 + case anb_int32:
1533 1533 /* compile case: (int32 <lc> . <Cint>) */
1534 1534 {
1535   - code = cons(cons(load_int32,
1536   - cdr2(head)),
1537   - end_code);
  1535 + code = cons(cons(load_int32,
  1536 + cdr2(head)),
  1537 + end_code);
1538 1538 }
1539 1539 break;
1540 1540  
... ... @@ -1543,21 +1543,21 @@ Expr compile_term(Expr head,
1543 1543 case small_datum:
1544 1544 /* compile case: (small_datum <type> . <Cint>) */
1545 1545 code = cons(cons(load_int32,
1546   - cdr2(head)),
1547   - end_code);
  1546 + cdr2(head)),
  1547 + end_code);
1548 1548 break;
1549 1549  
1550 1550  
1551 1551  
1552 1552  
1553 1553 /*----------------------------------------------------------------------*/
1554   - case fpnum:
  1554 + case fpnum:
1555 1555 /* compile case: (fpnum <lc> <int32 mantissa> . <int32 exponent>) */
1556 1556 {
1557   - code = cons(mcons3(load_float,
1558   - third(head),
1559   - cdr3(head)),
1560   - end_code);
  1557 + code = cons(mcons3(load_float,
  1558 + third(head),
  1559 + cdr3(head)),
  1560 + end_code);
1561 1561 }
1562 1562 break;
1563 1563  
... ... @@ -1574,15 +1574,15 @@ Expr compile_term(Expr head,
1574 1574 Warning: <i> is not significant and should be removed from 'local'
1575 1575 */
1576 1576 {
1577   - int i = 0;
  1577 + int i = 0;
1578 1578  
1579   - while (!(car(car(ctxt)) == second(head)) &&
  1579 + while (!(car(car(ctxt)) == second(head)) &&
1580 1580 !(car(car(ctxt)) == f_micro_ctxt && second(car(ctxt)) == second(head))
1581 1581 )
1582   - {
1583   - ctxt = cdr(ctxt);
1584   - i++;
1585   - }
  1582 + {
  1583 + ctxt = cdr(ctxt);
  1584 + i++;
  1585 + }
1586 1586 //assert(i == integer_value(third(head)));
1587 1587  
1588 1588 code = mcons3(mcons3(peek,second(head),new_integer(i)),
... ... @@ -1700,16 +1700,16 @@ Expr compile_term(Expr head,
1700 1700  
1701 1701  
1702 1702 /*----------------------------------------------------------------------*/
1703   - case app:
  1703 + case app:
1704 1704 /* compile case: (app <lc> <op int head> . <int heads>) */
1705 1705 {
1706   - Expr args = reverse(cdr3(head)); /* arguments in reverse order (a_k,...,a_1) */
1707   - int k = length(args); /* number of arguments */
1708   - int op_instance_id;
1709   - Expr args_codes = nil; /* code for computing arguments */
  1706 + Expr args = reverse(cdr3(head)); /* arguments in reverse order (a_k,...,a_1) */
  1707 + int k = length(args); /* number of arguments */
  1708 + int op_instance_id;
  1709 + Expr args_codes = nil; /* code for computing arguments */
1710 1710  
1711 1711 Expr f_code = nil; /* code for function */
1712   - Expr arg_type; /* type of current argument */
  1712 + Expr arg_type; /* type of current argument */
1713 1713 int stack_needed = 0;
1714 1714  
1715 1715 //debug(head);
... ... @@ -1726,21 +1726,21 @@ Expr compile_term(Expr head,
1726 1726 msgtext_remove_alert[language]);
1727 1727 }
1728 1728  
1729   - /* <op int head> may be either (operation ...) or any other kind of term able to
1730   - represent a function (local symbol, applicative term, conditional, with-term,
1731   - ...). The code for the function is always inline except when <op int head> is
1732   - (operation ...) and if the operation instance has no inline code. */
  1729 + /* <op int head> may be either (operation ...) or any other kind of term able to
  1730 + represent a function (local symbol, applicative term, conditional, with-term,
  1731 + ...). The code for the function is always inline except when <op int head> is
  1732 + (operation ...) and if the operation instance has no inline code. */
1733 1733  
1734 1734 /* determine if f is inline or offline */
1735   - if (car(third(head)) == operation &&
  1735 + if (car(third(head)) == operation &&
1736 1736 (f_code =
1737   - compiled_ops[op_instance_id =
  1737 + compiled_ops[op_instance_id =
1738 1738 get_op_instance_id(second(third(head)),
1739 1739 integer_value(third(third(head))),
1740 1740 fifth(third(head)),
1741 1741 env)].inline_code) == nil)
1742   - {
1743   - /* the function is offline. The code is:
  1742 + {
  1743 + /* the function is offline. The code is:
1744 1744  
1745 1745 (check_stack . k+1+sup(...))
1746 1746 (push_addr . e)
... ... @@ -1753,7 +1753,7 @@ Expr compile_term(Expr head,
1753 1753 push
1754 1754 (address . f)
1755 1755 (apply . k)
1756   - (ret_point .e)
  1756 + (ret_point .e)
1757 1757 end_code
1758 1758  
1759 1759 However, in the case of offline equality, we must also keep fake copies of the two
... ... @@ -1778,9 +1778,9 @@ Expr compile_term(Expr head,
1778 1778 del_stack_instr for a2 ...
1779 1779 end_code
1780 1780  
1781   - */
  1781 + */
1782 1782  
1783   - Expr e = new_addr_name(labs_none,0);
  1783 + Expr e = new_addr_name(labs_none,0);
1784 1784  
1785 1785 if (forth(third(head)) == pdstr_eq)
1786 1786 { /* equality operation: our applicative term is:
... ... @@ -1885,99 +1885,99 @@ Expr compile_term(Expr head,
1885 1885 code = mcons3(cons(comment,new_string("pushing a dummy address")),
1886 1886 cons(push_addr,e),
1887 1887 code);
1888   -
  1888 +
1889 1889 code = cons(cons(check_stack,new_integer(stack_needed+k+1)),code);
1890 1890 }
1891 1891  
1892   - }
  1892 + }
1893 1893  
1894   - else
1895   - {
1896   - /* the function is inline. The code is the following if
1897   - car(third(head)) is 'operation':
  1894 + else
  1895 + {
  1896 + /* the function is inline. The code is the following if
  1897 + car(third(head)) is 'operation':
1898 1898  
1899   - (check_stack . k+sup(...))
1900   - [ak]ctxt
1901   - push
1902   - [ak-1]((argument . Tk) . ctxt)
1903   - push
1904   - ...
1905   - [a1]((argument . T2) ... (argument . Tk) . ctxt)
1906   - push
1907   - [f]((argument . T1) ... (argument . Tk) . ctxt)
  1899 + (check_stack . k+sup(...))
  1900 + [ak]ctxt
  1901 + push
  1902 + [ak-1]((argument . Tk) . ctxt)
  1903 + push
  1904 + ...
  1905 + [a1]((argument . T2) ... (argument . Tk) . ctxt)
  1906 + push
  1907 + [f]((argument . T1) ... (argument . Tk) . ctxt)
1908 1908  
1909   - Otherwise, it is the same one plus:
  1909 + Otherwise, it is the same one plus:
1910 1910  
1911   - - 'push_address' instruction at the beginning,
1912   - - 'apply' and 'ret_point' instructions at the end.
  1911 + - 'push_address' instruction at the beginning,
  1912 + - 'apply' and 'ret_point' instructions at the end.
1913 1913 - and k+1 instead of k in check_stack.
1914 1914  
1915   - This is because the inline code from a compiled op struct is the code
1916   - executing the function itself, while the code comming from other terms is
1917   - the code producing the function, not the code executing the function.
  1915 + This is because the inline code from a compiled op struct is the code
  1916 + executing the function itself, while the code comming from other terms is
  1917 + the code producing the function, not the code executing the function.
1918 1918  
1919 1919 Of course, the end code must be added at the end.
1920 1920 */
1921   - Expr ret_addr = nil;
1922   -
1923   - if (car(third(head)) == operation)
1924   - {
1925   - code = end_code;
1926   - }
1927   - else
1928   - {
1929   - /* we may be here for example when the function is a local symbol */
1930   - ret_addr = new_addr_name(labs_none,0);
1931   -
1932   - if (end_code == nil)
1933   - code = mcons3(cons(apply,new_integer(k)),
1934   - cons(ret_point,ret_addr),
1935   - end_code);
1936   - else
1937   - code = shift_end_code(end_code,new_integer(k));
1938   -
1939   - ctxt = cons(cons(ret,ret_addr),ctxt);
1940   - }
1941   -
1942   - /* We generate the code for arguments before the code for
1943   - f, because of context expansion */
1944   -
1945   - while (consp(args)) /* are currently in reverse order */
1946   - {
1947   - /* we are computing the list of codes:
1948   - ([a1]((argument . T2)...ctxt) ... [ak]ctxt) */
1949   -
1950   - /* get type of argument */
  1921 + Expr ret_addr = nil;
  1922 +
  1923 + if (car(third(head)) == operation)
  1924 + {
  1925 + code = end_code;
  1926 + }
  1927 + else
  1928 + {
  1929 + /* we may be here for example when the function is a local symbol */
  1930 + ret_addr = new_addr_name(labs_none,0);
  1931 +
  1932 + if (end_code == nil)
  1933 + code = mcons3(cons(apply,new_integer(k)),
  1934 + cons(ret_point,ret_addr),
  1935 + end_code);
  1936 + else
  1937 + code = shift_end_code(end_code,new_integer(k));
  1938 +
  1939 + ctxt = cons(cons(ret,ret_addr),ctxt);
  1940 + }
  1941 +
  1942 + /* We generate the code for arguments before the code for
  1943 + f, because of context expansion */
  1944 +
  1945 + while (consp(args)) /* are currently in reverse order */
  1946 + {
  1947 + /* we are computing the list of codes:
  1948 + ([a1]((argument . T2)...ctxt) ... [ak]ctxt) */
  1949 +
  1950 + /* get type of argument */
1951 1951 arg_type = type_from_interpretation(car(args),env);
1952 1952  
1953   - /* compile argument */
  1953 + /* compile argument */
1954 1954 //debug(car(args));
1955   - args_codes = cons(compile_term(car(args),
  1955 + args_codes = cons(compile_term(car(args),
1956 1956 ctxt,
1957 1957 env,
1958 1958 nil),
1959   - args_codes);
  1959 + args_codes);
1960 1960  
1961   - /* do for next argument */
1962   - args = cdr(args);
  1961 + /* do for next argument */
  1962 + args = cdr(args);
1963 1963  
1964   - /* update context */
1965   - ctxt = cons(cons(argument,arg_type),ctxt);
1966   - }
  1964 + /* update context */
  1965 + ctxt = cons(cons(argument,arg_type),ctxt);
  1966 + }
1967 1967  
1968   - /* args_codes contains codes for arguments in natural
1969   - order. We insert 'push' instruction, reversing the
1970   - order. Now ctxt is ((argument . T1) ... (argument . Tk)
1971   - . ctxt) */
  1968 + /* args_codes contains codes for arguments in natural
  1969 + order. We insert 'push' instruction, reversing the
  1970 + order. Now ctxt is ((argument . T1) ... (argument . Tk)
  1971 + . ctxt) */
1972 1972  
1973   - /* if f_code is non nil, the inline code for f is
1974   - available. Otherwise, f must be compiled (with no end code) */
1975   - if (f_code != nil)
  1973 + /* if f_code is non nil, the inline code for f is
  1974 + available. Otherwise, f must be compiled (with no end code) */
  1975 + if (f_code != nil)
1976 1976 {
1977 1977 stack_needed = sup(stack_needed,stack_needs(f_code));
1978 1978 code = append(remove_check_stack(f_code),code);
1979 1979 }
1980   - else
  1980 + else
1981 1981 {
1982 1982 //debug(third(head));
1983 1983 f_code = compile_term(third(head),ctxt,env,nil);
... ... @@ -1985,27 +1985,27 @@ Expr compile_term(Expr head,
1985 1985 code = append(remove_check_stack(f_code),code);
1986 1986 }
1987 1987  
1988   - /* Insert a view of the stack */
1989   - code = cons(mcons3(context,ctxt,env),code);
  1988 + /* Insert a view of the stack */
  1989 + code = cons(mcons3(context,ctxt,env),code);
1990 1990  
1991 1991 /* We insert arguments codes together with 'push'
1992   - instructions. */
1993   - while (consp(args_codes))
1994   - {
  1992 + instructions. */
  1993 + while (consp(args_codes))
  1994 + {
1995 1995 stack_needed = sup(stack_needed,stack_needs(car(args_codes)));
1996   - code = append(remove_check_stack(car(args_codes)),
1997   - cons(push,
1998   - code));
1999   - args_codes = cdr(args_codes);
2000   - }
  1996 + code = append(remove_check_stack(car(args_codes)),
  1997 + cons(push,
  1998 + code));
  1999 + args_codes = cdr(args_codes);
  2000 + }
2001 2001  
2002   - if (!(car(third(head)) == operation))
2003   - code = cons(cons(push_addr,ret_addr),
2004   - code);
  2002 + if (!(car(third(head)) == operation))
  2003 + code = cons(cons(push_addr,ret_addr),
  2004 + code);
2005 2005  
2006 2006 code = cons(cons(check_stack,new_integer(stack_needed+k+1)),code);
2007 2007  
2008   - }
  2008 + }
2009 2009 }
2010 2010 break;
2011 2011  
... ... @@ -2017,39 +2017,39 @@ Expr compile_term(Expr head,
2017 2017  
2018 2018  
2019 2019 /*----------------------------------------------------------------------*/
2020   - case cond:
  2020 + case cond:
2021 2021 /* compile case: (cond <lc> <int head> ((<name> (<var> . <type>) ...) <lc> . <int head>) ...) */
2022 2022 {
2023 2023  
2024   - /* the test is always compiled with no end code, because it is
  2024 + /* the test is always compiled with no end code, because it is
2025 2025 followed by the code of at least one case. */
2026   - Expr test_code = compile_term(third(head),ctxt,env,nil);
  2026 + Expr test_code = compile_term(third(head),ctxt,env,nil);
2027 2027  
2028   - /* get interpretations of cases */
2029   - Expr clause_ints = cdr3(head);
  2028 + /* get interpretations of cases */
  2029 + Expr clause_ints = cdr3(head);
2030 2030  
2031   - /* get implementation of type of test */
2032   - Expr test_type_implem =
2033   - implems[type_implementation_id(type_from_interpretation(third(head),env),env)].implem;
  2031 + /* get implementation of type of test */
  2032 + Expr test_type_implem =
  2033 + implems[type_implementation_id(type_from_interpretation(third(head),env),env)].implem;
2034 2034  
2035   - /* we need an end address only if end_code is 'nil' */
2036   - Expr end_addr = nil;
  2035 + /* we need an end address only if end_code is 'nil' */
  2036 + Expr end_addr = nil;
2037 2037  
2038 2038 /* We need case addresses when there are at least two cases */
2039   - Expr case_addrs = nil;
2040   - Expr case_codes = nil;
2041   - Expr aux, aux2;
2042   - Expr a, c;
  2039 + Expr case_addrs = nil;
  2040 + Expr case_codes = nil;
  2041 + Expr aux, aux2;
  2042 + Expr a, c;
2043 2043 int stack_needed = stack_needs(test_code);
2044 2044  
2045 2045 //if (find(new_string("first_arg"),head))debug(head);
2046 2046  
2047 2047  
2048   - if (length(clause_ints) == 1)
2049   - {
2050   - /*----------------- conditional with only one case ---------------------*/
  2048 + if (length(clause_ints) == 1)
  2049 + {
  2050 + /*----------------- conditional with only one case ---------------------*/
2051 2051  
2052   - /* The conditional:
  2052 + /* The conditional:
2053 2053  
2054 2054 (cond <lc> <test> ((<name> (<var> . <type>) ...) <lc> . <body>))
2055 2055  
... ... @@ -2058,7 +2058,7 @@ Expr compile_term(Expr head,
2058 2058 [<test>]ctxt puts value of <test> in R
2059 2059 ; no need for a switch
2060 2060 <case code>
2061   - */
  2061 + */
2062 2062 Expr case_code = compile_case(car(clause_ints),
2063 2063 type_from_interpretation(third(head),env),
2064 2064 car(cdr3(test_type_implem)),
... ... @@ -2068,17 +2068,17 @@ Expr compile_term(Expr head,
2068 2068  
2069 2069 stack_needed = sup(stack_needed,stack_needs(case_code));
2070 2070  
2071   - code = append(remove_check_stack(test_code),
2072   - remove_check_stack(case_code));
  2071 + code = append(remove_check_stack(test_code),
  2072 + remove_check_stack(case_code));
2073 2073  
2074 2074 if (stack_needed)
2075 2075 code = cons(cons(check_stack,new_integer(stack_needed)),code);
2076   - }
2077   - else
2078   - {
2079   - /*--------------- conditional with at least two cases --------------------*/
  2076 + }
  2077 + else
  2078 + {
  2079 + /*--------------- conditional with at least two cases --------------------*/
2080 2080  
2081   - /* the conditional is compiled as follows:
  2081 + /* the conditional is compiled as follows:
2082 2082  
2083 2083 [<test>]ctxt value of test in R
2084 2084 <get index instruction> index of alternative in I
... ... @@ -2096,38 +2096,38 @@ Expr compile_term(Expr head,
2096 2096 and the get index instruction is 'index_indirect'. Otherwise, it is
2097 2097 '(index_direct . bit_width)'.
2098 2098  
2099   - */
2100   -
2101   - if (end_code == nil) /* there is no end code */
2102   - {
2103   - end_addr = new_addr_name(labs_none,0);
2104   - code = list1(cons(label,end_addr));
2105   - }
2106   - else /* there is some end code */
2107   - {
2108   - code = nil;
2109   - }
2110   -
2111   - /* create case addresses and collect case codes */
2112   - aux = clause_ints; /* list of clauses */
2113   - aux2 = cdr3(test_type_implem); /* list of alt implems
2114   - (same length) */
2115   - case_codes = nil;
2116   - case_addrs = nil;
2117   - while (consp(aux))
2118   - {
  2099 + */
  2100 +
  2101 + if (end_code == nil) /* there is no end code */
  2102 + {
  2103 + end_addr = new_addr_name(labs_none,0);
  2104 + code = list1(cons(label,end_addr));
  2105 + }
  2106 + else /* there is some end code */
  2107 + {
  2108 + code = nil;
  2109 + }
  2110 +
  2111 + /* create case addresses and collect case codes */
  2112 + aux = clause_ints; /* list of clauses */
  2113 + aux2 = cdr3(test_type_implem); /* list of alt implems
  2114 + (same length) */
  2115 + case_codes = nil;
  2116 + case_addrs = nil;
  2117 + while (consp(aux))
  2118 + {
2119 2119 Expr case_code;
2120 2120  
2121   - /* create a new label */
2122   - a = new_addr_name(labs_none,0);
2123   - /* collect new address */
2124   - case_addrs = cons(a,case_addrs);
2125   - /* generate final 'jmp' (only if no end code) */
2126   - if (end_code == nil)
2127   - c = list1(cons(jmp,end_addr));
2128   - else
2129   - c = nil;
2130   - /* compile case */
  2121 + /* create a new label */
  2122 + a = new_addr_name(labs_none,0);
  2123 + /* collect new address */
  2124 + case_addrs = cons(a,case_addrs);
  2125 + /* generate final 'jmp' (only if no end code) */
  2126 + if (end_code == nil)
  2127 + c = list1(cons(jmp,end_addr));
  2128 + else
  2129 + c = nil;
  2130 + /* compile case */
2131 2131  
2132 2132 case_code = compile_case(car(aux),
2133 2133 type_from_interpretation(third(head),env),
... ... @@ -2138,27 +2138,27 @@ Expr compile_term(Expr head,
2138 2138  
2139 2139 stack_needed = sup(stack_needed,stack_needs(case_code));
2140 2140  
2141   - c = append(remove_check_stack(case_code),
2142   - c);
2143   -
2144   - /* add label for case */
2145   - c = cons(cons(label,a),c);
2146   - /* collect case code */
2147   - case_codes = append(c,case_codes);
2148   - /* do for next alternative/case */
2149   - aux = cdr(aux);
2150   - aux2 = cdr(aux2);
2151   - }
2152   -
2153   - /* append everything */
2154   - code = append(case_codes,code);
2155   - code = cons(cons(_switch,reverse(case_addrs)),code);
2156   - code = cons(car(test_type_implem) == large_type
2157   - ? index_indirect : cons(index_direct,third(test_type_implem)),code);
2158   - code = append(remove_check_stack(test_code),code);
  2141 + c = append(remove_check_stack(case_code),
  2142 + c);
  2143 +
  2144 + /* add label for case */
  2145 + c = cons(cons(label,a),c);
  2146 + /* collect case code */
  2147 + case_codes = append(c,case_codes);
  2148 + /* do for next alternative/case */
  2149 + aux = cdr(aux);
  2150 + aux2 = cdr(aux2);
  2151 + }
  2152 +
  2153 + /* append everything */
  2154 + code = append(case_codes,code);
  2155 + code = cons(cons(_switch,reverse(case_addrs)),code);
  2156 + code = cons(car(test_type_implem) == large_type
  2157 + ? index_indirect : cons(index_direct,third(test_type_implem)),code);
  2158 + code = append(remove_check_stack(test_code),code);
2159 2159 if (stack_needed)
2160 2160 code = cons(cons(check_stack,new_integer(stack_needed)),code);
2161   - }
  2161 + }
2162 2162 }
2163 2163 break;
2164 2164  
... ... @@ -2250,7 +2250,7 @@ Expr compile_term(Expr head,
2250 2250  
2251 2251  
2252 2252 /*----------------------------------------------------------------------*/
2253   - case with:
  2253 + case with:
2254 2254 /* compile case: (with <lc> <symbol> <int head> . <int head>) */
2255 2255 {
2256 2256 Expr a_code = compile_term(forth(head),ctxt,env,nil);
... ... @@ -2302,15 +2302,15 @@ Expr compile_term(Expr head,
2302 2302 /* compile case: (anb_read <lc> . <conn>) */
2303 2303  
2304 2304 {
2305   - Expr conn_type = type_from_interpretation(cdr2(head),env);
  2305 + Expr conn_type = type_from_interpretation(cdr2(head),env);
2306 2306  
2307   - assert(is_address_type(conn_type));
  2307 + assert(is_address_type(conn_type));
2308 2308  
2309   - switch (car(conn_type))
2310   - {
2311   - case type_RAddr:
2312   - case type_RWAddr:
2313   - {
  2309 + switch (car(conn_type))
  2310 + {
  2311 + case type_RAddr:
  2312 + case type_RWAddr:
  2313 + {
2314 2314 /*
2315 2315 Far connections:
2316 2316  
... ... @@ -2324,21 +2324,21 @@ Expr compile_term(Expr head,
2324 2324 where the type of the connection is (type_?Addr . T)
2325 2325 */
2326 2326  
2327   - Expr f_code = compile_term(cdr2(head),ctxt,env,nil);
2328   - Expr T = cdr(conn_type); /* type of datum in connection */
  2327 + Expr f_code = compile_term(cdr2(head),ctxt,env,nil);
  2328 + Expr T = cdr(conn_type); /* type of datum in connection */
2329 2329 Expr r_code = read_code(T,env,cons(cons(argument,conn_type),ctxt));
2330 2330  
2331   - code = cons(cons(check_stack,
  2331 + code = cons(cons(check_stack,
2332 2332 new_integer(sup(stack_needs(f_code),stack_needs(r_code)+1))),
2333   - append(remove_check_stack(f_code),
2334   - cons(push,
2335   - append(remove_check_stack(r_code),
2336   - cons(cons(del_stack_conn,new_integer(0)),end_code)))));
2337   - }
2338   - break;
2339   -
2340   - case type_Var:
2341   - {
  2333 + append(remove_check_stack(f_code),
  2334 + cons(push,
  2335 + append(remove_check_stack(r_code),
  2336 + cons(cons(del_stack_conn,new_integer(0)),end_code)))));
  2337 + }
  2338 + break;
  2339 +
  2340 + case type_Var:
  2341 + {
2342 2342 /*
2343 2343 Dynamic variable (type_Var):
2344 2344  
... ... @@ -2350,19 +2350,19 @@ Expr compile_term(Expr head,
2350 2350 del_stack Var(T) ...
2351 2351 end_code
2352 2352 */
2353   - Expr v_code = compile_term(cdr2(head),ctxt,env,nil);
2354   - Expr var_del_code_addr = get_del_code_addr(conn_type,env);
2355   -
2356   - code = mcons5(push,
2357   - get_vv,
2358   - get_copy_instr(cdr(conn_type),env),
2359   - mcons3(del_stack,new_integer(0),var_del_code_addr),
2360   - end_code);
2361   - code = append(remove_check_stack(v_code),code);
2362   - code = cons(cons(check_stack,new_integer(1+stack_needs(v_code))),
2363   - code);
2364   - }
2365   - break;
  2353 + Expr v_code = compile_term(cdr2(head),ctxt,env,nil);
  2354 + Expr var_del_code_addr = get_del_code_addr(conn_type,env);
  2355 +
  2356 + code = mcons5(push,
  2357 + get_vv,
  2358 + get_copy_instr(cdr(conn_type),env),
  2359 + mcons3(del_stack,new_integer(0),var_del_code_addr),
  2360 + end_code);
  2361 + code = append(remove_check_stack(v_code),code);
  2362 + code = cons(cons(check_stack,new_integer(1+stack_needs(v_code))),
  2363 + code);
  2364 + }
  2365 + break;
2366 2366  
2367 2367 case pseudo_type_MVar_Slot:
2368 2368 {
... ... @@ -2408,8 +2408,8 @@ Expr compile_term(Expr head,
2408 2408 }
2409 2409 break;
2410 2410  
2411   - case type_GAddr:
2412   - {
  2411 + case type_GAddr:
  2412 + {
2413 2413 /*
2414 2414 Global variable (type_GAddr):
2415 2415  
... ... @@ -2420,20 +2420,20 @@ Expr compile_term(Expr head,
2420 2420  
2421 2421 where T is the type of the datum in f.
2422 2422 */
2423   - Expr f_code = list1(cons(gv_address,get_gvar_index(cdr2(head))));
2424   - Expr T;
  2423 + Expr f_code = list1(cons(gv_address,get_gvar_index(cdr2(head))));
  2424 + Expr T;
2425 2425  
2426   - T = cdr(conn_type);
  2426 + T = cdr(conn_type);
2427 2427  
2428   - code = cons(get_copy_instr(T,env),end_code);
2429   - code = cons(get_gvv,code);
  2428 + code = cons(get_copy_instr(T,env),end_code);
  2429 + code = cons(get_gvv,code);
2430 2430 code = append(f_code,code);
2431   - }
2432   - break;
  2431 + }
  2432 + break;
2433 2433  
2434   - default:
2435   - assert(0);
2436   - }
  2434 + default:
  2435 + assert(0);
  2436 + }
2437 2437 }
2438 2438 break;
2439 2439  
... ... @@ -2445,12 +2445,12 @@ Expr compile_term(Expr head,
2445 2445 case anb_write:
2446 2446 /* compile case: (anb_write <lc> <conn> . <value>) */
2447 2447 {
2448   - Expr conn_type = type_from_interpretation(third(head),env);
  2448 + Expr conn_type = type_from_interpretation(third(head),env);
2449 2449  
2450   - switch (car(conn_type))
2451   - {
2452   - case type_WAddr:
2453   - case type_RWAddr:
  2450 + switch (car(conn_type))
  2451 + {
  2452 + case type_WAddr:
  2453 + case type_RWAddr:
2454 2454 /*
2455 2455 Far connection:
2456 2456  
... ... @@ -2467,37 +2467,37 @@ Expr compile_term(Expr head,
2467 2467 where the type of f is (type_?Addr . T), and the type
2468 2468 of a is T.
2469 2469 */
2470   - {
2471   - Expr T = type_from_interpretation(cdr3(head),env);
2472   - Expr f_code = compile_term(third(head),ctxt,env,nil);
2473   - Expr a_code = compile_term(cdr3(head),cons(cons(argument,conn_type),ctxt),env,nil);
  2470 + {
  2471 + Expr T = type_from_interpretation(cdr3(head),env);
  2472 + Expr f_code = compile_term(third(head),ctxt,env,nil);
  2473 + Expr a_code = compile_term(cdr3(head),cons(cons(argument,conn_type),ctxt),env,nil);
2474 2474 Expr w_code = write_code(T,
2475 2475 env,
2476 2476 mcons3(cons(argument,T),
2477 2477 cons(argument,conn_type),
2478 2478 ctxt));
2479   - Expr a_del_code =
2480   - get_del_code_from_ctxt(list2(cons(nil,T),
2481   - cons(ret,0)),env);
  2479 + Expr a_del_code =
  2480 + get_del_code_from_ctxt(list2(cons(nil,T),
  2481 + cons(ret,0)),env);
2482 2482  
2483 2483 int stack_needed = sup(stack_needs(f_code),
2484 2484 sup(stack_needs(a_code)+1,
2485 2485 stack_needs(w_code)+2));
2486 2486  
2487   - code = cons(cons(check_stack,new_integer(stack_needed)),
2488   - append(remove_check_stack(f_code),
2489   - cons(push,
2490   - append(remove_check_stack(a_code),
2491   - cons(push,
2492   - append(remove_check_stack(w_code),
2493   - append(a_del_code,
2494   - cons(cons(del_stack_conn,
2495   - new_integer(0)),
2496   - end_code))))))));
2497   - }
2498   - break;
2499   -
2500   - case type_Var:
  2487 + code = cons(cons(check_stack,new_integer(stack_needed)),
  2488 + append(remove_check_stack(f_code),
  2489 + cons(push,
  2490 + append(remove_check_stack(a_code),
  2491 + cons(push,
  2492 + append(remove_check_stack(w_code),
  2493 + append(a_del_code,
  2494 + cons(cons(del_stack_conn,
  2495 + new_integer(0)),
  2496 + end_code))))))));
  2497 + }
  2498 + break;
  2499 +
  2500 + case type_Var:
2501 2501 /*
2502 2502 Dynamic variable (type_Var):
2503 2503  
... ... @@ -2518,14 +2518,14 @@ Expr compile_term(Expr head,
2518 2518 del_stack 0 Var(T) ...
2519 2519 end code
2520 2520 */
2521   - {
  2521 + {
2522 2522 Expr z_addr = new_addr_name(labs_none,0);
2523   - Expr var_del_code_addr = get_del_code_addr(conn_type,env);
2524   - Expr v_code = compile_term(third(head),ctxt,env,nil);
2525   - Expr a_code = compile_term(cdr3(head),cons(cons(argument,conn_type),ctxt),env,nil);
  2523 + Expr var_del_code_addr = get_del_code_addr(conn_type,env);
  2524 + Expr v_code = compile_term(third(head),ctxt,env,nil);
  2525 + Expr a_code = compile_term(cdr3(head),cons(cons(argument,conn_type),ctxt),env,nil);
2526 2526 int stack_needed = sup(stack_needs(v_code),stack_needs(a_code))+4;
2527 2527  
2528   - code = cons(mcons3(del_stack,new_integer(0),var_del_code_addr),end_code);
  2528 + code = cons(mcons3(del_stack,new_integer(0),var_del_code_addr),end_code);
2529 2529 code = cons(cons(glue_index,new_integer(0)),code);
2530 2530  
2531 2531 //code = cons(stop_debug_avm,code);
... ... @@ -2539,15 +2539,15 @@ Expr compile_term(Expr head,
2539 2539 code = cons(get_var_monitors,code);
2540 2540 code = cons(cons(push_addr,z_addr),code);
2541 2541  
2542   - code = cons(get_del_instr(cdr(conn_type),env),code);
2543   - code = cons(xchg_vv,code);
2544   - code = append(remove_check_stack(a_code),code);
2545   - code = cons(push,code);
2546   - code = append(remove_check_stack(v_code),code);
2547   - code = cons(cons(check_stack,new_integer(stack_needed)),
2548   - code);
2549   - }
2550   - break;
  2542 + code = cons(get_del_instr(cdr(conn_type),env),code);
  2543 + code = cons(xchg_vv,code);
  2544 + code = append(remove_check_stack(a_code),code);
  2545 + code = cons(push,code);
  2546 + code = append(remove_check_stack(v_code),code);
  2547 + code = cons(cons(check_stack,new_integer(stack_needed)),
  2548 + code);
  2549 + }
  2550 + break;
2551 2551  
2552 2552 case pseudo_type_MVar_Slot:
2553 2553 /*
... ... @@ -2606,19 +2606,19 @@ Expr compile_term(Expr head,
2606 2606 code = cons(cons(address,mvar_change_code_label),code);
2607 2607 code = cons(get_mvar_monitors,code);
2608 2608 code = cons(cons(push_addr,z_addr),code);
2609   - code = cons(get_del_instr(cdr(conn_type),env),code);
2610   - code = cons(xchg_mvv,code);
2611   - code = append(remove_check_stack(a_code),code);
  2609 + code = cons(get_del_instr(cdr(conn_type),env),code);
  2610 + code = cons(xchg_mvv,code);
  2611 + code = append(remove_check_stack(a_code),code);
2612 2612 code = cons(push,code);
2613 2613 code = append(remove_check_stack(i_code),code);
2614 2614 code = cons(push,code);
2615 2615 code = append(remove_check_stack(mv_code),code);
2616   - code = cons(cons(check_stack,new_integer(stack_needed)),
2617   - code);
  2616 + code = cons(cons(check_stack,new_integer(stack_needed)),
  2617 + code);
2618 2618 }
2619 2619 break;
2620 2620  
2621   - case type_GAddr:
  2621 + case type_GAddr:
2622 2622 /*
2623 2623 Global variable connection:
2624 2624  
... ... @@ -2632,32 +2632,32 @@ Expr compile_term(Expr head,
2632 2632  
2633 2633 where T is the type of 'a'.
2634 2634 */
2635   - {
2636   - Expr T = type_from_interpretation(cdr3(head),env);
2637   - Expr a_code = compile_term(cdr3(head),ctxt,env,nil);
  2635 + {
  2636 + Expr T = type_from_interpretation(cdr3(head),env);
  2637 + Expr a_code = compile_term(cdr3(head),ctxt,env,nil);
2638 2638 Expr f_code = list1(cons(gv_address,get_gvar_index(third(head))));
2639 2639 int stack_needed = sup(stack_needs(a_code),stack_needs(f_code)+1);
2640 2640  
2641   - code = cons(cons(load_int32,0),end_code);
2642   - code = cons(get_del_instr(T,env),code);
2643   - code = cons(xchg_gvv,code);
2644   - code = append(remove_check_stack(f_code),code);
2645   - code = cons(push,code);
2646   - code = append(remove_check_stack(a_code),code);
2647   - code = cons(cons(check_stack,new_integer(stack_needed)),code);
2648   - }
2649   - break;
2650   -
2651   - default:
2652   - assert(0);
2653   - }
  2641 + code = cons(cons(load_int32,0),end_code);
  2642 + code = cons(get_del_instr(T,env),code);
  2643 + code = cons(xchg_gvv,code);
  2644 + code = append(remove_check_stack(f_code),code);
  2645 + code = cons(push,code);
  2646 + code = append(remove_check_stack(a_code),code);
  2647 + code = cons(cons(check_stack,new_integer(stack_needed)),code);
  2648 + }
  2649 + break;
  2650 +
  2651 + default:
  2652 + assert(0);
  2653 + }
2654 2654 }
2655 2655 break;
2656 2656  
2657 2657 case anb_exchange:
2658 2658 /* compile case: (anb_exchange <lc> <conn> . <value>) */
2659 2659 {
2660   - /*
  2660 + /*
2661 2661  
2662 2662  
2663 2663 Dynamic variable (type_Var):
... ... @@ -2686,19 +2686,19 @@ Expr compile_term(Expr head,
2686 2686 where T is the type of 'a'.
2687 2687 */
2688 2688  
2689   - Expr conn_type = type_from_interpretation(third(head),env);
  2689 + Expr conn_type = type_from_interpretation(third(head),env);
2690 2690  
2691   - switch (car(conn_type))
2692   - {
2693   - case type_Var:
2694   - {
  2691 + switch (car(conn_type))
  2692 + {
  2693 + case type_Var:
  2694 + {
2695 2695 Expr z_addr = new_addr_name(labs_none,0);
2696   - Expr var_del_code_addr = get_del_code_addr(conn_type,env);
2697   - Expr v_code = compile_term(third(head),ctxt,env,nil);
2698   - Expr a_code = compile_term(cdr3(head),cons(cons(argument,conn_type),ctxt),env,nil);
  2696 + Expr var_del_code_addr = get_del_code_addr(conn_type,env);
  2697 + Expr v_code = compile_term(third(head),ctxt,env,nil);
  2698 + Expr a_code = compile_term(cdr3(head),cons(cons(argument,conn_type),ctxt),env,nil);
2699 2699 int stack_needed = sup(stack_needs(v_code),stack_needs(a_code))+4;
2700 2700  
2701   - code = cons(mcons3(del_stack,new_integer(0),var_del_code_addr),end_code);
  2701 + code = cons(mcons3(del_stack,new_integer(0),var_del_code_addr),end_code);
2702 2702  
2703 2703 //code = cons(stop_debug_avm,code);
2704 2704  
... ... @@ -2711,31 +2711,31 @@ Expr compile_term(Expr head,
2711 2711 code = cons(get_var_monitors,code);
2712 2712 code = cons(cons(push_addr,z_addr),code);
2713 2713  
2714   - code = cons(xchg_vv,code);
2715   - code = append(remove_check_stack(a_code),code);
2716   - code = cons(push,code);
2717   - code = append(remove_check_stack(v_code),code);
2718   - code = cons(cons(check_stack,new_integer(stack_needed)),
2719   - code);
2720   - }
2721   - break;
2722   - case type_GAddr:
2723   - {
2724   - Expr a_code = compile_term(cdr3(head),ctxt,env,nil);
  2714 + code = cons(xchg_vv,code);
  2715 + code = append(remove_check_stack(a_code),code);
  2716 + code = cons(push,code);
  2717 + code = append(remove_check_stack(v_code),code);
  2718 + code = cons(cons(check_stack,new_integer(stack_needed)),
  2719 + code);
  2720 + }
  2721 + break;
  2722 + case type_GAddr:
  2723 + {
  2724 + Expr a_code = compile_term(cdr3(head),ctxt,env,nil);
2725 2725 Expr f_code = list1(cons(gv_address,get_gvar_index(third(head))));
2726 2726 int stack_needed = sup(stack_needs(a_code),stack_needs(f_code)+1);
2727 2727  
2728   - code = cons(xchg_gvv,code);
2729   - code = append(remove_check_stack(f_code),code);
2730   - code = cons(push,code);
2731   - code = append(remove_check_stack(a_code),code);
2732   - code = cons(cons(check_stack,new_integer(stack_needed)),code);
2733   - }
2734   - break;
2735   -
2736   - default:
2737   - assert(0);
2738   - }
  2728 + code = cons(xchg_gvv,code);
  2729 + code = append(remove_check_stack(f_code),code);
  2730 + code = cons(push,code);
  2731 + code = append(remove_check_stack(a_code),code);
  2732 + code = cons(cons(check_stack,new_integer(stack_needed)),code);
  2733 + }
  2734 + break;
  2735 +
  2736 + default:
  2737 + assert(0);
  2738 + }
2739 2739 }
2740 2740 break;
2741 2741  
... ... @@ -2784,7 +2784,7 @@ Expr compile_term(Expr head,
2784 2784  
2785 2785 case wait_for:
2786 2786 {
2787   - /* compile case: (wait_for <lc> <head (condition)> <head (milliseconds)>
  2787 + /* compile case: (wait_for <lc> <head (condition)> <head (milliseconds)>
2788 2788 . <head (after)>) */
2789 2789  
2790 2790 /*
... ... @@ -2799,24 +2799,24 @@ Expr compile_term(Expr head,
2799 2799 pop_1 pop the delay
2800 2800 [after] otherwise continue
2801 2801  
2802   - */
2803   - Expr a = new_addr_name(labs_none,0);
2804   - Expr cond_code = compile_term(third(head),
  2802 + */
  2803 + Expr a = new_addr_name(labs_none,0);
  2804 + Expr cond_code = compile_term(third(head),
2805 2805 cons(cons(argument,type_Int32),ctxt),env,nil);
2806 2806 Expr ms_code = compile_term(forth(head),ctxt,env,nil);
2807   - Expr after_code = compile_term(cdr4(head),ctxt,env,end_code);
  2807 + Expr after_code = compile_term(cdr4(head),ctxt,env,end_code);
2808 2808 int stack_needed = sup(stack_needs(cond_code)+1,sup(stack_needs(ms_code),stack_needs(after_code)));
2809 2809  
2810   - code = mcons3(cons(jmp_false,a),
  2810 + code = mcons3(cons(jmp_false,a),
2811 2811 pop1,
2812   - remove_check_stack(after_code));
  2812 + remove_check_stack(after_code));
2813 2813  
2814   - code = append(remove_check_stack(cond_code),code);
  2814 + code = append(remove_check_stack(cond_code),code);
2815 2815  
2816   - code = mcons4(push,
  2816 + code = mcons4(push,
2817 2817 cons(label,a),
2818   - give_up,
2819   - code);
  2818 + give_up,
  2819 + code);
2820 2820  
2821 2821 code = append(ms_code,code);
2822 2822  
... ... @@ -2831,7 +2831,7 @@ Expr compile_term(Expr head,
2831 2831  
2832 2832 case delegate:
2833 2833 {
2834   - /* (delegate <lc> <head (delegated)> . <head (body)>) *///
  2834 + /* (delegate <lc> <head (delegated)> . <head (body)>) *///
2835 2835  
2836 2836 /*
2837 2837 should produce this:
... ... @@ -2856,28 +2856,28 @@ Expr compile_term(Expr head,
2856 2856 label a:
2857 2857 [body]
2858 2858  
2859   - */
2860   - int d = length(ctxt);
2861   - Expr a = new_addr_name(labs_none,0);
  2859 + */
  2860 + int d = length(ctxt);
  2861 + Expr a = new_addr_name(labs_none,0);
2862 2862 Expr b = new_addr_name(labs_none,0);
2863 2863 Expr c = new_addr_name(labs_none,0);
2864   - Expr before_start = get_before_start_code(ctxt,env);
2865   - Expr delegated_code = compile_term(third(head),ctxt,env,nil);
2866   - Expr virtual_deletions = get_del_code_from_ctxt(ctxt,env);
2867   - Expr body_code = compile_term(cdr3(head),ctxt,env,end_code);
  2864 + Expr before_start = get_before_start_code(ctxt,env);
  2865 + Expr delegated_code = compile_term(third(head),ctxt,env,nil);
  2866 + Expr virtual_deletions = get_del_code_from_ctxt(ctxt,env);
  2867 + Expr body_code = compile_term(cdr3(head),ctxt,env,end_code);
2868 2868  
2869   - code = mcons3(finish,
2870   - cons(label,a),
2871   - remove_check_stack(body_code));
  2869 + code = mcons3(finish,
  2870 + cons(label,a),
  2871 + remove_check_stack(body_code));
2872 2872  
2873 2873 code = cons(cons(ret_point,c),code);
2874 2874 code = cons(cons(apply,new_integer(0)),code);
2875 2875 code = cons(variables_deletion_address,code);
2876 2876 code = cons(cons(push_addr,c),code);
2877 2877 code = cons(get_del_instr(type_from_interpretation(third(head),env),env),code);
2878   - code = append(virtual_deletions,code);
  2878 + code = append(virtual_deletions,code);
2879 2879 code = cons(cons(comment,new_string("deleting initial stack content")),code);
2880   - code = append(delegated_code,code);
  2880 + code = append(delegated_code,code);
2881 2881  
2882 2882 //code = cons(stop_debug_avm,code);
2883 2883  
... ... @@ -2888,8 +2888,8 @@ Expr compile_term(Expr head,
2888 2888  
2889 2889 //code = cons(start_debug_avm,code);
2890 2890  
2891   - code = cons(mcons3(start,new_integer(d),a),code);
2892   - code = append(before_start,code);
  2891 + code = cons(mcons3(start,new_integer(d),a),code);
  2892 + code = append(before_start,code);
2893 2893 code = cons(cons(check_stack,new_integer(stack_needs(body_code))),code);
2894 2894 }
2895 2895 break;
... ... @@ -2899,7 +2899,7 @@ Expr compile_term(Expr head,
2899 2899  
2900 2900 case serialize:
2901 2901 {
2902   - /* head = (serialize <lc> . <term>) */
  2902 + /* head = (serialize <lc> . <term>) */
2903 2903  
2904 2904 /*
2905 2905 should produce:
... ... @@ -2919,22 +2919,22 @@ Expr compile_term(Expr head,
2919 2919 <end code>
2920 2920  
2921 2921 */
2922   - Expr term_code = compile_term(cdr2(head),ctxt,env,nil);
2923   - Expr term_type = type_from_interpretation(cdr2(head),env);
2924   - Expr implem_id = type_implementation_id(term_type,env);
2925   - Expr implem_code_addr = implems[implem_id].addr;
2926   -
2927   - if (same_type(term_type,env,type_ByteArray,nil))
2928   - code = end_code;
2929   - else
2930   - code = mcons6(push,
2931   - mcons3(context,cons(cons(argument,term_type),ctxt),env),
2932   - cons(serialize,implem_code_addr),
2933   - cons(revert_to_computing,new_integer(type_width(term_type,env))),
2934   - get_del_stack_instr(term_type,env,new_integer(0)),
2935   - end_code);
2936   -
2937   - code = append(term_code,code);
  2922 + Expr term_code = compile_term(cdr2(head),ctxt,env,nil);
  2923 + Expr term_type = type_from_interpretation(cdr2(head),env);
  2924 + Expr implem_id = type_implementation_id(term_type,env);
  2925 + Expr implem_code_addr = implems[implem_id].addr;
  2926 +
  2927 + if (same_type(term_type,env,type_ByteArray,nil))
  2928 + code = end_code;
  2929 + else
  2930 + code = mcons6(push,
  2931 + mcons3(context,cons(cons(argument,term_type),ctxt),env),
  2932 + cons(serialize,implem_code_addr),
  2933 + cons(revert_to_computing,new_integer(type_width(term_type,env))),
  2934 + get_del_stack_instr(term_type,env,new_integer(0)),
  2935 + end_code);
  2936 +
  2937 + code = append(term_code,code);
2938 2938 }
2939 2939 break;
2940 2940  
... ... @@ -2944,7 +2944,7 @@ Expr compile_term(Expr head,
2944 2944  
2945 2945 case unserialize: /* (unserialize <lc> <type> . <head>) *///
2946 2946 {
2947   - /*
  2947 + /*
2948 2948  
2949 2949 Unserializing is a state of the virtual machine, and works as follows.
2950 2950  
... ... @@ -3076,30 +3076,30 @@ Expr compile_term(Expr head,
3076 3076 success 32 needed to put the byte array into a 'success'
3077 3077 <end code>
3078 3078  
3079   - */
3080   - Expr term_code = compile_term(cdr3(head),ctxt,env,nil);
3081   - Expr type = third(head);
3082   - Expr implem_id;
3083   - Expr implem_code_addr;
  3079 + */
  3080 + Expr term_code = compile_term(cdr3(head),ctxt,env,nil);
  3081 + Expr type = third(head);
  3082 + Expr implem_id;
  3083 + Expr implem_code_addr;
3084 3084  
3085   - /* type must be 'Maybe(T)' */
3086   - assert(consp(type) && car(type) == app_ts && second(type) == pdstr_Maybe);
  3085 + /* type must be 'Maybe(T)' */
  3086 + assert(consp(type) && car(type) == app_ts && second(type) == pdstr_Maybe);
3087 3087  
3088   - /* the type of interest to us is T */
3089   - type = third(type);
3090   - implem_id = type_implementation_id(type,env);
3091   - implem_code_addr = implems[implem_id].addr;
  3088 + /* the type of interest to us is T */
  3089 + type = third(type);
  3090 + implem_id = type_implementation_id(type,env);
  3091 + implem_code_addr = implems[implem_id].addr;
3092 3092  
3093   - if (same_type(type,env,type_ByteArray,nil))
3094   - code = cons(cons(success,new_integer(mw)),
  3093 + if (same_type(type,env,type_ByteArray,nil))
  3094 + code = cons(cons(success,new_integer(mw)),
3095 3095 end_code);
3096   - else
3097   - code = mcons4(cons(unserialize,implem_code_addr),
3098   - cons(revert_to_computing,new_integer(type_width(type,env))),
3099   - get_del_stack_instr(type,env,new_integer(0)),
3100   - end_code);
  3096 + else
  3097 + code = mcons4(cons(unserialize,implem_code_addr),
  3098 + cons(revert_to_computing,new_integer(type_width(type,env))),
  3099 + get_del_stack_instr(type,env,new_integer(0)),
  3100 + end_code);
3101 3101  
3102   - code = append(term_code,code);
  3102 + code = append(term_code,code);
3103 3103 }
3104 3104 break;
3105 3105  
... ... @@ -3260,9 +3260,9 @@ static Expr constructor_code(Expr type_implem, int alt_index);
3260 3260 Expr op_comment(int opid)
3261 3261 {
3262 3262 sprintf(ccbuf,"* * * '%s' (in '%s' at line %d) * * *",
3263   - string_content(car(operations[opid].names)),
3264   - string_content(operations[opid].file_name),
3265   - integer_value(operations[opid].line));
  3263 + string_content(car(operations[opid].names)),
  3264 + string_content(operations[opid].file_name),
  3265 + integer_value(operations[opid].line));
3266 3266 return new_string(ccbuf);
3267 3267 }
3268 3268  
... ... @@ -3308,11 +3308,11 @@ static Expr do_kill_instrs(Expr code)
3308 3308 /**** Compiling an operation *************************************************/
3309 3309 int get_op_instance_id(Expr lc,
3310 3310 int opid,
3311   - Expr parms, /* a list of types in the same
3312   - order as parameters in the
3313   - parms field of the operation
3314   - structure */
3315   - Expr env) /* values for unknowns in these types */
  3311 + Expr parms, /* a list of types in the same
  3312 + order as parameters in the
  3313 + parms field of the operation
  3314 + structure */
  3315 + Expr env) /* values for unknowns in these types */
3316 3316 {
3317 3317 int i, arity;
3318 3318  
... ... @@ -3341,15 +3341,15 @@ int get_op_instance_id(Expr lc,
3341 3341 for (i = 0; i < next_compiled_op; i++)
3342 3342 {
3343 3343 if (same_op_instance(opid,
3344   - parms,
3345   - env,
3346   - compiled_ops[i].op_id,
3347   - compiled_ops[i].types,
3348   - compiled_ops[i].env))
3349   - {
3350   - /* operation is already compiled */
3351   - return i;
3352   - }
  3344 + parms,
  3345 + env,
  3346 + compiled_ops[i].op_id,
  3347 + compiled_ops[i].types,
  3348 + compiled_ops[i].env))
  3349 + {
  3350 + /* operation is already compiled */
  3351 + return i;
  3352 + }
3353 3353 }
3354 3354  
3355 3355 /* operation is not already compiled */
... ... @@ -3375,10 +3375,10 @@ int get_op_instance_id(Expr lc,
3375 3375 while(consp(aux))
3376 3376 {
3377 3377 /* 'subst' is temporary */
3378   - subst =
3379   - cons(cons(car(op_parms),car(aux)),subst);
3380   - aux = cdr(aux);
3381   - op_parms = cdr(op_parms);
  3378 + subst =
  3379 + cons(cons(car(op_parms),car(aux)),subst);
  3380 + aux = cdr(aux);
  3381 + op_parms = cdr(op_parms);
3382 3382 }
3383 3383  
3384 3384 assert(i == next_compiled_op);
... ... @@ -3408,55 +3408,55 @@ int get_op_instance_id(Expr lc,
3408 3408  
3409 3409 if (def == no_term)
3410 3410 {
3411   - fprintf(errfile,
3412   - msgtext_operation_not_defined[language],
3413   - string_content(car(operations[opid].names)),
3414   - string_content(operations[opid].file_name),
3415   - integer_value(operations[opid].line));
3416   - anb_exit(1);
  3411 + fprintf(errfile,
  3412 + msgtext_operation_not_defined[language],
  3413 + string_content(car(operations[opid].names)),
  3414 + string_content(operations[opid].file_name),
  3415 + integer_value(operations[opid].line));
  3416 + anb_exit(1);
3417 3417 }
3418 3418  
3419 3419 else if (car(def) == constructor)
3420 3420 /* def = (constructor <type_id> . <alt_index>) */
3421 3421 {
3422   - Expr c_code;
  3422 + Expr c_code;
3423 3423  
3424   - /* compiling a constructor instance */
3425   - int type_id = integer_value(second(def));
3426   - int alt_index = integer_value(cdr2(def));
3427   - Expr type_instance, type_implem;
  3424 + /* compiling a constructor instance */
  3425 + int type_id = integer_value(second(def));
  3426 + int alt_index = integer_value(cdr2(def));
  3427 + Expr type_instance, type_implem;
3428 3428  
3429   - /* The structure operations[opid] describes a constructor scheme, which we must
3430   - instantiate. operations[opid].parms is the list of parameters of the type
3431   - scheme, which defined the constructor (see typedef.c). It must be the same as
3432   - the list of parameters of the type scheme number 'type_id'. */
  3429 + /* The structure operations[opid] describes a constructor scheme, which we must
  3430 + instantiate. operations[opid].parms is the list of parameters of the type
  3431 + scheme, which defined the constructor (see typedef.c). It must be the same as
  3432 + the list of parameters of the type scheme number 'type_id'. */
3433 3433  
3434   - assert(equal(types[type_id].parms,operations[opid].parms));
  3434 + assert(equal(types[type_id].parms,operations[opid].parms));
3435 3435  
3436   - /* Now, our 'parms' argument (of this procedure 'get_op_instance_id') is precisely
3437   - the list of values of the parameters (taking the environment into account). So,
3438   - the (target) type of our constructor instance is precisely: */
  3436 + /* Now, our 'parms' argument (of this procedure 'get_op_instance_id') is precisely
  3437 + the list of values of the parameters (taking the environment into account). So,
  3438 + the (target) type of our constructor instance is precisely: */
3439 3439  
3440   - type_instance = mcons3(app_ts,
3441   - types[type_id].name,
3442   - parms);
  3440 + type_instance = mcons3(app_ts,
  3441 + types[type_id].name,
  3442 + parms);
3443 3443  
3444   - /* so that we can compute the implementation the instance of the (target) type of
3445   - our constructor */
3446   - type_implem = implems[type_implementation_id(type_instance,env)].implem;
3447   -
3448   - /* get code for that constructor */
3449   - c_code = constructor_code(type_implem,alt_index);
  3444 + /* so that we can compute the implementation the instance of the (target) type of
  3445 + our constructor */
  3446 + type_implem = implems[type_implementation_id(type_instance,env)].implem;
  3447 +
  3448 + /* get code for that constructor */
  3449 + c_code = constructor_code(type_implem,alt_index);
3450 3450  
3451   - sprintf(ccbuf,"constructor number %d for type '%s'",
  3451 + sprintf(ccbuf,"constructor number %d for type '%s'",
3452 3452 alt_index,
3453 3453 string_content(types[type_id].name));
3454 3454  
3455 3455 compiled_ops[i].inline_code = save(
3456   - cons(cons(comment,new_string(ccbuf)),
3457   - c_code));
  3456 + cons(cons(comment,new_string(ccbuf)),
  3457 + c_code));
3458 3458  
3459   - compiled_ops[i].offline_code = save(
  3459 + compiled_ops[i].offline_code = save(
3460 3460 cons(cons(header,op_comment(opid)),
3461 3461 mcons3(odd_align,
3462 3462 cons(label,addr),
... ... @@ -3467,25 +3467,25 @@ int get_op_instance_id(Expr lc,
3467 3467  
3468 3468 else
3469 3469 {
3470   - Expr ctxt = append(substitute(operations[opid].ctxt,subst),
3471   - list1(cons(ret,new_integer(arity))));
  3470 + Expr ctxt = append(substitute(operations[opid].ctxt,subst),
  3471 + list1(cons(ret,new_integer(arity))));
3472 3472  
3473 3473 Expr del_code = get_del_code_from_ctxt(ctxt,env);
3474 3474  
3475 3475 /* code for general offline operations */
3476 3476 //debug(def);
3477   - aux = compile_term(def,
3478   - ctxt,
3479   - env,
3480   - append(del_code,
3481   - list1(cons(ret,new_integer(arity)))));
  3477 + aux = compile_term(def,
  3478 + ctxt,
  3479 + env,
  3480 + append(del_code,
  3481 + list1(cons(ret,new_integer(arity)))));
3482 3482  
3483 3483 if (car(def) == avm)
3484 3484 aux = do_kill_instrs(aux);
3485 3485  
3486 3486 compiled_ops[i].offline_code = save(
3487 3487 cons(cons(header,op_comment(opid)),
3488   - mcons3(odd_align,
  3488 + mcons3(odd_align,
3489 3489 cons(label,addr),
3490 3490 cons(mcons3(context,ctxt,env),
3491 3491 aux))));
... ... @@ -3526,19 +3526,19 @@ Expr constructor_code_1(Expr alt, int alt_index)
3526 3526  
3527 3527 case small_alt:
3528 3528 {
3529   - alt = cdr(alt); /* alt = ((i1 o1 . w1) ... (ik ok . wk)) */
  3529 + alt = cdr(alt); /* alt = ((i1 o1 . w1) ... (ik ok . wk)) */
3530 3530  
3531   - result = nil;
  3531 + result = nil;
3532 3532 i = length(alt);
3533   - while(consp(alt))
3534   - {
3535   - result = cons(cons(glue,second(car(alt))),result);
3536   - alt = cdr(alt);
3537   - i--;
3538   - }
3539   - return cons(cons(glue_index,new_integer(alt_index)),
3540   - hard_reverse(result)
3541   - /* result */
  3533 + while(consp(alt))
  3534 + {
  3535 + result = cons(cons(glue,second(car(alt))),result);
  3536 + alt = cdr(alt);
  3537 + i--;
  3538 + }
  3539 + return cons(cons(glue_index,new_integer(alt_index)),
  3540 + hard_reverse(result)
  3541 + /* result */
3542 3542 );
3543 3543 }
3544 3544 break;
... ... @@ -3547,25 +3547,25 @@ Expr constructor_code_1(Expr alt, int alt_index)
3547 3547  
3548 3548 case mixed_alt:
3549 3549 {
3550   - int n, d;
3551   - Expr aux;
3552   - alt = cdr(alt); /* alt = ((i1 o1 . w1) ... (ik ok . wk)) */
  3550 + int n, d;
  3551 + Expr aux;
  3552 + alt = cdr(alt); /* alt = ((i1 o1 . w1) ... (ik ok . wk)) */
3553 3553  
3554 3554  
3555   - /* Computing the size of the segment to allocate: it is
  3555 + /* Computing the size of the segment to allocate: it is
3556 3556 4 + w1 + ... + wk. */
3557   - aux = alt;
3558   - n = d = 4;
3559   - while (consp(aux))
3560   - {
3561   - n += integer_value(cdr2(car(aux)));
3562   - aux = cdr(aux);
3563   - }
3564   -
3565   - /* making the constructor code */
3566   - result = nil;
3567   - while(consp(alt))
3568   - {
  3557 + aux = alt;
  3558 + n = d = 4;
  3559 + while (consp(aux))
  3560 + {
  3561 + n += integer_value(cdr2(car(aux)));
  3562 + aux = cdr(aux);
  3563 + }
  3564 +
  3565 + /* making the constructor code */
  3566 + result = nil;
  3567 + while(consp(alt))
  3568 + {
3569 3569 result = cons(cons(cdr2(car(alt)) == new_integer(0)
3570 3570 ?
3571 3571 store_0
... ... @@ -3581,12 +3581,12 @@ Expr constructor_code_1(Expr alt, int alt_index)
3581 3581 store_4,
3582 3582 second(car(alt))+new_integer(d)),
3583 3583 result);
3584   - alt = cdr(alt);
3585   - }
3586   - result = cons(cons(alloc,new_integer(n)),
3587   - append(hard_reverse(result),
3588   - list1(cons(glue_mixed_index,new_integer(alt_index)))));
3589   - return result;
  3584 + alt = cdr(alt);
  3585 + }
  3586 + result = cons(cons(alloc,new_integer(n)),
  3587 + append(hard_reverse(result),
  3588 + list1(cons(glue_mixed_index,new_integer(alt_index)))));
  3589 + return result;
3590 3590 }
3591 3591 break;
3592 3592  
... ... @@ -3594,26 +3594,26 @@ Expr constructor_code_1(Expr alt, int alt_index)
3594 3594  
3595 3595 case large_alt:
3596 3596 {
3597   - int n, d;
3598   - Expr aux;
3599   - alt = cdr(alt); /* alt = ((i1 o1 . w1) ... (ik ok . wk)) */
  3597 + int n, d;
  3598 + Expr aux;
  3599 + alt = cdr(alt); /* alt = ((i1 o1 . w1) ... (ik ok . wk)) */
3600 3600  
3601 3601  
3602   - /* Computing the size of the segment to allocate: it is
  3602 + /* Computing the size of the segment to allocate: it is
3603 3603 4 + 1 + w1 + ... + wk. */
3604   - aux = alt;
3605   - n = d = 4+1;
3606   - while (consp(aux))
3607   - {
3608   - n += integer_value(cdr2(car(aux)));
3609   - aux = cdr(aux);
3610   - }
3611   - /* n is the number of bytes to allocate */
3612   -
3613   - /* making the constructor code */
3614   - result = nil;
3615   - while(consp(alt))
3616   - {
  3604 + aux = alt;
  3605 + n = d = 4+1;
  3606 + while (consp(aux))
  3607 + {
  3608 + n += integer_value(cdr2(car(aux)));
  3609 + aux = cdr(aux);
  3610 + }
  3611 + /* n is the number of bytes to allocate */
  3612 +
  3613 + /* making the constructor code */
  3614 + result = nil;
  3615 + while(consp(alt))
  3616 + {
3617 3617 result = cons(cons(cdr2(car(alt)) == new_integer(0)
3618 3618 ?
3619 3619 store_0
... ... @@ -3629,13 +3629,13 @@ Expr constructor_code_1(Expr alt, int alt_index)
3629 3629 store_4,
3630 3630 second(car(alt))+new_integer(d)),
3631 3631 result);
3632   - alt = cdr(alt);
3633   - }
  3632 + alt = cdr(alt);
  3633 + }
3634 3634  
3635   - result = cons(cons(alloc,new_integer(n)),
3636   - cons(cons(store_index,new_integer(alt_index)),
3637   - hard_reverse(result)));
3638   - return result;
  3635 + result = cons(cons(alloc,new_integer(n)),
  3636 + cons(cons(store_index,new_integer(alt_index)),
  3637 + hard_reverse(result)));
  3638 + return result;
3639 3639 }
3640 3640 break;
3641 3641  
... ... @@ -3650,7 +3650,7 @@ Expr constructor_code_1(Expr alt, int alt_index)
3650 3650  
3651 3651  
3652 3652 Expr constructor_code(Expr type_implem,
3653   - int alt_index)
  3653 + int alt_index)
3654 3654 {
3655 3655 Expr alt, iw;
3656 3656 int i;
... ... @@ -3672,10 +3672,10 @@ Expr constructor_code(Expr type_implem,
3672 3672 */
3673 3673  
3674 3674 assert(consp(type_implem) && (
3675   - car(type_implem) == small_type ||
3676   - car(type_implem) == mixed_type ||
3677   - car(type_implem) == large_type
3678   - ));
  3675 + car(type_implem) == small_type ||
  3676 + car(type_implem) == mixed_type ||
  3677 + car(type_implem) == large_type
  3678 + ));
3679 3679  
3680 3680 /* get width of index */
3681 3681 iw = third(type_implem);
... ...
anubis_dev/compiler/src/delcode.c
  Show/Hide comments   View file @e69a754
... ... @@ -105,7 +105,7 @@ static Expr get_mvar_slots_del_instr(Expr type, Expr env)
105 105 regardless of T.
106 106 */
107 107 Expr get_del_code_addr(Expr type,
108   - Expr env)
  108 + Expr env)
109 109 {
110 110 int i;
111 111  
... ... @@ -132,7 +132,7 @@ Expr get_del_code_addr(Expr type,
132 132 for (i = 0; i < next_del_code; i++)
133 133 {
134 134 if (same_type(type,env,del_codes[i].type,del_codes[i].env))
135   - return del_codes[i].addr;
  135 + return del_codes[i].addr;
136 136 }
137 137  
138 138 /* The delete code has not yet been computed */
... ... @@ -273,66 +273,66 @@ Expr get_del_code_addr(Expr type,
273 273  
274 274 else
275 275 {
276   - Expr alts = cdr3(implem);
277   - Expr case_addrs = nil;
278   - Expr aux;
279   - Expr result = nil;
280   - Expr alts_codes = nil;
281   -
282   - /* get a list of addresses for cases */
283   - aux = alts;
284   - while (consp(aux))
285   - {
286   - case_addrs = cons(new_addr_name(labs_none,0),case_addrs);
287   - aux = cdr(aux);
288   - }
289   -
290   - /* get the codes for alternatives */
291   - while (consp(alts))
292   - {
293   - alts_codes = cons(alt_del_code(car(alts),
294   - env),
295   - alts_codes);
296   - alts = cdr(alts);
297   - }
298   -
299   - /* record codes for alternatives with their labels */
300   - aux = case_addrs;
301   - while (consp(alts_codes))
302   - {
303   - result = cons(cons(label,car(aux)),append(car(alts_codes),result));
304   - alts_codes = cdr(alts_codes);
305   - aux = cdr(aux);
306   - }
307   -
308   - /* add a switch */
309   - result = cons(cons(_switch,reverse(case_addrs)),result);
310   -
311   - /* add the 'index' instruction */
312   - if (type_sort == large_type)
313   - {
314   - result = cons(del_index_indirect,result);
315   - }
316   - else
317   - {
318   - result = cons(del_index_direct,result);
319   - }
  276 + Expr alts = cdr3(implem);
  277 + Expr case_addrs = nil;
  278 + Expr aux;
  279 + Expr result = nil;
  280 + Expr alts_codes = nil;
  281 +
  282 + /* get a list of addresses for cases */
  283 + aux = alts;
  284 + while (consp(aux))
  285 + {
  286 + case_addrs = cons(new_addr_name(labs_none,0),case_addrs);
  287 + aux = cdr(aux);
  288 + }
  289 +
  290 + /* get the codes for alternatives */
  291 + while (consp(alts))
  292 + {
  293 + alts_codes = cons(alt_del_code(car(alts),
  294 + env),
  295 + alts_codes);
  296 + alts = cdr(alts);
  297 + }
  298 +
  299 + /* record codes for alternatives with their labels */
  300 + aux = case_addrs;
  301 + while (consp(alts_codes))
  302 + {
  303 + result = cons(cons(label,car(aux)),append(car(alts_codes),result));
  304 + alts_codes = cdr(alts_codes);
  305 + aux = cdr(aux);
  306 + }
  307 +
  308 + /* add a switch */
  309 + result = cons(cons(_switch,reverse(case_addrs)),result);
  310 +
  311 + /* add the 'index' instruction */
  312 + if (type_sort == large_type)
  313 + {
  314 + result = cons(del_index_indirect,result);
  315 + }
  316 + else
  317 + {
  318 + result = cons(del_index_direct,result);
  319 + }
320 320  
321 321 /* if deleting a monitoring ticket insert a 'remove_monitor' */
322 322 if (consp(type) && car(type) == app_ts && second(type) == pdstr_MonitoringTicket)
323 323 result = cons(remove_monitor,
324 324 result);
325 325  
326   - /* add the label of the subroutine */
327   - result = mcons4(cons(header,new_string("* * * deletion code * * *")),
328   - cons(label,del_codes[i].addr),
329   - mcons3(context,list2(cons(argument,type),
330   - cons(ret,new_integer(1))),
331   - env),
332   - result);
333   -
334   - /* store the offline code */
335   - del_codes[i].offline_code = save(result);
  326 + /* add the label of the subroutine */
  327 + result = mcons4(cons(header,new_string("* * * deletion code * * *")),
  328 + cons(label,del_codes[i].addr),
  329 + mcons3(context,list2(cons(argument,type),
  330 + cons(ret,new_integer(1))),
  331 + env),
  332 + result);
  333 +
  334 + /* store the offline code */
  335 + del_codes[i].offline_code = save(result);
336 336 }
337 337  
338 338 /* return address of deletion code */
... ... @@ -383,33 +383,33 @@ Expr component_del_code(int id)
383 383 case type_WAddr:
384 384 case type_RWAddr:
385 385 return list1(indirect_del_conn);
386   - break;
  386 + break;
387 387 case type_Var:
388   - {
389   - Expr del_code_addr = get_del_code_addr(implems[id].type,implems[id].env);
  388 + {
  389 + Expr del_code_addr = get_del_code_addr(implems[id].type,implems[id].env);
390 390 /* del_code_addr is the address of deletion code for type 'Var(T)', not for type
391 391 'T'. It is never 'nil'. */
392   - assert(del_code_addr != nil);
  392 + assert(del_code_addr != nil);
393 393 return list1(cons(indirect_del_var,del_code_addr));
394   - }
395   - break;
  394 + }
  395 + break;
396 396  
397 397 case type_MVar:
398   - {
  398 + {
399 399 /* del_code_addr is the address of deletion code for type 'MVar(T)', not for
400 400 type 'T'. It is never 'nil'. */
401   - Expr del_code_addr = get_del_code_addr(implems[id].type,implems[id].env);
402   - assert(del_code_addr != nil);
  401 + Expr del_code_addr = get_del_code_addr(implems[id].type,implems[id].env);
  402 + assert(del_code_addr != nil);
403 403 return list1(cons(indirect_del_mvar,del_code_addr));
404   - }
405   - break;
  404 + }
  405 + break;
406 406  
407 407 case type_GAddr:
408   - return nil;
409   - break;
  408 + return nil;
  409 + break;
410 410  
411 411 default:
412   - assert(0);
  412 + assert(0);
413 413 }
414 414  
415 415 if (is_struct_ptr_type(implem))
... ... @@ -425,17 +425,17 @@ Expr component_del_code(int id)
425 425  
426 426 case large_type:
427 427 {
428   - /* we have to delete virtually the datum whose manipulation word is pointed to
429   - from the top of stack. This word is a pointer, except in the mixed case, where
430   - it may be a manipulation word of a small datum, or a pointer glued to an index.
431   - We use a indirect_del or indirect_del_mixed instruction. */
432   - return list1(cons(indirect_del,
  428 + /* we have to delete virtually the datum whose manipulation word is pointed to
  429 + from the top of stack. This word is a pointer, except in the mixed case, where
  430 + it may be a manipulation word of a small datum, or a pointer glued to an index.
  431 + We use a indirect_del or indirect_del_mixed instruction. */
  432 + return list1(cons(indirect_del,
433 433 get_del_code_addr(implems[id].type,implems[id].env)));
434 434 }
435 435 case mixed_type:
436 436 return list1(mcons3(indirect_del_mixed,
437   - mixed_copy_mask(implem),
438   - get_del_code_addr(implems[id].type,implems[id].env)));
  437 + mixed_copy_mask(implem),
  438 + get_del_code_addr(implems[id].type,implems[id].env)));
439 439  
440 440 default:
441 441 assert(0);
... ... @@ -448,7 +448,7 @@ Expr component_del_code(int id)
448 448  
449 449 /* Making the deletion code for an alternative */
450 450 static Expr alt_del_code(Expr alt_implem,
451   - Expr env)
  451 + Expr env)
452 452 {
453 453 int code_offset = 5;
454 454  
... ... @@ -460,23 +460,23 @@ static Expr alt_del_code(Expr alt_implem,
460 460 code_offset--;
461 461 case large_alt:
462 462 {
463   - /* get geometry of components in reverse order */
464   - Expr geoms = reverse(cdr(alt_implem));
465   - /* each geometry has the form: (<imp> <offset> . <width>) */
  463 + /* get geometry of components in reverse order */
  464 + Expr geoms = reverse(cdr(alt_implem));
  465 + /* each geometry has the form: (<imp> <offset> . <width>) */
466 466  
467   - Expr result = list3(free_seg_1,
  467 + Expr result = list3(free_seg_1,
468 468 pop2,
469 469 cons(ret,new_integer(1)));
470   - Expr prevw;
  470 + Expr prevw;
471 471  
472   - while (consp(geoms))
473   - {
  472 + while (consp(geoms))
  473 + {
474 474 Expr util;
475 475  
476   - if (!consp(cdr(geoms)))
477   - prevw = new_integer(code_offset);
478   - else
479   - prevw = cdr2(car(cdr(geoms)));
  476 + if (!consp(cdr(geoms)))
  477 + prevw = new_integer(code_offset);
  478 + else
  479 + prevw = cdr2(car(cdr(geoms)));
480 480  
481 481 util = append(component_del_code(integer_value(car(car(geoms)))),
482 482 result);
... ... @@ -487,11 +487,11 @@ static Expr alt_del_code(Expr alt_implem,
487 487 else
488 488 result = util;
489 489  
490   - geoms = cdr(geoms);
491   - }
  490 + geoms = cdr(geoms);
  491 + }
492 492  
493 493  
494   - return result;
  494 + return result;
495 495 }
496 496 default:
497 497 assert(0);
... ...
anubis_dev/compiler/src/destruct.c
  Show/Hide comments   View file @e69a754
... ... @@ -53,11 +53,11 @@ operation U d(T _) =
53 53 while(consp(dests))
54 54 {
55 55 make_1_destructor(second(type_def), /* lc */
56   - third(type_def), /* T */
57   - forth(type_def), /* parms of scheme */
58   - cdr4(type_def), /* alternatives */
59   - car(car(dests)), /* U */
60   - cdr(car(dests)), /* d */
  56 + third(type_def), /* T */
  57 + forth(type_def), /* parms of scheme */
  58 + cdr4(type_def), /* alternatives */
  59 + car(car(dests)), /* U */
  60 + cdr(car(dests)), /* d */
61 61 public,
62 62 tid);
63 63 dests = cdr(dests);
... ... @@ -82,7 +82,7 @@ static void make_1_destructor(Expr lc,
82 82 {
83 83 max_operation += 500;
84 84 operations = (struct Operation_struct *)reallocz(operations,
85   - max_operation*sizeof(struct Operation_struct));
  85 + max_operation*sizeof(struct Operation_struct));
86 86 }
87 87 operations[next_operation].names = list1(d);
88 88 operations[next_operation].file_name = new_string(source_file_name);
... ... @@ -106,7 +106,7 @@ static void make_1_destructor(Expr lc,
106 106 if (verbose && strcmp(source_file_name,"predefined.anubis"))
107 107 {
108 108 printf(msgtext_made_destructor[language],
109   - string_content(d));
  109 + string_content(d));
110 110 show_type(stdout,source_type,nil);
111 111 printf(".\n");
112 112  
... ... @@ -117,8 +117,8 @@ static void make_1_destructor(Expr lc,
117 117 show_type(stdout,source_type,nil);
118 118 printf(" _\n ) =\n ");
119 119 show_interpretation(stdout,
120   - operations[next_operation].definition,
121   - nil);
  120 + operations[next_operation].definition,
  121 + nil);
122 122 printf(".\n\n");
123 123 */
124 124  
... ... @@ -131,8 +131,8 @@ static void make_1_destructor(Expr lc,
131 131  
132 132  
133 133 static Expr make_cases(Expr alts,
134   - Expr d,
135   - Expr U)
  134 + Expr d,
  135 + Expr U)
136 136 {
137 137 /* compute the list of cases:
138 138  
... ... @@ -147,14 +147,14 @@ static Expr make_cases(Expr alts,
147 147 {
148 148 /* each case has the form:
149 149  
150   - ((<name> (<var> . <type>) ...) <lc> local "d" i . U)
  150 + ((<name> (<var> . <type>) ...) <lc> local "d" i . U)
151 151  
152 152 <name> may be taken as the first name of alternative, each
153   - (<var> . <type>) corresponds to a (<type> . <sym>), with
154   - <var> == "£" if <sym> == noname. <lc> may be 0. i is the
155   - depth of d in the stack in the case body. It is the length of
156   - the tail ((<type> . <sym>) ...) which comes just after the
157   - pair (<type> . d). */
  153 + (<var> . <type>) corresponds to a (<type> . <sym>), with
  154 + <var> == "£" if <sym> == noname. <lc> may be 0. i is the
  155 + depth of d in the stack in the case body. It is the length of
  156 + the tail ((<type> . <sym>) ...) which comes just after the
  157 + pair (<type> . d). */
158 158  
159 159 Expr alt = car(alts); /* ((<name> ...) (<type> . <sym>) ...) */
160 160 Expr c = car(car(alt));
... ... @@ -163,27 +163,27 @@ static Expr make_cases(Expr alts,
163 163  
164 164 alt = cdr(alt);
165 165 while(consp(alt))
166   - {
167   - /* collect resurgent variables and their types */
168   - Expr sym = cdr(car(alt));
169   - case_head = cons(cons(sym == noname
170   - ?
171   - pdstr_pound /* "£" */
172   - :
173   - sym,
174   - car(car(alt))),
175   - case_head);
176   - if (sym == d)
177   - i = length(cdr(alt)); /* this will be the last occurence
178   - of 'd' amongh resurgent variables */
179   - alt = cdr(alt);
180   - }
  166 + {
  167 + /* collect resurgent variables and their types */
  168 + Expr sym = cdr(car(alt));
  169 + case_head = cons(cons(sym == noname
  170 + ?
  171 + pdstr_pound /* "£" */
  172 + :
  173 + sym,
  174 + car(car(alt))),
  175 + case_head);
  176 + if (sym == d)
  177 + i = length(cdr(alt)); /* this will be the last occurence
  178 + of 'd' amongh resurgent variables */
  179 + alt = cdr(alt);
  180 + }
181 181 case_head = cons(c,hard_reverse(case_head));
182 182  
183 183 result = cons(mcons3(case_head,
184   - new_integer(0),
185   - mcons4(local,d,new_integer(i),U)),
186   - result);
  184 + new_integer(0),
  185 + mcons4(local,d,new_integer(i),U)),
  186 + result);
187 187 alts = cdr(alts);
188 188 }
189 189 return hard_reverse(result);
... ... @@ -203,11 +203,11 @@ static Expr get_dests(Expr alts)
203 203 {
204 204 /* all explicitly named operands are destructors */
205 205 while(consp(first))
206   - {
207   - if (cdr(car(first)) != noname)
208   - result = cons(car(first),result);
209   - first = cdr(first);
210   - }
  206 + {
  207 + if (cdr(car(first)) != noname)
  208 + result = cons(car(first),result);
  209 + first = cdr(first);
  210 + }
211 211 }
212 212 else /* at least two alternatives */
213 213 {
... ... @@ -219,8 +219,8 @@ static Expr get_dests(Expr alts)
219 219 while(consp(first))
220 220 {
221 221 if (member(car(first),others))
222   - result = cons(car(first),result);
223   - first = cdr(first);
  222 + result = cons(car(first),result);
  223 + first = cdr(first);
224 224 }
225 225 }
226 226 return result;
... ... @@ -233,7 +233,7 @@ int has_parameters(Expr alts)
233 233 while (consp(alts))
234 234 {
235 235 if (is_user_type_variable(car(alts)))
236   - return 1;
  236 + return 1;
237 237 alts = cdr(alts);
238 238 }
239 239 return 0;
... ...
anubis_dev/compiler/src/determin.c
  Show/Hide comments   View file @e69a754
... ... @@ -124,58 +124,58 @@ static int is_deterministic(Expr head,
124 124  
125 125 case local:
126 126 case string:
127   - case int32:
  127 + case anb_int32:
128 128 case small_datum:
129 129 case fpnum:
130 130 case constructor:
131 131 case operation:
132 132 {
133   - /* local variables and strings are always deterministic */
134   - return 1;
  133 + /* local variables and strings are always deterministic */
  134 + return 1;
135 135 }
136 136 break;
137 137  
138 138 case app: /* (app <lc> <op int head> . <int heads>) */
139 139 {
140   - /* function and operands should be deterministic */
141   - head = cdr(cdr(head));
142   - if (!is_deterministic_function(car(head),env))
143   - return 0;
144   - head = cdr(head);
145   - while(consp(head))
146   - {
147   - if (!is_deterministic(car(head),env))
148   - return 0;
149   - head = cdr(head);
150   - }
151   - return 1;
  140 + /* function and operands should be deterministic */
  141 + head = cdr(cdr(head));
  142 + if (!is_deterministic_function(car(head),env))
  143 + return 0;
  144 + head = cdr(head);
  145 + while(consp(head))
  146 + {
  147 + if (!is_deterministic(car(head),env))
  148 + return 0;
  149 + head = cdr(head);
  150 + }
  151 + return 1;
152 152 }
153 153 break;
154 154  
155 155 case with:
156 156 {
157   - /* (with <lc> <symbol> <int head> . <int head>) */
158   - return is_deterministic(forth(head),env)
159   - && is_deterministic(cdr4(head),env);
  157 + /* (with <lc> <symbol> <int head> . <int head>) */
  158 + return is_deterministic(forth(head),env)
  159 + && is_deterministic(cdr4(head),env);
160 160 }
161 161 break;
162 162  
163 163 case cond: /* (cond <lc> <int head> (<clause head> <lc> . <int
164   - head>) ...), where <clause head> may also be
165   - 'else_case' for the last one) */
  164 + head>) ...), where <clause head> may also be
  165 + 'else_case' for the last one) */
166 166 {
167   - /* test and bodies should be deterministic */
168   - head = cdr(cdr(head));
169   - if (!is_deterministic(car(head),env))
170   - return 0;
171   - head = cdr(head);
172   - while(consp(head))
173   - {
  167 + /* test and bodies should be deterministic */
  168 + head = cdr(cdr(head));
  169 + if (!is_deterministic(car(head),env))
  170 + return 0;
  171 + head = cdr(head);
  172 + while(consp(head))
  173 + {
174 174 if (!is_deterministic(cdr(cdr(car(head))),env))
175   - return 0;
176   - head = cdr(head);
177   - }
178   - return 1;
  175 + return 0;
  176 + head = cdr(head);
  177 + }
  178 + return 1;
179 179 }
180 180 break;
181 181  
... ... @@ -183,8 +183,8 @@ static int is_deterministic(Expr head,
183 183 /* (select_cond_interp <lc> <test head> <index> <clause head> <head then> . <head else>) */
184 184 head = cdr2(head);
185 185 return ( is_deterministic(car(head),env) &&
186   - is_deterministic(forth(head),env) &&
187   - is_deterministic(cdr4(head),env) );
  186 + is_deterministic(forth(head),env) &&
  187 + is_deterministic(cdr4(head),env) );
188 188 break;
189 189  
190 190 case anb_read:
... ... @@ -194,8 +194,8 @@ static int is_deterministic(Expr head,
194 194 case connect_file_RW:
195 195 case connect_IP_RW:
196 196 {
197   - /* i/o are (by definition) non deterministic */
198   - return 0;
  197 + /* i/o are (by definition) non deterministic */
  198 + return 0;
199 199 }
200 200 break;
201 201  
... ... @@ -229,17 +229,17 @@ static int is_deterministic_function(Expr head, Expr env)
229 229  
230 230 case local: /* (local <name> <i> . <type>) */
231 231 {
232   - head = cdr3(head); /* <type> */
233   - if (car(head) == functype)
234   - return 1;
235   - else
236   - return 0;
  232 + head = cdr3(head); /* <type> */
  233 + if (car(head) == functype)
  234 + return 1;
  235 + else
  236 + return 0;
237 237 }
238 238 break;
239 239  
240 240 case operation: /* (operation <lc> <id> <name> <parms> <type> . <types>) */
241 241 {
242   - return operations[integer_value(third(head))].deterministic;
  242 + return operations[integer_value(third(head))].deterministic;
243 243 }
244 244 break;
245 245  
... ... @@ -269,16 +269,16 @@ void find_determinism(void)
269 269 change = 0;
270 270 for (i = 0; i < next_operation; i++)
271 271 {
272   - if (operations[i].deterministic
273   - &&
274   - operations[i].definition != no_term
275   - &&
276   - !is_deterministic(operations[i].definition,
277   - nil))
278   - {
279   - change = 1;
280   - operations[i].deterministic = 0;
281   - }
  272 + if (operations[i].deterministic
  273 + &&
  274 + operations[i].definition != no_term
  275 + &&
  276 + !is_deterministic(operations[i].definition,
  277 + nil))
  278 + {
  279 + change = 1;
  280 + operations[i].deterministic = 0;
  281 + }
282 282 }
283 283 }
284 284 while (change);
... ... @@ -286,14 +286,14 @@ void find_determinism(void)
286 286 if (verbose && par_seen)
287 287 for (i = 0; i < next_operation; i++)
288 288 {
289   - if (operations[i].line != 0)
290   - printf(" '%s' (%s)\n",
291   - string_content(car(operations[i].names)),
292   - operations[i].deterministic
293   - ?
294   - msgtext_deterministic[language]
295   - :
296   - msgtext_non_deterministic[language]);
  289 + if (operations[i].line != 0)
  290 + printf(" '%s' (%s)\n",
  291 + string_content(car(operations[i].names)),
  292 + operations[i].deterministic
  293 + ?
  294 + msgtext_deterministic[language]
  295 + :
  296 + msgtext_non_deterministic[language]);
297 297 }
298 298 }
299 299  
... ...
anubis_dev/compiler/src/dlm.c
  Show/Hide comments   View file @e69a754
... ... @@ -278,8 +278,8 @@ void dump_dlm(int iid)
278 278  
279 279 /* translate offline symbolic code */
280 280 translation = translate_dynamic_code(sym_code,
281   - start_label,
282   - compiled_ops[iid].sha1_digest,
  281 + start_label,
  282 + compiled_ops[iid].sha1_digest,
283 283 initialization_address_value);
284 284  
285 285 /* compute checksum */
... ... @@ -297,8 +297,8 @@ void dump_dlm(int iid)
297 297 sprintf(buf,"%s.sc",opname);
298 298 symfile = fopenz(buf,"wt");
299 299 fprintf(symfile,
300   - "\n This file was generated by the Anubis compiler (version 1.%d)\n\n",
301   - min_version);
  300 + "\n This file was generated by the Anubis compiler (version 1.%d)\n\n",
  301 + min_version);
302 302 fprintf(symfile,
303 303 " Symbolic code for module '%s.%s'\n\n",opname,module_ext);
304 304 fprintf(symfile,
... ... @@ -308,7 +308,7 @@ void dump_dlm(int iid)
308 308 " starting point at offset: %u (executing '%s' from file '%s' at line %u)\n"
309 309 " module identification: %s\n",
310 310 *((U32 *)(translation+4)),
311   - (ta->tm_year)+1900,
  311 + (ta->tm_year)+1900,
312 312 (ta->tm_mon)+1,
313 313 ta->tm_mday,
314 314 ta->tm_hour,
... ... @@ -317,13 +317,13 @@ void dump_dlm(int iid)
317 317 ((*((U32 *)(translation+4+4))) & mf_using_ssl) ? "yes" : "no",
318 318 *((U32 *)(translation+4+4+4)),
319 319 *((U32 *)(translation+4+4+4+4)),
320   - opname,
  320 + opname,
321 321 string_content(operations[compiled_ops[iid].op_id].file_name),
322   - integer_value(operations[compiled_ops[iid].op_id].line),
323   - sha1_to_ascii(translation+4+4+4+4+4));
  322 + integer_value(operations[compiled_ops[iid].op_id].line),
  323 + sha1_to_ascii(translation+4+4+4+4+4));
324 324 fprintf(symfile,
325 325 " module checksum: %s\n\n",
326   - sha1_to_ascii(checksum));
  326 + sha1_to_ascii(checksum));
327 327 fprintf(symfile,
328 328 " offsets | symbolic code\n"
329 329 "---------|--------------------------------------------------------");
... ... @@ -338,7 +338,7 @@ void dump_dlm(int iid)
338 338 {
339 339 sprintf(buf,"%s/%s", my_shells_directory, opname);
340 340 #ifdef WIN32
341   - strcat(buf,".bat");
  341 + strcat(buf,".bat");
342 342 #endif
343 343 shell_file = fopenz(buf,"wt");
344 344 fprintf(shell_file,"anbexec %s/modules/%s.adm --pdir:%s $*\n",
... ... @@ -380,7 +380,7 @@ void dump_dlm(int iid)
380 380 "\n| size of code: %u"
381 381 "\n| starting point: %u"
382 382 "\n| identification: %s",
383   - buf,
  383 + buf,
384 384 get_maj_version(*((U32 *)translation)),
385 385 get_min_version(*((U32 *)translation)),
386 386 get_rel_version(*((U32 *)translation)),
... ... @@ -388,10 +388,10 @@ void dump_dlm(int iid)
388 388 ((*((U32 *)(translation+4+4))) & mf_using_ssl) ? "yes" : "no",
389 389 *((U32 *)(translation+4+4+4)),
390 390 *((U32 *)(translation+4+4+4+4)),
391   - sha1_to_ascii(translation+4+4+4+4+4));
  391 + sha1_to_ascii(translation+4+4+4+4+4));
392 392 printf("\n| checksum: %s"
393 393 "\n|__________________\n",
394   - sha1_to_ascii(checksum));
  394 + sha1_to_ascii(checksum));
395 395 }
396 396 freez(buf);
397 397 }
... ...
anubis_dev/compiler/src/dumpct.c
  Show/Hide comments   View file @e69a754
... ... @@ -14,8 +14,8 @@ Expr C_constr_types_list = nil;
14 14  
15 15 void make_C_constr(Expr lc,
16 16 Expr file_name,
17   - Expr new_name,
18   - Expr type)
  17 + Expr new_name,
  18 + Expr type)
19 19 {
20 20 Expr implem;
21 21  
... ... @@ -97,9 +97,9 @@ void dump_C_types(void)
97 97 aux = cdr(aux);
98 98  
99 99 if(verbose)
100   - {
101   - printf("Dumping constructors in C for '%s' ",type_name);
102   - }
  100 + {
  101 + printf("Dumping constructors in C for '%s' ",type_name);
  102 + }
103 103  
104 104 fprintf(h_target,"/* constructors for type '");
105 105 show_type(h_target,type,nil);
... ... @@ -112,68 +112,68 @@ void dump_C_types(void)
112 112 }
113 113  
114 114 switch (car(implem))
115   - {
116   - case small_type:
117   - {
118   - if (verbose) printf("(small type).\n");
  115 + {
  116 + case small_type:
  117 + {
  118 + if (verbose) printf("(small type).\n");
119 119  
120   - /* implem = (small_type <nalt> <iw> <alt geom> ...) */
121   - /* alts_implems = (<alt geom> ...) */
  120 + /* implem = (small_type <nalt> <iw> <alt geom> ...) */
  121 + /* alts_implems = (<alt geom> ...) */
122 122 /* <alt geom> = (small_type (<imp> <offset> . <width>) ...) */
123 123 /* alts = ((("name" ...) (type . sym) ...) ...) */
124   - while (consp(alts_implems))
125   - {
126   - int k;
127   - Expr aux2;
  124 + while (consp(alts_implems))
  125 + {
  126 + int k;
  127 + Expr aux2;
128 128 Expr alt_name = car(car(car(alts)));
129   - Expr geom = cdr(car(alts_implems));
130   - /* geom = ((<imp> <offset> . <width>) ...) */
  129 + Expr geom = cdr(car(alts_implems));
  130 + /* geom = ((<imp> <offset> . <width>) ...) */
131 131  
132   - alts_implems = cdr(alts_implems);
  132 + alts_implems = cdr(alts_implems);
133 133 alts = cdr(alts);
134 134  
135   - fprintf(h_target,
136   - "\n#define %s%s",
137   - type_name,
  135 + fprintf(h_target,
  136 + "\n#define %s%s",
  137 + type_name,
138 138 regular_string_content(alt_name));
139 139  
140   - if (consp(geom)) fprintf(h_target,"(");
141   -
142   - k = 1;
143   - aux2 = geom;
144   - while (consp(aux2))
145   - {
146   - fprintf(h_target,"_%d",k++);
147   - aux2 = cdr(aux2);
148   - if (consp(aux2)) fprintf(h_target,",");
149   - }
150   - if (k >= 2) fprintf(h_target,")");
151   - fprintf(h_target," (%d",ind);
152   -
153   - k = 1;
154   - while(consp(geom))
155   - {
156   - fprintf(h_target,"|((_%d)<<%d)",k++,integer_value(second(car(geom))));
157   - geom = cdr(geom);
158   - }
159   - fprintf(h_target,")\n");
160   - ind++; /* next alternative index */
161   - }
162   - }
163   - break;
164   -
165   - case mixed_type:
166   - case large_type:
167   - {
168   - if (verbose)
169   - {
170   - if (car(implem) == large_type)
171   - printf("(large type).\n");
172   - else
173   - printf("(mixed type)).\n");
174   - }
175   -
176   - fprintf(c_target,"/*********** constructors for type '");
  140 + if (consp(geom)) fprintf(h_target,"(");
  141 +
  142 + k = 1;
  143 + aux2 = geom;
  144 + while (consp(aux2))
  145 + {
  146 + fprintf(h_target,"_%d",k++);
  147 + aux2 = cdr(aux2);
  148 + if (consp(aux2)) fprintf(h_target,",");
  149 + }
  150 + if (k >= 2) fprintf(h_target,")");
  151 + fprintf(h_target," (%d",ind);
  152 +
  153 + k = 1;
  154 + while(consp(geom))
  155 + {
  156 + fprintf(h_target,"|((_%d)<<%d)",k++,integer_value(second(car(geom))));
  157 + geom = cdr(geom);
  158 + }
  159 + fprintf(h_target,")\n");
  160 + ind++; /* next alternative index */
  161 + }
  162 + }
  163 + break;
  164 +
  165 + case mixed_type:
  166 + case large_type:
  167 + {
  168 + if (verbose)
  169 + {
  170 + if (car(implem) == large_type)
  171 + printf("(large type).\n");
  172 + else
  173 + printf("(mixed type)).\n");
  174 + }
  175 +
  176 + fprintf(c_target,"/*********** constructors for type '");
177 177 show_type(c_target,type,nil);
178 178 fprintf(c_target,"' ************/\n\n");
179 179 if (dcti)
... ... @@ -185,167 +185,167 @@ void dump_C_types(void)
185 185  
186 186  
187 187  
188   - while (consp(alts_implems))
189   - {
190   - int k;
191   - int n, d;
192   - Expr aux;
  188 + while (consp(alts_implems))
  189 + {
  190 + int k;
  191 + int n, d;
  192 + Expr aux;
193 193 Expr alt_name = car(car(car(alts)));
194   - Expr alt_sort = car(car(alts_implems));
195   - Expr geom = cdr(car(alts_implems));
  194 + Expr alt_sort = car(car(alts_implems));
  195 + Expr geom = cdr(car(alts_implems));
196 196  
197   - alts_implems = cdr(alts_implems);
  197 + alts_implems = cdr(alts_implems);
198 198 alts = cdr(alts);
199 199  
200   - /* alt_sort may be small_alt or mixed_alt for mixed
201   - types, and large_alt for large types. */
202   -
203   - if (alt_sort == small_alt)
204   - {
205   - int k;
206   - Expr aux2;
207   - /* geom = ((<imp> <offset> . <width>) ...) */
208   -
209   - fprintf(h_target,
210   - "\n#define %s%s",
211   - type_name,
212   - regular_string_content(alt_name));
213   -
214   - if (consp(geom)) fprintf(h_target,"(");
215   -
216   - k = 1;
217   - aux2 = geom;
218   - while (consp(aux2))
219   - {
220   - fprintf(h_target,"_%d",k++);
221   - aux2 = cdr(aux2);
222   - if (consp(aux2)) fprintf(h_target,",");
223   - }
224   - if (k >= 2) fprintf(h_target,")");
225   - fprintf(h_target," (%d",ind);
226   -
227   - k = 1;
228   - while(consp(geom))
229   - {
230   - fprintf(h_target,"|((_%d)<<%d)",k++,integer_value(second(car(geom))));
231   - geom = cdr(geom);
232   - }
233   - fprintf(h_target,")\n");
234   -
235   - }
236   - else /* large or mixed alt */
237   - {
238   - /* compute the size to allocate */
239   - aux = geom;
240   - n = d = 4;
241   - if (car(implem) == large_type) { n++; d++; }
242   - while (consp(aux))
243   - {
244   - n += integer_value(cdr2(car(aux)));
245   - aux = cdr(aux);
246   - }
247   -
248   - /* convert n (bytes) into a number of words (4 bytes) */
249   - while (n&3) n++;
250   - n >>= 2;
  200 + /* alt_sort may be small_alt or mixed_alt for mixed
  201 + types, and large_alt for large types. */
  202 +
  203 + if (alt_sort == small_alt)
  204 + {
  205 + int k;
  206 + Expr aux2;
  207 + /* geom = ((<imp> <offset> . <width>) ...) */
  208 +
  209 + fprintf(h_target,
  210 + "\n#define %s%s",
  211 + type_name,
  212 + regular_string_content(alt_name));
  213 +
  214 + if (consp(geom)) fprintf(h_target,"(");
  215 +
  216 + k = 1;
  217 + aux2 = geom;
  218 + while (consp(aux2))
  219 + {
  220 + fprintf(h_target,"_%d",k++);
  221 + aux2 = cdr(aux2);
  222 + if (consp(aux2)) fprintf(h_target,",");
  223 + }
  224 + if (k >= 2) fprintf(h_target,")");
  225 + fprintf(h_target," (%d",ind);
  226 +
  227 + k = 1;
  228 + while(consp(geom))
  229 + {
  230 + fprintf(h_target,"|((_%d)<<%d)",k++,integer_value(second(car(geom))));
  231 + geom = cdr(geom);
  232 + }
  233 + fprintf(h_target,")\n");
  234 +
  235 + }
  236 + else /* large or mixed alt */
  237 + {
  238 + /* compute the size to allocate */
  239 + aux = geom;
  240 + n = d = 4;
  241 + if (car(implem) == large_type) { n++; d++; }
  242 + while (consp(aux))
  243 + {
  244 + n += integer_value(cdr2(car(aux)));
  245 + aux = cdr(aux);
  246 + }
  247 +
  248 + /* convert n (bytes) into a number of words (4 bytes) */
  249 + while (n&3) n++;
  250 + n >>= 2;
251 251  
252 252 fprintf(h_target,
253 253 "\n#define %s%s(",
254 254 type_name,
255 255 regular_string_content(alt_name));
256 256  
257   - k = 1;
258   - aux = geom;
259   - while (consp(aux))
260   - {
261   - fprintf(h_target,"%s_%d",k==1 ? "":",", k);
262   - k++;
263   - aux = cdr(aux);
264   - }
265   - fprintf(h_target,")\\\n");
  257 + k = 1;
  258 + aux = geom;
  259 + while (consp(aux))
  260 + {
  261 + fprintf(h_target,"%s_%d",k==1 ? "":",", k);
  262 + k++;
  263 + aux = cdr(aux);
  264 + }
  265 + fprintf(h_target,")\\\n");
266 266  
267 267 fprintf(h_target,
268 268 " (_%s%s(allocator",
269 269 type_name,
270 270 regular_string_content(alt_name));
271 271  
272   - k = 1;
273   - aux = geom;
274   - while (consp(aux))
275   - {
276   - fprintf(h_target,",_%d", k);
277   - k++;
278   - aux = cdr(aux);
279   - }
280   - fprintf(h_target,"))\n");
  272 + k = 1;
  273 + aux = geom;
  274 + while (consp(aux))
  275 + {
  276 + fprintf(h_target,",_%d", k);
  277 + k++;
  278 + aux = cdr(aux);
  279 + }
  280 + fprintf(h_target,"))\n");
281 281  
282   - fprintf(h_target,
283   - "\nextern U32 _%s%s(Allocator dct_allocator",
284   - type_name,
285   - regular_string_content(alt_name));
286   - fprintf(c_target,
287   - "\nU32 _%s%s(Allocator dct_allocator",
288   - type_name,
289   - regular_string_content(alt_name));
290   -
291   - k = 1;
292   - aux = geom;
293   - while (consp(aux))
294   - {
295   - fprintf(h_target,",U32 _%d",k);
296   - fprintf(c_target,",U32 _%d",k);
297   - k++;
298   - aux = cdr(aux);
299   - }
300   - fprintf(h_target,"); \n");
301   - fprintf(c_target,")\n"
302   - "{\n"
303   - " U32 result;\n"
304   - "\n"
305   - " /* allocate %d words (= %d bytes) */\n"
306   - " if ((result = allocate_data_segment(%d,dct_allocator)) == 0)\n",
307   - n,4*n,n);
308   - fprintf(c_target,
309   - " {\n"
310   - " if (!enlarge_memory(dct_allocator) ||\n"
  282 + fprintf(h_target,
  283 + "\nextern U32 _%s%s(Allocator dct_allocator",
  284 + type_name,
  285 + regular_string_content(alt_name));
  286 + fprintf(c_target,
  287 + "\nU32 _%s%s(Allocator dct_allocator",
  288 + type_name,
  289 + regular_string_content(alt_name));
  290 +
  291 + k = 1;
  292 + aux = geom;
  293 + while (consp(aux))
  294 + {
  295 + fprintf(h_target,",U32 _%d",k);
  296 + fprintf(c_target,",U32 _%d",k);
  297 + k++;
  298 + aux = cdr(aux);
  299 + }
  300 + fprintf(h_target,"); \n");
  301 + fprintf(c_target,")\n"
  302 + "{\n"
  303 + " U32 result;\n"
  304 + "\n"
  305 + " /* allocate %d words (= %d bytes) */\n"
  306 + " if ((result = allocate_data_segment(%d,dct_allocator)) == 0)\n",
  307 + n,4*n,n);
  308 + fprintf(c_target,
  309 + " {\n"
  310 + " if (!enlarge_memory(dct_allocator) ||\n"
311 311 " (result = allocate_data_segment(%d,dct_allocator)) == 0)\n"
312 312 " { dct_error_flag = 1; return 0; }\n"
313   - " }\n",n);
314   -
315   - if (car(implem) == large_type)
316   - fprintf(c_target,
317   - " *(((U8 *)result)+4) = %d;\n",
318   - ind);
319   -
320   - aux = geom;
321   - k = 1;
322   - while (consp(aux))
323   - {
324   - int w = cdr2(car(aux)) == new_integer(0) ? 0 :
  313 + " }\n",n);
  314 +
  315 + if (car(implem) == large_type)
  316 + fprintf(c_target,
  317 + " *(((U8 *)result)+4) = %d;\n",
  318 + ind);
  319 +
  320 + aux = geom;
  321 + k = 1;
  322 + while (consp(aux))
  323 + {
  324 + int w = cdr2(car(aux)) == new_integer(0) ? 0 :
325 325 cdr2(car(aux)) == new_integer(1) ? 8 :
326   - cdr2(car(aux)) == new_integer(2) ? 16 : 32;
327   - fprintf(c_target,
328   - " *((U%d *)(((U8 *)result)+%d)) = (U%d)_%d;\n",
329   - w,
330   - d + integer_value(second(car(aux))),
331   - w,
332   - k);
333   - k++;
334   - aux = cdr(aux);
335   - }
336   -
337   - if (car(implem) == mixed_type && ind != 0)
338   - fprintf(c_target," result |= %d;\n",ind);
339   -
340   - fprintf(c_target," return result;\n}\n\n");
341   - }
342   - ind++;
343   - }
344   - }
345   - break;
346   -
347   - default: assert(0);
348   - }
  326 + cdr2(car(aux)) == new_integer(2) ? 16 : 32;
  327 + fprintf(c_target,
  328 + " *((U%d *)(((U8 *)result)+%d)) = (U%d)_%d;\n",
  329 + w,
  330 + d + integer_value(second(car(aux))),
  331 + w,
  332 + k);
  333 + k++;
  334 + aux = cdr(aux);
  335 + }
  336 +
  337 + if (car(implem) == mixed_type && ind != 0)
  338 + fprintf(c_target," result |= %d;\n",ind);
  339 +
  340 + fprintf(c_target," return result;\n}\n\n");
  341 + }
  342 + ind++;
  343 + }
  344 + }
  345 + break;
  346 +
  347 + default: assert(0);
  348 + }
349 349  
350 350 fprintf(h_target,"\n");
351 351 }
... ...
anubis_dev/compiler/src/eqcode.c
  Show/Hide comments   View file @e69a754
... ... @@ -14,7 +14,7 @@ static Expr alt_eq_code(Expr lc, Expr, Expr, Expr);
14 14 /* Getting the address of equality code for a given type instance */
15 15 int get_eq_code_id(Expr lc,
16 16 Expr type,
17   - Expr env)
  17 + Expr env)
18 18 {
19 19 int i;
20 20  
... ... @@ -31,7 +31,7 @@ int get_eq_code_id(Expr lc,
31 31 {
32 32 err_line_col(lc);
33 33 fprintf(errfile,
34   - msgtext_float_equality[language]);
  34 + msgtext_float_equality[language]);
35 35 return float_eq_op_id; /* instance of '=' which produces always 'false' */
36 36 }
37 37  
... ... @@ -49,9 +49,9 @@ int get_eq_code_id(Expr lc,
49 49 {
50 50 if (compiled_ops[i].op_id == eq_scheme_op_id
51 51 && same_type(type,env,car(compiled_ops[i].types),compiled_ops[i].env))
52   - {
53   - return i;
54   - }
  52 + {
  53 + return i;
  54 + }
55 55 }
56 56  
57 57 /* if here, the equality code for this type instance is not yet
... ... @@ -124,37 +124,37 @@ int get_eq_code_id(Expr lc,
124 124  
125 125 aux = alts;
126 126 while (consp(aux))
127   - {
128   - case_addrs = cons(new_addr_name(labs_none,0),case_addrs);
129   - aux = cdr(aux);
130   - }
  127 + {
  128 + case_addrs = cons(new_addr_name(labs_none,0),case_addrs);
  129 + aux = cdr(aux);
  130 + }
131 131  
132 132 while (consp(alts))
133   - {
134   - alts_codes = cons(alt_eq_code(lc,
  133 + {
  134 + alts_codes = cons(alt_eq_code(lc,
135 135 car(alts),
136   - end_addr,
137   - env),
138   - alts_codes);
139   - alts = cdr(alts);
140   - }
  136 + end_addr,
  137 + env),
  138 + alts_codes);
  139 + alts = cdr(alts);
  140 + }
141 141  
142 142 aux = case_addrs;
143 143 while (consp(alts_codes))
144   - {
145   - result = cons(cons(label,car(aux)),append(car(alts_codes),result));
146   - alts_codes = cdr(alts_codes);
147   - aux = cdr(aux);
148   - }
  144 + {
  145 + result = cons(cons(label,car(aux)),append(car(alts_codes),result));
  146 + alts_codes = cdr(alts_codes);
  147 + aux = cdr(aux);
  148 + }
149 149 result = cons(cons(_switch,reverse(case_addrs)),result);
150 150 result = cons(jmp_instr,result);
151 151 result = cons(cons(jmp_eq_stack,end_addr),result);
152 152  
153 153 /* inline code performs garbage collection. It duplicates the
154   - two arguments, without making any virtual copy, because the
155   - offline code makes no garbage-collection. After return of the
156   - offline code, it virtually deletes the two arguments. The
157   - code is:
  154 + two arguments, without making any virtual copy, because the
  155 + offline code makes no garbage-collection. After return of the
  156 + offline code, it virtually deletes the two arguments. The
  157 + code is:
158 158  
159 159 (push_addr . ret_addr)
160 160 push_eq_data
... ... @@ -168,8 +168,8 @@ int get_eq_code_id(Expr lc,
168 168  
169 169 /* offline code makes no garbage collection */
170 170 compiled_ops[i].offline_code = save(
171   - cons(cons(header,op_comment(compiled_ops[i].op_id)),
172   - mcons3(odd_align,
  171 + cons(cons(header,op_comment(compiled_ops[i].op_id)),
  172 + mcons3(odd_align,
173 173 cons(label,compiled_ops[i].addr),
174 174 cons(mcons3(context,
175 175 list3(cons(argument,type),
... ... @@ -210,7 +210,7 @@ static Expr component_eq_code(Expr lc, int id, Expr end_addr)
210 210 {
211 211 err_line_col(lc);
212 212 fprintf(errfile,
213   - msgtext_float_equality[language]);
  213 + msgtext_float_equality[language]);
214 214 return list1(cons(false_jmp,end_addr));
215 215 }
216 216 else if (is_primitive_type(implem))
... ... @@ -230,33 +230,33 @@ static Expr component_eq_code(Expr lc, int id, Expr end_addr)
230 230 {
231 231 case small_type:
232 232 {
233   - int w = type_width(implems[id].type,implems[id].env);
  233 + int w = type_width(implems[id].type,implems[id].env);
234 234 assert(w >= 0);
235 235 if (w == 0)
236 236 return list1(mcons3(jmp_neq,new_integer(0),end_addr));
237   - else if (w <= 8)
238   - return list1(mcons3(jmp_neq,new_integer(1),end_addr));
239   - else if (w <= 16)
240   - return list1(mcons3(jmp_neq,new_integer(2),end_addr));
241   - else
242   - return list1(mcons3(jmp_neq,new_integer(4),end_addr));
  237 + else if (w <= 8)
  238 + return list1(mcons3(jmp_neq,new_integer(1),end_addr));
  239 + else if (w <= 16)
  240 + return list1(mcons3(jmp_neq,new_integer(2),end_addr));
  241 + else
  242 + return list1(mcons3(jmp_neq,new_integer(4),end_addr));
243 243 }
244 244  
245 245 case mixed_type:
246 246 case large_type:
247 247 {
248   - /* push a return address, push data on the stack and call the
249   - eq code for that component */
250   - Expr ret_addr = new_addr_name(labs_none,0);
  248 + /* push a return address, push data on the stack and call the
  249 + eq code for that component */
  250 + Expr ret_addr = new_addr_name(labs_none,0);
251 251  
252   - return list7(cons(check_stack,new_integer(3)),
  252 + return list7(cons(check_stack,new_integer(3)),
253 253 cons(push_addr,ret_addr),
254 254 push_eq_data,
255   - cons(address,
256   - compiled_ops[get_eq_code_id(lc,implems[id].type,implems[id].env)].addr),
257   - cons(apply,new_integer(2)),
258   - cons(label,ret_addr),
259   - cons(jmp_false,end_addr));
  255 + cons(address,
  256 + compiled_ops[get_eq_code_id(lc,implems[id].type,implems[id].env)].addr),
  257 + cons(apply,new_integer(2)),
  258 + cons(label,ret_addr),
  259 + cons(jmp_false,end_addr));
260 260 }
261 261 default:
262 262 assert(0);
... ... @@ -267,38 +267,38 @@ static Expr component_eq_code(Expr lc, int id, Expr end_addr)
267 267  
268 268 Expr alt_eq_code(Expr lc,
269 269 Expr alt_implem,
270   - Expr end_addr,
271   - Expr env)
  270 + Expr end_addr,
  271 + Expr env)
272 272 {
273 273 switch(car(alt_implem))
274 274 {
275 275 case small_alt:
276 276 /* at that point *(SP-1) and *(SP-2) are small data of the same
277   - alternative, which must be non equal, because a test of
278   - equality of these two words has already been performed. */
  277 + alternative, which must be non equal, because a test of
  278 + equality of these two words has already been performed. */
279 279 return list1(cons(false_jmp,end_addr));
280 280  
281 281 case mixed_alt:
282 282 case large_alt:
283 283 {
284   - Expr geoms = reverse(cdr(alt_implem)); /* ((<id> <offset> . <width>) ...) */
285   - Expr result = list1(cons(true_jmp,end_addr));
286   - Expr prevw;
287   -
288   - while (consp(geoms))
289   - {
290   - if (!consp(cdr(geoms)))
291   - prevw = (car(alt_implem) == mixed_alt ?
292   - new_integer(4) :
293   - new_integer(5));
294   - else
295   - prevw = cdr2(car(cdr(geoms)));
296   - result = cons(cons(increment_eq,prevw),
297   - append(component_eq_code(lc,integer_value(car(car(geoms))),end_addr),
298   - result));
299   - geoms = cdr(geoms);
300   - }
301   - return result;
  284 + Expr geoms = reverse(cdr(alt_implem)); /* ((<id> <offset> . <width>) ...) */
  285 + Expr result = list1(cons(true_jmp,end_addr));
  286 + Expr prevw;
  287 +
  288 + while (consp(geoms))
  289 + {
  290 + if (!consp(cdr(geoms)))
  291 + prevw = (car(alt_implem) == mixed_alt ?
  292 + new_integer(4) :
  293 + new_integer(5));
  294 + else
  295 + prevw = cdr2(car(cdr(geoms)));
  296 + result = cons(cons(increment_eq,prevw),
  297 + append(component_eq_code(lc,integer_value(car(car(geoms))),end_addr),
  298 + result));
  299 + geoms = cdr(geoms);
  300 + }
  301 + return result;
302 302 }
303 303  
304 304 default:
... ...
anubis_dev/compiler/src/expr.c
  Show/Hide comments   View file @e69a754
... ... @@ -33,8 +33,8 @@ Expr _car(Expr expr, int line, char *filename)
33 33 else
34 34 {
35 35 fprintf(errfile,"In '%s' at line %d, attempt to take the head of: ",
36   - filename,
37   - line);
  36 + filename,
  37 + line);
38 38 print_expr(errfile,expr);
39 39 fprintf(errfile,"\n");
40 40 anb_exit(1);
... ... @@ -51,8 +51,8 @@ Expr _cdr(Expr expr, int line, char *filename)
51 51 else
52 52 {
53 53 fprintf(errfile,"In '%s' at line %d, attempt to take the tail of: ",
54   - filename,
55   - line);
  54 + filename,
  55 + line);
56 56 print_expr(errfile,expr);
57 57 fprintf(errfile,"\n");
58 58 anb_exit(1);
... ... @@ -84,7 +84,7 @@ Expr new_utvar(char *name) /* name with leading $ removed */
84 84 for (i = 0; i < next_utvar; i++)
85 85 {
86 86 if (!strcmp(utvar_names[i],name))
87   - return index2utvar(i);
  87 + return index2utvar(i);
88 88 }
89 89  
90 90 if (max_utvar == next_utvar)
... ... @@ -113,13 +113,13 @@ Expr cons(Expr x, Expr y)
113 113 {
114 114 max_pair += 1000;
115 115 if (max_pair > max_pair_limit)
116   - {
  116 + {
117 117 int c;
118   - board_option = 1;
119   - board_headers();
120   - board();
121   - fprintf(errfile,
122   - msgtext_max_pair_limit[language],max_pair_limit);
  118 + board_option = 1;
  119 + board_headers();
  120 + board();
  121 + fprintf(errfile,
  122 + msgtext_max_pair_limit[language],max_pair_limit);
123 123 if ((c = getchar()) == 'q' || c == 'Q')
124 124 anb_exit(1);
125 125 else
... ... @@ -127,7 +127,7 @@ Expr cons(Expr x, Expr y)
127 127 max_pair_limit += 1000000;
128 128 while (getchar() != '\n'); /* empty the input */
129 129 }
130   - }
  130 + }
131 131 pairs = (struct Pair_struct *)reallocz(pairs,max_pair*sizeof(struct Pair_struct));
132 132 }
133 133 pairs[next_pair].first = x;
... ... @@ -155,7 +155,7 @@ Expr save(Expr x)
155 155 if (is_tpair(x))
156 156 {
157 157 //debug(x);
158   - if (car(x) == int32 || car(x) == integer)
  158 + if (car(x) == anb_int32 || car(x) == integer)
159 159 {
160 160 /* (int32 <lc> . <Cint>) */
161 161 return pcons(car(x),pcons(second(x),cdr2(x)));
... ... @@ -409,7 +409,7 @@ static Expr symbols_plus(Expr l1, Expr l2)
409 409 while (consp(l2))
410 410 {
411 411 if (!member(car(l2),l1))
412   - l1 = cons(car(l2),l1);
  412 + l1 = cons(car(l2),l1);
413 413 l2 = cdr(l2);
414 414 }
415 415 return l1;
... ... @@ -423,7 +423,7 @@ static Expr symbols_minus(Expr l1, Expr l2)
423 423 while (consp(l1))
424 424 {
425 425 if (!member(car(l1),l2))
426   - result = cons(car(l1),result);
  426 + result = cons(car(l1),result);
427 427 l1 = cdr(l1);
428 428 }
429 429 return result;
... ... @@ -452,7 +452,7 @@ Expr _symbols_in_interp(Expr head)
452 452 goto begin;
453 453  
454 454 case string:
455   - case int32:
  455 + case anb_int32:
456 456 case integer:
457 457 case small_datum:
458 458 case fpnum:
... ... @@ -473,14 +473,14 @@ Expr _symbols_in_interp(Expr head)
473 473  
474 474 case app:
475 475 {
476   - Expr result = nil;
477   - head = cdr2(head);
478   - while (consp(head))
479   - {
480   - result = symbols_plus(_symbols_in_interp(car(head)),result);
481   - head = cdr(head);
482   - }
483   - return result;
  476 + Expr result = nil;
  477 + head = cdr2(head);
  478 + while (consp(head))
  479 + {
  480 + result = symbols_plus(_symbols_in_interp(car(head)),result);
  481 + head = cdr(head);
  482 + }
  483 + return result;
484 484 }
485 485  
486 486 case closure: /* (closure <lc> (f_micro_ctxt fname ftype (sym . type)...) <args> . <body>) */
... ... @@ -506,38 +506,38 @@ Expr _symbols_in_interp(Expr head)
506 506  
507 507 case with:
508 508 return symbols_plus(_symbols_in_interp(forth(head)),
509   - symbols_minus(_symbols_in_interp(cdr4(head)),
510   - list1(third(head))));
  509 + symbols_minus(_symbols_in_interp(cdr4(head)),
  510 + list1(third(head))));
511 511  
512 512 case cond:
513 513 {
514   - Expr result = _symbols_in_interp(third(head));
515   - head = cdr3(head); /* (((<name> (<var> . <type>) ...) <lc> . <int head>) ...) */
  514 + Expr result = _symbols_in_interp(third(head));
  515 + head = cdr3(head); /* (((<name> (<var> . <type>) ...) <lc> . <int head>) ...) */
516 516  
517 517 //debug(head);
518 518  
519   - while (consp(head))
520   - {
521   - Expr t_resurg = cdr(car(car(head)));
522   - Expr resurg = nil;
  519 + while (consp(head))
  520 + {
  521 + Expr t_resurg = cdr(car(car(head)));
  522 + Expr resurg = nil;
523 523  
524 524 //debug(t_resurg);
525 525  
526   - /* collect resurgent symbols */
527   - while (consp(t_resurg))
528   - {
  526 + /* collect resurgent symbols */
  527 + while (consp(t_resurg))
  528 + {
529 529 if (is_string(car(t_resurg)))
530 530 resurg = cons(car(t_resurg),resurg);
531 531 else
532 532 resurg = cons(car(car(t_resurg)),resurg);
533   - t_resurg = cdr(t_resurg);
534   - }
535   -
536   - result = symbols_plus(result,
537   - symbols_minus(_symbols_in_interp(cdr2(car(head))),resurg));
538   - head = cdr(head);
539   - }
540   - return result;
  533 + t_resurg = cdr(t_resurg);
  534 + }
  535 +
  536 + result = symbols_plus(result,
  537 + symbols_minus(_symbols_in_interp(cdr2(car(head))),resurg));
  538 + head = cdr(head);
  539 + }
  540 + return result;
541 541 }
542 542  
543 543 case select_cond_interp:
... ... @@ -549,20 +549,20 @@ Expr _symbols_in_interp(Expr head)
549 549 (<sym> (<type> . <resurgent sym>) ...)
550 550 */
551 551 {
552   - Expr result = symbols_plus(_symbols_in_interp(third(head)),_symbols_in_interp(cdr6(head)));
553   - Expr t_resurg, resurg;
  552 + Expr result = symbols_plus(_symbols_in_interp(third(head)),_symbols_in_interp(cdr6(head)));
  553 + Expr t_resurg, resurg;
554 554  
555   - head = cdr4(head); /* ((<sym> (<type> . <sym>) ...) <head> . <head>) */
556   - t_resurg = cdr(car(head));
  555 + head = cdr4(head); /* ((<sym> (<type> . <sym>) ...) <head> . <head>) */
  556 + t_resurg = cdr(car(head));
557 557 resurg = nil;
558   - while (consp(t_resurg))
559   - {
560   - resurg = cons(cdr(car(t_resurg)),resurg);
561   - t_resurg = cdr(t_resurg);
562   - }
563   -
564   - return symbols_plus(result,
565   - symbols_minus(_symbols_in_interp(second(head)),resurg));
  558 + while (consp(t_resurg))
  559 + {
  560 + resurg = cons(cdr(car(t_resurg)),resurg);
  561 + t_resurg = cdr(t_resurg);
  562 + }
  563 +
  564 + return symbols_plus(result,
  565 + symbols_minus(_symbols_in_interp(second(head)),resurg));
566 566 }
567 567  
568 568 case anb_read:
... ... @@ -877,20 +877,20 @@ void print_expr(FILE *filep, Expr expr)
877 877 else if (is_unknown(expr)) fprintf(filep,"$%d",itvar2index(expr));
878 878 else if (consp(expr))
879 879 {
880   - if (car(expr) == integer || car(expr) == int32 || car(expr) == small_datum)
881   - {
882   - fprintf(filep,"(");
883   - print_expr(filep,car(expr));
884   - fprintf(filep," ");
885   - print_expr(filep,second(expr));
886   - fprintf(filep," . <Cint %d>)",cdr2(expr));
887   - }
  880 + if (car(expr) == integer || car(expr) == anb_int32 || car(expr) == small_datum)
  881 + {
  882 + fprintf(filep,"(");
  883 + print_expr(filep,car(expr));
  884 + fprintf(filep," ");
  885 + print_expr(filep,second(expr));
  886 + fprintf(filep," . <Cint %d>)",cdr2(expr));
  887 + }
888 888 else
889   - {
890   - fprintf(filep,"(");
891   - print_expr(filep,car(expr));
892   - print_tail(filep,cdr(expr));
893   - }
  889 + {
  890 + fprintf(filep,"(");
  891 + print_expr(filep,car(expr));
  892 + print_tail(filep,cdr(expr));
  893 + }
894 894 }
895 895 else fprintf(filep,"[Expr %d]",expr);
896 896 }
... ... @@ -900,20 +900,20 @@ void print_tail(FILE *filep, Expr expr)
900 900 if (expr == nil) fprintf(filep,")");
901 901 else if (consp(expr))
902 902 {
903   - if (car(expr) == integer || car(expr) == int32 || car(expr) == small_datum)
904   - {
905   - fprintf(filep," ");
906   - print_expr(filep,car(expr));
907   - fprintf(filep," ");
908   - print_expr(filep,second(expr));
909   - fprintf(filep," . <Cint %d>)",cdr2(expr));
910   - }
  903 + if (car(expr) == integer || car(expr) == anb_int32 || car(expr) == small_datum)
  904 + {
  905 + fprintf(filep," ");
  906 + print_expr(filep,car(expr));
  907 + fprintf(filep," ");
  908 + print_expr(filep,second(expr));
  909 + fprintf(filep," . <Cint %d>)",cdr2(expr));
  910 + }
911 911 else
912   - {
913   - fprintf(filep," ");
914   - print_expr(filep,car(expr));
915   - print_tail(filep,cdr(expr));
916   - }
  912 + {
  913 + fprintf(filep," ");
  914 + print_expr(filep,car(expr));
  915 + print_tail(filep,cdr(expr));
  916 + }
917 917 }
918 918 else
919 919 {
... ... @@ -959,20 +959,20 @@ int sprint_expr(char *filep, Expr expr)
959 959 else if (is_unknown(expr)) return sprintf(filep,"$%d",itvar2index(expr));
960 960 else if (consp(expr))
961 961 {
962   - if (car(expr) == integer || car(expr) == int32 || car(expr) == small_datum)
963   - {
964   - i += sprintf(filep,"(");
965   - i += sprint_expr(filep+i,car(expr));
966   - i += sprintf(filep+i," ");
967   - i += sprint_expr(filep+i,second(expr));
968   - return i + sprintf(filep+i," . <Cint %d>)",cdr2(expr));
969   - }
  962 + if (car(expr) == integer || car(expr) == anb_int32 || car(expr) == small_datum)
  963 + {
  964 + i += sprintf(filep,"(");
  965 + i += sprint_expr(filep+i,car(expr));
  966 + i += sprintf(filep+i," ");
  967 + i += sprint_expr(filep+i,second(expr));
  968 + return i + sprintf(filep+i," . <Cint %d>)",cdr2(expr));
  969 + }
970 970 else
971   - {
972   - i += sprintf(filep,"(");
973   - i += sprint_expr(filep+i,car(expr));
974   - return i + sprint_tail(filep+i,cdr(expr));
975   - }
  971 + {
  972 + i += sprintf(filep,"(");
  973 + i += sprint_expr(filep+i,car(expr));
  974 + return i + sprint_tail(filep+i,cdr(expr));
  975 + }
976 976 }
977 977 else return sprintf(filep,"[Expr %d]",expr);
978 978 }
... ... @@ -1038,10 +1038,10 @@ void err_line_col(Expr lc)
1038 1038 error_banner_sent = 1;
1039 1039 }
1040 1040 fprintf(errfile,
1041   - msgtext_line_col[language],
1042   - file_in(lc),
1043   - line_in(lc),
1044   - col_in(lc));
  1041 + msgtext_line_col[language],
  1042 + file_in(lc),
  1043 + line_in(lc),
  1044 + col_in(lc));
1045 1045 errors++;
1046 1046 }
1047 1047  
... ... @@ -1049,16 +1049,16 @@ void err_line_col(Expr lc)
1049 1049 void warn_line_col(Expr lc)
1050 1050 {
1051 1051 fprintf(errfile,
1052   - msgtext_warn_line_col[language],
1053   - file_in(lc),
1054   - line_in(lc),
1055   - col_in(lc));
  1052 + msgtext_warn_line_col[language],
  1053 + file_in(lc),
  1054 + line_in(lc),
  1055 + col_in(lc));
1056 1056 errors++;
1057 1057 }
1058 1058  
1059 1059  
1060 1060 int have_common_element(Expr l1,
1061   - Expr l2)
  1061 + Expr l2)
1062 1062 {
1063 1063 while (consp(l1))
1064 1064 {
... ... @@ -1074,25 +1074,25 @@ int equal(Expr x, Expr y)
1074 1074 if (consp(x))
1075 1075 {
1076 1076 if (consp(y))
1077   - {
1078   - if (equal(car(x),car(y)))
1079   - {
1080   - x = cdr(x);
1081   - y = cdr(y);
1082   - goto begin;
1083   - }
1084   - else return 0;
1085   - }
  1077 + {
  1078 + if (equal(car(x),car(y)))
  1079 + {
  1080 + x = cdr(x);
  1081 + y = cdr(y);
  1082 + goto begin;
  1083 + }
  1084 + else return 0;
  1085 + }
1086 1086 else return 0;
1087 1087 }
1088 1088 else
1089 1089 {
1090 1090 if (consp(y))
1091   - return 0;
  1091 + return 0;
1092 1092 else
1093   - {
1094   - return x == y;
1095   - }
  1093 + {
  1094 + return x == y;
  1095 + }
1096 1096 }
1097 1097 }
1098 1098  
... ... @@ -1105,7 +1105,7 @@ Expr merge_lists(Expr l1, Expr l2)
1105 1105 while (consp(l1))
1106 1106 {
1107 1107 if (!member(car(l1),l2))
1108   - l2 = cons(car(l1),l2);
  1108 + l2 = cons(car(l1),l2);
1109 1109 l1 = cdr(l1);
1110 1110 }
1111 1111 return l2;
... ... @@ -1117,7 +1117,7 @@ Expr substitute(Expr expr, Expr a_list)
1117 1117 {
1118 1118 Expr val;
1119 1119  
1120   - if (consp(expr) && (car(expr) == int32 || car(expr) == integer))
  1120 + if (consp(expr) && (car(expr) == anb_int32 || car(expr) == integer))
1121 1121 return expr;
1122 1122 if (0 && consp(expr) && car(expr) == operation)
1123 1123 {
... ... @@ -1133,14 +1133,14 @@ Expr substitute(Expr expr, Expr a_list)
1133 1133 return mcons3(small_datum,substitute(second(expr),a_list),cdr2(expr));
1134 1134 else if (consp(expr))
1135 1135 return cons(substitute(car(expr),a_list),
1136   - substitute(cdr(expr),a_list));
  1136 + substitute(cdr(expr),a_list));
1137 1137 else if ((val = assoc(expr,a_list)) != key_not_found)
1138 1138 {
1139   - return substitute(val,a_list);
  1139 + return substitute(val,a_list);
1140 1140 }
1141 1141 else
1142 1142 {
1143   - return expr;
  1143 + return expr;
1144 1144 }
1145 1145 }
1146 1146  
... ... @@ -1200,7 +1200,7 @@ int has_repetition(Expr list)
1200 1200 while (consp(list))
1201 1201 {
1202 1202 if (member(car(list),cdr(list)))
1203   - return 1;
  1203 + return 1;
1204 1204 list = cdr(list);
1205 1205 }
1206 1206 return 0;
... ... @@ -1220,7 +1220,7 @@ void print_expr_to_C(FILE *fp, Expr x)
1220 1220 fprintf(fp,"cons(integer,cons(");
1221 1221 fprintf(fp,"new_integer(%d),%d))",integer_value(second(x)),cdr2(x));
1222 1222 }
1223   - else if (car(x) == int32) assert(0);
  1223 + else if (car(x) == anb_int32) assert(0);
1224 1224 else
1225 1225 {
1226 1226 fprintf(fp,"cons(");
... ... @@ -1259,7 +1259,7 @@ void binary_print_expr(FILE *fp, Expr x)
1259 1259 {
1260 1260 put8(fp,5); put32(fp,second(x)); put32(fp,cdr2(x));
1261 1261 }
1262   - else if (car(x) == int32)
  1262 + else if (car(x) == anb_int32)
1263 1263 {
1264 1264 put8(fp,6); put32(fp,second(x)); put32(fp,cdr2(x));
1265 1265 }
... ... @@ -1345,7 +1345,7 @@ Expr binary_read_expr(U8 **source, U8 *end)
1345 1345 case 4: return binary_read_utvar(source,end);
1346 1346 // very important: make permanent pairs
1347 1347 case 5: { Expr lc = read32(source,end); return pcons3(integer,lc,read32(source,end)); }
1348   - case 6: { Expr lc = read32(source,end); return pcons3(int32,lc,read32(source,end)); }
  1348 + case 6: { Expr lc = read32(source,end); return pcons3(anb_int32,lc,read32(source,end)); }
1349 1349 case 7: { Expr lc = read32(source,end); return pcons3(small_datum,lc,read32(source,end)); }
1350 1350 case 8:
1351 1351 {
... ... @@ -1630,19 +1630,19 @@ void board(void)
1630 1630 {
1631 1631 if (board_count == 15)
1632 1632 {
1633   - board_count = 0;
1634   - board_headers();
1635   - }
  1633 + board_count = 0;
  1634 + board_headers();
  1635 + }
1636 1636 fprintf(stderr,
1637   - "\n%-16s %-30s%-8d%-8d%-8d%-12d%-12d\r",
  1637 + "\n%-16s %-30s%-8d%-8d%-8d%-12d%-12d\r",
1638 1638 source_file_name,
1639   - current_name,
1640   - lineno,
1641   - next_type,
1642   - next_operation,
1643   - next_ppair,
1644   - next_pair
1645   - );
  1639 + current_name,
  1640 + lineno,
  1641 + next_type,
  1642 + next_operation,
  1643 + next_ppair,
  1644 + next_pair
  1645 + );
1646 1646 board_count++;
1647 1647 }
1648 1648 }
... ...
anubis_dev/compiler/src/globals.c
  Show/Hide comments   View file @e69a754
... ... @@ -17,6 +17,7 @@ int error_banner_sent = 0;
17 17 int par_seen = 0;
18 18 int reading_predef = 0;
19 19 FILE * predef_aux = NULL;
  20 +FILE * predef_npd_aux = NULL;
20 21 FILE * predef_dat = NULL;
21 22 int max_include = 10;
22 23 FILE * errfile;
... ...
anubis_dev/compiler/src/grammar_tools.c
  Show/Hide comments   View file @e69a754
... ... @@ -31,16 +31,16 @@ Expr mantissa_and_exponent(Expr lc, Expr fpn)
31 31  
32 32 while (text[i] != '.')
33 33 {
34   - if (j < max_float_digits)
35   - {
36   - m = (10*m) + (text[i] - '0');
37   - i++; j++;
38   - }
39   - else
40   - {
41   - e++; /* ignore digits after the max_float_digits-th one, but still
42   - compute exponent, until the dot is found. */
43   - }
  34 + if (j < max_float_digits)
  35 + {
  36 + m = (10*m) + (text[i] - '0');
  37 + i++; j++;
  38 + }
  39 + else
  40 + {
  41 + e++; /* ignore digits after the max_float_digits-th one, but still
  42 + compute exponent, until the dot is found. */
  43 + }
44 44 }
45 45 if (e > 0)
46 46 return(cons(new_integer(m),new_integer(e)));
... ... @@ -50,9 +50,9 @@ Expr mantissa_and_exponent(Expr lc, Expr fpn)
50 50  
51 51 while (text[i] != 0 && j < max_float_digits)
52 52 {
53   - m = (10*m) + (text[i] - '0');
54   - i++; j++;
55   - e--; /* compute exponent */
  53 + m = (10*m) + (text[i] - '0');
  54 + i++; j++;
  55 + e--; /* compute exponent */
56 56 }
57 57  
58 58 /* return the result */
... ...
anubis_dev/compiler/src/implem.c
  Show/Hide comments   View file @e69a754
... ... @@ -191,20 +191,20 @@ static int new_type_implementation(Expr type, /* type */
191 191 if (is_address_type(type))
192 192 {
193 193 switch (car(type))
194   - {
195   - case type_RAddr:
196   - case type_WAddr:
197   - case type_RWAddr:
198   - case type_GAddr:
  194 + {
  195 + case type_RAddr:
  196 + case type_WAddr:
  197 + case type_RWAddr:
  198 + case type_GAddr:
199 199 case type_MVar:
200   - implems[implem_id].implem = save(cons(car(type),
  200 + implems[implem_id].implem = save(cons(car(type),
201 201 new_integer(type_implementation_id(cdr(type),env))));
202   - return implem_id;
  202 + return implem_id;
203 203  
204   - default:
205   - internal_error("Cannot implement address type",type);
206   - return nil;
207   - }
  204 + default:
  205 + internal_error("Cannot implement address type",type);
  206 + return nil;
  207 + }
208 208 }
209 209  
210 210 if (is_struct_ptr_type(type))
... ... @@ -250,8 +250,8 @@ static int new_type_implementation(Expr type, /* type */
250 250 while (consp(parms))
251 251 {
252 252 p_env = cons(cons(car(parms),
253   - car(parms_values)),
254   - p_env);
  253 + car(parms_values)),
  254 + p_env);
255 255 parms = cdr(parms);
256 256 parms_values = cdr(parms_values);
257 257 }
... ... @@ -275,11 +275,11 @@ static int new_type_implementation(Expr type, /* type */
275 275  
276 276 alt_widths = cons(new_integer(w),alt_widths);
277 277 max_alt_width =
278   - sup(max_alt_width,w);
  278 + sup(max_alt_width,w);
279 279 aux = cdr(aux);
280 280 }
281 281 alt_widths = hard_reverse(alt_widths); /* used below for mixed
282   - types */
  282 + types */
283 283  
284 284  
285 285 /* compute the sort of the type */
... ... @@ -307,55 +307,55 @@ static int new_type_implementation(Expr type, /* type */
307 307 if (type_sort == small_type)
308 308 {
309 309 while (consp(alts))
310   - {
311   - alts_implem =
312   - cons(small_alt_implem(cdr(car(alts)), /* ((<type> . <var>) ...) */
313   - iw,
  310 + {
  311 + alts_implem =
  312 + cons(small_alt_implem(cdr(car(alts)), /* ((<type> . <var>) ...) */
  313 + iw,
314 314 env),
315   - alts_implem);
316   - alts = cdr(alts);
317   - }
  315 + alts_implem);
  316 + alts = cdr(alts);
  317 + }
318 318 }
319 319  
320 320 else if (type_sort == mixed_type)
321 321 {
322 322 while (consp(alts))
323   - {
324   - if (integer_value(car(alt_widths)) < mw)
325   - {
326   - /* alternative is small */
327   - alts_implem =
328   - cons(small_alt_implem(cdr(car(alts)),
329   - iw,
330   - env),
331   - alts_implem);
332   - }
333   - else
334   - {
335   - /* alternative is mixed */
336   - alts_implem =
337   - cons(mixed_alt_implem(cdr(car(alts)),
338   - iw,
339   - env),
340   - alts_implem);
341   - }
342   - alt_widths = cdr(alt_widths);
343   - alts = cdr(alts);
344   - }
  323 + {
  324 + if (integer_value(car(alt_widths)) < mw)
  325 + {
  326 + /* alternative is small */
  327 + alts_implem =
  328 + cons(small_alt_implem(cdr(car(alts)),
  329 + iw,
  330 + env),
  331 + alts_implem);
  332 + }
  333 + else
  334 + {
  335 + /* alternative is mixed */
  336 + alts_implem =
  337 + cons(mixed_alt_implem(cdr(car(alts)),
  338 + iw,
  339 + env),
  340 + alts_implem);
  341 + }
  342 + alt_widths = cdr(alt_widths);
  343 + alts = cdr(alts);
  344 + }
345 345 }
346 346  
347 347 else /* type_sort == large_type */
348 348 {
349 349 assert(type_sort == large_type);
350 350 while (consp(alts))
351   - {
352   - alts_implem =
353   - cons(large_alt_implem(cdr(car(alts)),
354   - iw,
355   - env),
356   - alts_implem);
357   - alts = cdr(alts);
358   - }
  351 + {
  352 + alts_implem =
  353 + cons(large_alt_implem(cdr(car(alts)),
  354 + iw,
  355 + env),
  356 + alts_implem);
  357 + alts = cdr(alts);
  358 + }
359 359 }
360 360  
361 361  
... ... @@ -381,8 +381,8 @@ static int new_type_implementation(Expr type, /* type */
381 381  
382 382 /* implementing a small alternative */
383 383 static Expr small_alt_implem(Expr factors, /* ((<type> . <var>) ...) */
384   - int iw,
385   - Expr env)
  384 + int iw,
  385 + Expr env)
386 386 {
387 387 int offset = iw;
388 388 int w;
... ... @@ -408,8 +408,8 @@ static Expr small_alt_implem(Expr factors, /* ((&lt;type&gt; . &lt;var&gt;) ...) */
408 408  
409 409 /* implementing a mixed alternative */
410 410 static Expr mixed_alt_implem(Expr factors,
411   - int iw,
412   - Expr env)
  411 + int iw,
  412 + Expr env)
413 413 {
414 414 int offset = 0;
415 415 int bw;
... ... @@ -431,8 +431,8 @@ static Expr mixed_alt_implem(Expr factors,
431 431  
432 432 /* implementing a large alternative */
433 433 static Expr large_alt_implem(Expr factors,
434   - int iw,
435   - Expr env)
  434 + int iw,
  435 + Expr env)
436 436 {
437 437 int offset = 0;
438 438 int bw;
... ... @@ -471,10 +471,10 @@ static int small_implem_byte_width(Expr implem)
471 471 assert(car(car(implem)) == small_alt);
472 472 alt = cdr(car(implem)); /* ((<imp> <offset> . <width>) ...) */
473 473 while (consp(alt))
474   - {
475   - alt_width += integer_value(cdr2(car(alt)));
476   - alt = cdr(alt);
477   - }
  474 + {
  475 + alt_width += integer_value(cdr2(car(alt)));
  476 + alt = cdr(alt);
  477 + }
478 478 max_alt_width = sup(alt_width,max_alt_width);
479 479 implem = cdr(implem);
480 480 }
... ... @@ -631,13 +631,13 @@ static Expr get_indirect_implem_pseudo_instr(int implem_id)
631 631 {
632 632 /* implem (mixed_type <nalt> <iw> <alt geom> ...) */
633 633 return mcons3(indirect_type_mixed,
634   - mixed_copy_mask(implem),
635   - implems[implem_id].addr);
  634 + mixed_copy_mask(implem),
  635 + implems[implem_id].addr);
636 636 }
637 637 else if (is_large_implem(implem))
638 638 {
639 639 return cons(indirect_type_large,
640   - implems[implem_id].addr);
  640 + implems[implem_id].addr);
641 641 }
642 642 else
643 643 {
... ... @@ -687,7 +687,7 @@ static Expr alt_pseudo_code(Expr alt_geom, Expr index_width, int index)
687 687 assert(alt_sort == mixed_alt || alt_sort == large_alt);
688 688  
689 689 result = list1(cons(alt_sort == mixed_alt ? mixed_alt_begin : large_alt_begin,
690   - new_integer(seg_size(alt_geom))));
  690 + new_integer(seg_size(alt_geom))));
691 691 alt_geom = cdr(alt_geom);
692 692 while (consp(alt_geom))
693 693 {
... ... @@ -697,15 +697,15 @@ static Expr alt_pseudo_code(Expr alt_geom, Expr index_width, int index)
697 697 car(ind_instr) != indirect_type_16 &&
698 698 car(ind_instr) != indirect_type_32 &&
699 699 car(ind_instr) != type_small_alt)
700   - /* This case may happen only if the component has address, mixed or large type. */
  700 + /* This case may happen only if the component has address, mixed or large type. */
701 701 result = mcons3(pop1,ind_instr,result);
702 702 else
703   - result = cons(ind_instr,result);
  703 + result = cons(ind_instr,result);
704 704  
705 705 alt_geom = cdr(alt_geom);
706 706 }
707 707 result = cons(cons(alt_sort == mixed_alt ? mixed_alt_end : large_alt_end,
708   - new_integer(index)),
  708 + new_integer(index)),
709 709 result); /* mark the end of the alternative */
710 710 return hard_reverse(result);
711 711 }
... ... @@ -727,9 +727,9 @@ static Expr alts_pseudo_code(Expr labels,
727 727 {
728 728 n--;
729 729 result = cons(cons(label,car(labels)),
730   - append(alt_pseudo_code(car(alt_geoms),index_width,n),
731   - cons(cons(jmp,end_label),
732   - result)));
  730 + append(alt_pseudo_code(car(alt_geoms),index_width,n),
  731 + cons(cons(jmp,end_label),
  732 + result)));
733 733  
734 734 labels = cdr(labels);
735 735 alt_geoms = cdr(alt_geoms);
... ... @@ -775,9 +775,9 @@ Expr offline_pseudo_code(int implem_id)
775 775 aux = labels;
776 776  
777 777 result = cons(mcons3(type_mixed_switch,mixed_copy_mask(implem),labels),
778   - append(alts_pseudo_code(labels,third(implem),cdr3(implem),end_label),
779   - cons(cons(label,end_label),
780   - result)));
  778 + append(alts_pseudo_code(labels,third(implem),cdr3(implem),end_label),
  779 + cons(cons(label,end_label),
  780 + result)));
781 781 }
782 782 else if (is_large_implem(implem))
783 783 {
... ... @@ -790,9 +790,9 @@ Expr offline_pseudo_code(int implem_id)
790 790 aux = labels;
791 791  
792 792 result = cons(cons(type_large_switch,labels),
793   - append(alts_pseudo_code(labels,third(implem),cdr3(implem),end_label),
794   - cons(cons(label,end_label),
795   - result)));
  793 + append(alts_pseudo_code(labels,third(implem),cdr3(implem),end_label),
  794 + cons(cons(label,end_label),
  795 + result)));
796 796 }
797 797 else
798 798 {
... ...
anubis_dev/compiler/src/index.c
  Show/Hide comments   View file @e69a754
... ... @@ -70,7 +70,7 @@ void dump_type_def(FILE *fp, int tid)
70 70 fprintf(fp,"\n\n");
71 71  
72 72 xpos = fprintf(fp,"public type %s",
73   - string_content(types[tid].name));
  73 + string_content(types[tid].name));
74 74  
75 75 if ((aux = types[tid].parms) != nil)
76 76 print_expr(fp,aux);
... ... @@ -91,17 +91,17 @@ void dump_type_def(FILE *fp, int tid)
91 91 if consp(alt) xpos += fprintf(fp,"(");
92 92 margin = xpos;
93 93 while(consp(alt))
94   - {
  94 + {
95 95 xpos = margin;
96   - xpos += show_type(fp,car(car(alt)),nil);
  96 + xpos += show_type(fp,car(car(alt)),nil);
97 97 if (cdr(car(alt)) != noname)
98 98 {
99 99 while (xpos<margin+25) xpos += fprintf(fp," ");
100 100 fprintf(fp," %s",string_content(cdr(car(alt))));
101 101 }
102   - alt = cdr(alt);
103   - if (consp(alt)) fprintf(fp,",\n%*s",margin," "); else fprintf(fp,")");
104   - }
  102 + alt = cdr(alt);
  103 + if (consp(alt)) fprintf(fp,",\n%*s",margin," "); else fprintf(fp,")");
  104 + }
105 105 aux = cdr(aux);
106 106 if (consp(aux)) fprintf(fp,","); else fprintf(fp,".");
107 107 fprintf(fp,"\n");
... ... @@ -169,10 +169,10 @@ void dump_type_to_index(FILE *fp, FILE *html_left, FILE *html_right, int tid)
169 169 length(aux),
170 170 string_content(types[tid].name));
171 171 while (consp(aux))
172   - {
173   - fprintf(fp,"%s ",string_content(types[integer_value(car(aux))].name));
174   - aux = cdr(aux);
175   - }
  172 + {
  173 + fprintf(fp,"%s ",string_content(types[integer_value(car(aux))].name));
  174 + aux = cdr(aux);
  175 + }
176 176 fprintf(fp,"\n");
177 177 }
178 178 */
... ... @@ -198,11 +198,11 @@ void dump_op_def(FILE *fp, int opid)
198 198 fprintf(fp,"\n (\n");
199 199 while(consp(aux))
200 200 {
201   - fprintf(fp," ");
202   - show_type(fp,cdr(car(aux)),nil);
203   - fprintf(fp," %s",string_content(car(car(aux))));
204   - aux = cdr(aux);
205   - if (consp(aux)) fprintf(fp,",\n"); else fprintf(fp,"\n ).\n");
  201 + fprintf(fp," ");
  202 + show_type(fp,cdr(car(aux)),nil);
  203 + fprintf(fp," %s",string_content(car(car(aux))));
  204 + aux = cdr(aux);
  205 + if (consp(aux)) fprintf(fp,",\n"); else fprintf(fp,"\n ).\n");
206 206 }
207 207 }
208 208 else
... ... @@ -362,13 +362,13 @@ void produce_index(void)
362 362 html_right = fopenz("index_right.html","wt");
363 363  
364 364 fprintf(idf,
365   - "// This file has been generated by the Anubis compiler version 1.%d.\n\n",
366   - min_version);
  365 + "// This file has been generated by the Anubis compiler version 1.%d.\n\n",
  366 + min_version);
367 367  
368 368 fprintf(idf,
369 369 "// %d public type definitions and %d public data definitions.\n\n",
370   - n_type,
371   - n_op);
  370 + n_type,
  371 + n_op);
372 372  
373 373 fprintf(html_main,
374 374 "<html>\n"
... ...
anubis_dev/compiler/src/interp.c
  Show/Hide comments   View file @e69a754
... ... @@ -15,18 +15,18 @@
15 15  
16 16  
17 17 Expr symbol_interpretations (Expr lc,
18   - Expr ttype,
19   - Expr name,
20   - Expr ctxt,
21   - Expr env);
  18 + Expr ttype,
  19 + Expr name,
  20 + Expr ctxt,
  21 + Expr env);
22 22  
23 23 Expr of_type_interpretations (Expr lc,
24   - Expr ttype,
25   - Expr type,
26   - Expr term,
27   - Expr ctxt,
28   - Expr env,
29   - Expr tvs);
  24 + Expr ttype,
  25 + Expr type,
  26 + Expr term,
  27 + Expr ctxt,
  28 + Expr env,
  29 + Expr tvs);
30 30  
31 31 Expr lambda_interpretations (Expr lc,
32 32 Expr ttype,
... ... @@ -38,114 +38,114 @@ Expr lambda_interpretations (Expr lc,
38 38 Expr tvs);
39 39  
40 40 Expr app_interpretations (Expr lc,
41   - Expr ttype,
42   - Expr op,
43   - Expr args,
44   - Expr ctxt,
45   - Expr env,
46   - Expr tvs);
  41 + Expr ttype,
  42 + Expr op,
  43 + Expr args,
  44 + Expr ctxt,
  45 + Expr env,
  46 + Expr tvs);
47 47  
48 48 Expr app_interpretations_1 (Expr lc,
49   - Expr op_int_head,
50   - Expr op_int_env,
51   - Expr args_ints);
  49 + Expr op_int_head,
  50 + Expr op_int_env,
  51 + Expr args_ints);
52 52  
53 53 Expr with_interpretations (Expr keyword,
54   - Expr lc,
55   - Expr ttype,
56   - Expr symbol,
57   - Expr value,
58   - Expr body,
59   - Expr ctxt,
60   - Expr env,
61   - Expr tvs);
  54 + Expr lc,
  55 + Expr ttype,
  56 + Expr symbol,
  57 + Expr value,
  58 + Expr body,
  59 + Expr ctxt,
  60 + Expr env,
  61 + Expr tvs);
62 62  
63 63 Expr cond_interpretations (Expr lc,
64   - Expr ttype,
65   - Expr test,
66   - Expr clauses,
67   - Expr ctxt,
68   - Expr env,
69   - Expr tvs);
  64 + Expr ttype,
  65 + Expr test,
  66 + Expr clauses,
  67 + Expr ctxt,
  68 + Expr env,
  69 + Expr tvs);
70 70  
71 71 Expr select_cond_interpretations (Expr lc,
72   - Expr test,
73   - Expr constructor_name,
74   - Expr typed_resurg,
75   - Expr case_body,
76   - Expr else_term,
77   - Expr ctxt,
78   - Expr env,
79   - Expr tvs);
  72 + Expr test,
  73 + Expr constructor_name,
  74 + Expr typed_resurg,
  75 + Expr case_body,
  76 + Expr else_term,
  77 + Expr ctxt,
  78 + Expr env,
  79 + Expr tvs);
80 80  
81 81 Expr read_interpretations (Expr lc,
82   - Expr ttype,
83   - Expr conn,
84   - Expr ctxt,
85   - Expr env,
86   - Expr tvs);
  82 + Expr ttype,
  83 + Expr conn,
  84 + Expr ctxt,
  85 + Expr env,
  86 + Expr tvs);
87 87  
88 88 Expr write_interpretations (Expr lc,
89   - Expr ttype,
90   - Expr conn,
91   - Expr value,
92   - Expr ctxt,
93   - Expr env,
94   - Expr tvs);
  89 + Expr ttype,
  90 + Expr conn,
  91 + Expr value,
  92 + Expr ctxt,
  93 + Expr env,
  94 + Expr tvs);
95 95  
96 96 Expr exchange_interpretations (Expr lc,
97   - Expr ttype,
98   - Expr conn,
99   - Expr value,
100   - Expr ctxt,
101   - Expr env,
102   - Expr tvs);
  97 + Expr ttype,
  98 + Expr conn,
  99 + Expr value,
  100 + Expr ctxt,
  101 + Expr env,
  102 + Expr tvs);
103 103  
104 104 Expr connect_file_interpretations (Expr lc,
105   - Expr type,
106   - Expr name,
107   - Expr ctxt,
108   - Expr env,
109   - Expr tvs);
  105 + Expr type,
  106 + Expr name,
  107 + Expr ctxt,
  108 + Expr env,
  109 + Expr tvs);
110 110  
111 111 Expr connect_IP_interpretations (Expr lc,
112   - Expr type,
113   - Expr addr,
114   - Expr port,
115   - Expr ctxt,
116   - Expr env,
117   - Expr tvs);
  112 + Expr type,
  113 + Expr addr,
  114 + Expr port,
  115 + Expr ctxt,
  116 + Expr env,
  117 + Expr tvs);
118 118  
119 119 Expr wait_for_interpretations (Expr lc,
120   - Expr ttype,
121   - Expr condition,
  120 + Expr ttype,
  121 + Expr condition,
122 122 Expr milliseconds,
123   - Expr after,
124   - Expr ctxt,
125   - Expr env,
126   - Expr tvs);
  123 + Expr after,
  124 + Expr ctxt,
  125 + Expr env,
  126 + Expr tvs);
127 127  
128 128 Expr delegate_interpretations (Expr lc,
129   - Expr ttype,
130   - Expr delegated,
131   - Expr body,
132   - Expr ctxt,
133   - Expr env,
134   - Expr tvs);
  129 + Expr ttype,
  130 + Expr delegated,
  131 + Expr body,
  132 + Expr ctxt,
  133 + Expr env,
  134 + Expr tvs);
135 135  
136 136 Expr serialize_interpretations (Expr lc,
137 137 Expr ttype,
138 138 Expr datum,
139 139 Expr ctxt,
140   - Expr env,
141   - Expr tvs);
  140 + Expr env,
  141 + Expr tvs);
142 142  
143 143 Expr unserialize_interpretations (Expr lc,
144   - Expr ttype,
145   - Expr bytes,
146   - Expr ctxt,
147   - Expr env,
148   - Expr tvs);
  144 + Expr ttype,
  145 + Expr bytes,
  146 + Expr ctxt,
  147 + Expr env,
  148 + Expr tvs);
149 149  
150 150 Expr protect_interpretations (Expr lc,
151 151 Expr target_type,
... ... @@ -320,7 +320,7 @@ static Expr signature_from_type(Expr type, Expr env)
320 320 switch(car(type))
321 321 {
322 322 case functype:
323   - return second(type);
  323 + return second(type);
324 324 }
325 325  
326 326 return nil; /* because T is the same as () -> T */
... ... @@ -440,9 +440,9 @@ Expr select_special_interpretation(Expr lc,
440 440  
441 441 static Expr /* <operation interpretations> */
442 442 operation_interpretations(Expr lc, /* <lc> */
443   - Expr type, /* required type for operation */
444   - Expr name, /* <operation name> */
445   - Expr env)
  443 + Expr type, /* required type for operation */
  444 + Expr name, /* <operation name> */
  445 + Expr env)
446 446 {
447 447 int i, h;
448 448 Expr op_ints_result = nil;
... ... @@ -526,9 +526,9 @@ operation_interpretations(Expr lc, /* &lt;lc&gt; */
526 526 continue;
527 527  
528 528 if (name == variables[i].name)
529   - op_ints_result = cons(cons(mcons3(global_variable,lc,new_integer(i)),
530   - nil),
531   - op_ints_result);
  529 + op_ints_result = cons(cons(mcons3(global_variable,lc,new_integer(i)),
  530 + nil),
  531 + op_ints_result);
532 532 }
533 533  
534 534 /* if no match found, the operation is unknown */
... ... @@ -536,8 +536,8 @@ operation_interpretations(Expr lc, /* &lt;lc&gt; */
536 536 {
537 537 err_line_col(lc);
538 538 fprintf(errfile,
539   - msgtext_unknown_symbol[language],
540   - string_content(name));
  539 + msgtext_unknown_symbol[language],
  540 + string_content(name));
541 541 }
542 542  
543 543 /* in any case, return the list of interpretations */
... ... @@ -553,12 +553,12 @@ operation_interpretations(Expr lc, /* &lt;lc&gt; */
553 553 /* interpreting a tuple of terms */
554 554 static
555 555 Expr /* returns a list of tuple
556   - interpretations */
  556 + interpretations */
557 557 tuple_interpretations(Expr ttypes, /* required types */
558 558 Expr terms, /* terms to be interpreted */
559   - Expr ctxts, /* list of contexts */
560   - Expr env, /* environment */
561   - Expr tvs, /* user type variable list */
  559 + Expr ctxts, /* list of contexts */
  560 + Expr env, /* environment */
  561 + Expr tvs, /* user type variable list */
562 562 int same_types) /* if 1 keep only those interpretations where the
563 563 elements of the tuple may have the same type. */
564 564 {
... ... @@ -579,7 +579,7 @@ tuple_interpretations(Expr ttypes, /* required types */
579 579 {
580 580 /* get all interpretations of first term */
581 581 first =
582   - term_interpretations(dummy,car(terms),car(ctxts),env,tvs);
  582 + term_interpretations(dummy,car(terms),car(ctxts),env,tvs);
583 583 if (first == nil) return nil;
584 584  
585 585 /* get all interpretations of other terms */
... ... @@ -587,9 +587,9 @@ tuple_interpretations(Expr ttypes, /* required types */
587 587  
588 588 others = tuple_interpretations(dummy,
589 589 cdr(terms),
590   - cdr(ctxts),
591   - env,
592   - tvs,
  590 + cdr(ctxts),
  591 + env,
  592 + tvs,
593 593 same_types);
594 594  
595 595 if (others == nil) return nil;
... ... @@ -599,22 +599,22 @@ tuple_interpretations(Expr ttypes, /* required types */
599 599 for each interpretation (I1 . e) of first, and each interpretation
600 600 ((I2 ... Ik) . e') of others, construct:
601 601  
602   - ((I1 I2 ... Ik) . e'')
  602 + ((I1 I2 ... Ik) . e'')
603 603  
604   - where e'' is obtained by merging e and e' */
  604 + where e'' is obtained by merging e and e' */
605 605 while (consp(first))
606   - {
607   - first_int = car(car(first));
608   - first_env = cdr(car(first));
  606 + {
  607 + first_int = car(car(first));
  608 + first_env = cdr(car(first));
609 609  
610   - aux = others;
  610 + aux = others;
611 611  
612   - while (consp(aux))
613   - {
  612 + while (consp(aux))
  613 + {
614 614 Expr new_env;
615 615  
616   - others_int = car(car(aux));
617   - others_env = cdr(car(aux));
  616 + others_int = car(car(aux));
  617 + others_env = cdr(car(aux));
618 618  
619 619 new_env = join_envs(first_env,others_env);
620 620  
... ... @@ -643,10 +643,10 @@ tuple_interpretations(Expr ttypes, /* required types */
643 643 result);
644 644 }
645 645 }
646   - aux = cdr(aux);
647   - }
648   - first = cdr(first);
649   - }
  646 + aux = cdr(aux);
  647 + }
  648 + first = cdr(first);
  649 + }
650 650 }
651 651  
652 652 if (result == nil)
... ... @@ -662,9 +662,9 @@ tuple_interpretations(Expr ttypes, /* required types */
662 662 Expr /* returns a list of interpretations */
663 663 term_interpretations(Expr ttype, /* required type for that term (may contain unknowns) */
664 664 Expr term, /* <term> */
665   - Expr ctxt, /* <context> */
666   - Expr env, /* <environment> */
667   - Expr tvs) /* user type variable list */
  665 + Expr ctxt, /* <context> */
  666 + Expr env, /* <environment> */
  667 + Expr tvs) /* user type variable list */
668 668 {
669 669 Expr result = nil;
670 670  
... ... @@ -722,71 +722,71 @@ term_interpretations(Expr ttype, /* required type for that term (may contai
722 722  
723 723 case alert: /* (alert <lc> . <file name>) */
724 724 {
725   - /* equivalent to the term: alert_handler(file_name,line,column),
  725 + /* equivalent to the term: alert_handler(file_name,line,column),
726 726 with unknown type. */
727   - Expr lc = second(term);
728   -
729   - term = list6(app,
730   - lc,
731   - mcons3(symbol,lc,pdstr_alert_handler),
732   - mcons3(string,lc,cdr2(term)),
733   - mcons3(integer,lc,line_in(lc)),
734   - mcons3(integer,lc,col_in(lc)));
735   - goto begin;
  727 + Expr lc = second(term);
  728 +
  729 + term = list6(app,
  730 + lc,
  731 + mcons3(symbol,lc,pdstr_alert_handler),
  732 + mcons3(string,lc,cdr2(term)),
  733 + mcons3(integer,lc,line_in(lc)),
  734 + mcons3(integer,lc,col_in(lc)));
  735 + goto begin;
736 736 }
737 737 break;
738 738  
739 739 case debug_avm: /* (debug_avm <lc> . <term>) */
740 740 {
741   - Expr interps = term_interpretations(ttype,cdr2(term),ctxt,env,tvs);
742   - result = nil;
743   - while (consp(interps))
744   - {
745   - result = cons(cons(mcons3(debug_avm,
746   - second(term),
747   - car(car(interps))),
748   - cdr(car(interps))),
749   - result);
750   - interps = cdr(interps);
751   - }
  741 + Expr interps = term_interpretations(ttype,cdr2(term),ctxt,env,tvs);
  742 + result = nil;
  743 + while (consp(interps))
  744 + {
  745 + result = cons(cons(mcons3(debug_avm,
  746 + second(term),
  747 + car(car(interps))),
  748 + cdr(car(interps))),
  749 + result);
  750 + interps = cdr(interps);
  751 + }
752 752 }
753 753 break;
754 754  
755 755 case terminal: /* (terminal <lc> . <term>) */
756 756 {
757   - Expr interps = term_interpretations(ttype,cdr2(term),ctxt,env,tvs);
758   - result = nil;
759   - while (consp(interps))
760   - {
761   - result = cons(cons(mcons3(terminal,
762   - second(term),
763   - car(car(interps))),
764   - cdr(car(interps))),
765   - result);
766   - interps = cdr(interps);
767   - }
  757 + Expr interps = term_interpretations(ttype,cdr2(term),ctxt,env,tvs);
  758 + result = nil;
  759 + while (consp(interps))
  760 + {
  761 + result = cons(cons(mcons3(terminal,
  762 + second(term),
  763 + car(car(interps))),
  764 + cdr(car(interps))),
  765 + result);
  766 + interps = cdr(interps);
  767 + }
768 768 }
769 769 break;
770 770  
771 771  
772 772 case integer:
773 773 {
774   - /* (integer <lc> . <Cint>) */
775   - int x = (int)cdr2(term);
  774 + /* (integer <lc> . <Cint>) */
  775 + int x = (int)cdr2(term);
776 776  
777 777 //printf("line %d <Cint> = %d\n",line_in(second(term)),cdr2(term)); fflush(stdout);
778 778  
779   - if (0 <= x && x <= 255)
780   - {
781   - result = list2(cons(cons(int32,cdr(term)),env),
782   - cons(mcons3(small_datum,pdstr_Int8,cdr2(term)),env));
783   - }
784   - else
785   - result = list1(cons(cons(int32,cdr(term)),env));
786   -
787   - /* add an interpretation as float */
788   - result = cons(cons(mcons4(fpnum,second(term),new_integer(cdr2(term)),new_integer(0)),env),
789   - result);
  779 + if (0 <= x && x <= 255)
  780 + {
  781 + result = list2(cons(cons(anb_int32,cdr(term)),env),
  782 + cons(mcons3(small_datum,pdstr_Int8,cdr2(term)),env));
  783 + }
  784 + else
  785 + result = list1(cons(cons(anb_int32,cdr(term)),env));
  786 +
  787 + /* add an interpretation as float */
  788 + result = cons(cons(mcons4(fpnum,second(term),new_integer(cdr2(term)),new_integer(0)),env),
  789 + result);
790 790 }
791 791 break;
792 792  
... ... @@ -802,9 +802,9 @@ term_interpretations(Expr ttype, /* required type for that term (may contai
802 802 term = cdr(term);
803 803 result = symbol_interpretations(car(term), /* <lc> */
804 804 dummy,
805   - cdr(term), /* <string> */
806   - ctxt,
807   - env);
  805 + cdr(term), /* <string> */
  806 + ctxt,
  807 + env);
808 808 break;
809 809  
810 810 #if 0
... ... @@ -818,12 +818,12 @@ term_interpretations(Expr ttype, /* required type for that term (may contai
818 818 /* (of_type <lc> <type> . <term>) */
819 819 term = cdr(term);
820 820 result = of_type_interpretations(car(term), /* <lc> */
821   - dummy,
822   - car(cdr(term)), /* <type> */
823   - cdr(cdr(term)), /* <term> */
824   - ctxt,
825   - env,
826   - tvs);
  821 + dummy,
  822 + car(cdr(term)), /* <type> */
  823 + cdr(cdr(term)), /* <term> */
  824 + ctxt,
  825 + env,
  826 + tvs);
827 827 break;
828 828  
829 829 case constructor:
... ... @@ -861,40 +861,40 @@ term_interpretations(Expr ttype, /* required type for that term (may contai
861 861 /* (app <lc> <term> . <terms>) */
862 862 term = cdr(term);
863 863 result = app_interpretations(car(term), /* <lc> */
864   - dummy,
865   - car(cdr(term)), /* operation */
866   - cdr(cdr(term)), /* operands */
867   - ctxt,
868   - env,
869   - tvs);
  864 + dummy,
  865 + car(cdr(term)), /* operation */
  866 + cdr(cdr(term)), /* operands */
  867 + ctxt,
  868 + env,
  869 + tvs);
870 870 break;
871 871  
872 872 case cond:
873 873 /* (cond <lc> <test> . <clauses 1>) */
874 874 term = cdr(term);
875 875 result = cond_interpretations(car(term), /* <lc> */
876   - dummy,
877   - car(cdr(term)), /* test */
878   - cdr(cdr(term)), /* clauses */
879   - ctxt,
880   - env,
881   - tvs);
  876 + dummy,
  877 + car(cdr(term)), /* test */
  878 + cdr(cdr(term)), /* clauses */
  879 + ctxt,
  880 + env,
  881 + tvs);
882 882 break;
883 883  
884 884 case select_cond:
885 885 /* (select_cond <lc> <test> ((<sym> <typed resurg> ...) <lc> . <term>) . <else term>) */
886 886 term = cdr(term);
887 887 {
888   - Expr clause = third(term);
889   - result = select_cond_interpretations(car(term), /* lc */
890   - second(term), /* test */
891   - car(car(clause)), /* constructor name */
892   - cdr(car(clause)), /* typed resurgent symbols */
893   - cdr2(clause), /* body of case term */
894   - cdr3(term), /* else term */
895   - ctxt,
896   - env,
897   - tvs);
  888 + Expr clause = third(term);
  889 + result = select_cond_interpretations(car(term), /* lc */
  890 + second(term), /* test */
  891 + car(car(clause)), /* constructor name */
  892 + cdr(car(clause)), /* typed resurgent symbols */
  893 + cdr2(clause), /* body of case term */
  894 + cdr3(term), /* else term */
  895 + ctxt,
  896 + env,
  897 + tvs);
898 898 }
899 899 break;
900 900  
... ... @@ -902,13 +902,13 @@ term_interpretations(Expr ttype, /* required type for that term (may contai
902 902 /* (with <lc> <symbol> <term> . <term>) */
903 903 result = with_interpretations(car(term),
904 904 second(term), /* lc */
905   - dummy,
  905 + dummy,
906 906 third(term), /* symbol */
907   - forth(term), /* defined term */
908   - cdr4(term), /* body term */
909   - ctxt,
910   - env,
911   - tvs);
  907 + forth(term), /* defined term */
  908 + cdr4(term), /* body term */
  909 + ctxt,
  910 + env,
  911 + tvs);
912 912 break;
913 913  
914 914 case string:
... ... @@ -923,86 +923,86 @@ term_interpretations(Expr ttype, /* required type for that term (may contai
923 923 /* (anb_read <lc> . <conn>) */
924 924 term = cdr(term);
925 925 result = read_interpretations(car(term), /* lc */
926   - dummy,
927   - cdr(term), /* conn */
928   - ctxt,
929   - env,
930   - tvs);
  926 + dummy,
  927 + cdr(term), /* conn */
  928 + ctxt,
  929 + env,
  930 + tvs);
931 931 break;
932 932  
933 933 case anb_write:
934 934 /* (anb_write <lc> <conn> . <term>) */
935 935 term = cdr(term);
936 936 result = write_interpretations(car(term), /* lc */
937   - dummy,
938   - second(term), /* conn (<term>) */
939   - cdr2(term), /* value (<term>) */
940   - ctxt,
941   - env,
942   - tvs);
  937 + dummy,
  938 + second(term), /* conn (<term>) */
  939 + cdr2(term), /* value (<term>) */
  940 + ctxt,
  941 + env,
  942 + tvs);
943 943 break;
944 944  
945 945 case anb_exchange:
946 946 /* (anb_exchange <lc> <conn> . <term>) */
947 947 term = cdr(term);
948 948 result = exchange_interpretations(car(term), /* lc */
949   - dummy,
950   - second(term), /* conn (<term>) */
951   - cdr2(term), /* value (<term>) */
952   - ctxt,
953   - env,
954   - tvs);
  949 + dummy,
  950 + second(term), /* conn (<term>) */
  951 + cdr2(term), /* value (<term>) */
  952 + ctxt,
  953 + env,
  954 + tvs);
955 955 break;
956 956  
957 957 case connect_to_file:
958 958 /* (connect_to_file <lc> <type> . <term>) */
959 959 term = cdr(term);
960 960 result = connect_file_interpretations(car(term), /* lc */
961   - second(term), /* return type */
962   - cdr2(term), /* connection name */
963   - ctxt,
964   - env,
965   - tvs);
  961 + second(term), /* return type */
  962 + cdr2(term), /* connection name */
  963 + ctxt,
  964 + env,
  965 + tvs);
966 966 break;
967 967  
968 968 case connect_to_IP:
969 969 /* (connect_to_IP <lc> <type> <term> . <term>) */
970 970 term = cdr(term);
971 971 result = connect_IP_interpretations(car(term), /* lc */
972   - second(term), /* return type */
973   - third(term), /* IP addr */
974   - cdr3(term), /* port */
975   - ctxt,
976   - env,
977   - tvs);
  972 + second(term), /* return type */
  973 + third(term), /* IP addr */
  974 + cdr3(term), /* port */
  975 + ctxt,
  976 + env,
  977 + tvs);
978 978 break;
979 979  
980 980 case wait_for:
981 981 {
982   - /* (wait_for <lc> <term> <term> . <term>) */
983   - term = cdr(term);
984   - result = wait_for_interpretations(car(term), /* lc */
985   - dummy,
986   - second(term), /* condition */
  982 + /* (wait_for <lc> <term> <term> . <term>) */
  983 + term = cdr(term);
  984 + result = wait_for_interpretations(car(term), /* lc */
  985 + dummy,
  986 + second(term), /* condition */
987 987 third(term), /* milliseconds */
988   - cdr3(term), /* term after condition realized */
989   - ctxt,
990   - env,
991   - tvs);
  988 + cdr3(term), /* term after condition realized */
  989 + ctxt,
  990 + env,
  991 + tvs);
992 992 }
993 993 break;
994 994  
995 995 case delegate:
996 996 {
997   - /* (delegate <lc> <term> . <term>) */
998   - term = cdr(term);
999   - result = delegate_interpretations(car(term), /* lc */
1000   - dummy,
1001   - second(term), /* delegated */
1002   - cdr2(term), /* body */
1003   - ctxt,
1004   - env,
1005   - tvs);
  997 + /* (delegate <lc> <term> . <term>) */
  998 + term = cdr(term);
  999 + result = delegate_interpretations(car(term), /* lc */
  1000 + dummy,
  1001 + second(term), /* delegated */
  1002 + cdr2(term), /* body */
  1003 + ctxt,
  1004 + env,
  1005 + tvs);
1006 1006 }
1007 1007 break;
1008 1008  
... ... @@ -1014,26 +1014,26 @@ term_interpretations(Expr ttype, /* required type for that term (may contai
1014 1014  
1015 1015 case serialize:
1016 1016 /* (serialize <lc> . <term>) */
1017   - assert(reading_predef);
  1017 + //assert(reading_predef);
1018 1018 term = cdr(term);
1019 1019 result = serialize_interpretations(car(term),
1020   - dummy,
1021   - cdr(term),
1022   - ctxt,
1023   - env,
1024   - tvs);
  1020 + dummy,
  1021 + cdr(term),
  1022 + ctxt,
  1023 + env,
  1024 + tvs);
1025 1025 break;
1026 1026  
1027 1027 case unserialize:
1028 1028 /* (unserialize <lc> . <term>) */
1029   - assert(reading_predef);
  1029 + //assert(reading_predef);
1030 1030 term = cdr(term);
1031 1031 result = unserialize_interpretations(car(term),
1032   - dummy,
1033   - cdr(term),
1034   - ctxt,
1035   - env,
1036   - tvs);
  1032 + dummy,
  1033 + cdr(term),
  1034 + ctxt,
  1035 + env,
  1036 + tvs);
1037 1037 break;
1038 1038  
1039 1039 case vcopy:
... ... @@ -1109,30 +1109,30 @@ Expr symbol_micro_interpretations(Expr lc,
1109 1109  
1110 1110 /* mctxt = ((<symbol> . <type>) ...) */
1111 1111 if (name == car(car(mctxt)))
1112   - {
1113   - /* The symbol has been found in the context. It is micro-local. By
1114   - strong preemption principle, its required type must match
1115   - the type found in the context. This updates the
1116   - environment. */
  1112 + {
  1113 + /* The symbol has been found in the context. It is micro-local. By
  1114 + strong preemption principle, its required type must match
  1115 + the type found in the context. This updates the
  1116 + environment. */
1117 1117  
1118   - /* TODO: match types here (this may produce an error message) */
  1118 + /* TODO: match types here (this may produce an error message) */
1119 1119  
1120   - return list1(cons(mcons5(micro_local, /* the symbol is micro_local */
1121   - name, /* name of local symbol */
  1120 + return list1(cons(mcons5(micro_local, /* the symbol is micro_local */
  1121 + name, /* name of local symbol */
1122 1122 micro_depth, /* depth of micro context */
1123   - new_integer(i), /* depth within micro context */
1124   - cdr(car(mctxt))), /* type found for the symbol */
1125   - env)); /* environment is unchanged */
  1123 + new_integer(i), /* depth within micro context */
  1124 + cdr(car(mctxt))), /* type found for the symbol */
  1125 + env)); /* environment is unchanged */
1126 1126  
1127   - }
  1127 + }
1128 1128 i++; /* next depth */
1129 1129 mctxt = cdr(mctxt); /* sequel of micro-context */
1130 1130 }
1131 1131  
1132 1132 /* otherwise, the symbol must be defined globally */
1133 1133 return operation_interpretations(lc,
1134   - dummy, /* required type for the symbol */
1135   - name, /* name of global symbol */
  1134 + dummy, /* required type for the symbol */
  1135 + name, /* name of global symbol */
1136 1136 env);
1137 1137 }
1138 1138  
... ... @@ -1140,10 +1140,10 @@ Expr symbol_micro_interpretations(Expr lc,
1140 1140  
1141 1141  
1142 1142 Expr symbol_interpretations(Expr lc,
1143   - Expr ttype, /* required type for the symbol */
1144   - Expr name, /* name of symbol */
1145   - Expr ctxt, /* local context */
1146   - Expr env) /* environment for type unkowns */
  1143 + Expr ttype, /* required type for the symbol */
  1144 + Expr name, /* name of symbol */
  1145 + Expr ctxt, /* local context */
  1146 + Expr env) /* environment for type unkowns */
1147 1147 {
1148 1148 int i = 0; /* used to compute depth of symbol in context */
1149 1149  
... ... @@ -1170,29 +1170,29 @@ Expr symbol_interpretations(Expr lc,
1170 1170 }
1171 1171 }
1172 1172 else if (name == car(car(ctxt)))
1173   - {
1174   - /* The symbol has been found in the context. It is local. By
1175   - strong preemption principle, its required type must match
1176   - the type found in the context. This updates the
1177   - environment. */
  1173 + {
  1174 + /* The symbol has been found in the context. It is local. By
  1175 + strong preemption principle, its required type must match
  1176 + the type found in the context. This updates the
  1177 + environment. */
1178 1178  
1179   - /* TODO: match types here (this may produce an error message) */
  1179 + /* TODO: match types here (this may produce an error message) */
1180 1180  
1181   - return list1(cons(mcons4(local, /* the symbol is local */
1182   - name, /* name of local symbol */
1183   - new_integer(i), /* depth in context */
1184   - cdr(car(ctxt))), /* type found for the symbol */
1185   - env)); /* environment is unchanged */
  1181 + return list1(cons(mcons4(local, /* the symbol is local */
  1182 + name, /* name of local symbol */
  1183 + new_integer(i), /* depth in context */
  1184 + cdr(car(ctxt))), /* type found for the symbol */
  1185 + env)); /* environment is unchanged */
1186 1186  
1187   - }
  1187 + }
1188 1188 i++; /* next depth */
1189 1189 ctxt = cdr(ctxt); /* sequel of context */
1190 1190 }
1191 1191  
1192 1192 /* otherwise, the symbol must be defined globally */
1193 1193 return operation_interpretations(lc,
1194   - dummy, /* required type for the symbol */
1195   - name, /* name of global symbol */
  1194 + dummy, /* required type for the symbol */
  1195 + name, /* name of global symbol */
1196 1196 env);
1197 1197 }
1198 1198  
... ... @@ -1215,12 +1215,12 @@ Expr symbol_interpretations(Expr lc,
1215 1215 interpretations. If no interpretation is compatible with T, an
1216 1216 error message is sent. */
1217 1217 Expr of_type_interpretations(Expr lc,
1218   - Expr ttype, /* required type */
1219   - Expr type, /* T */
1220   - Expr term, /* t */
1221   - Expr ctxt,
1222   - Expr env,
1223   - Expr tvs)
  1218 + Expr ttype, /* required type */
  1219 + Expr type, /* T */
  1220 + Expr term, /* t */
  1221 + Expr ctxt,
  1222 + Expr env,
  1223 + Expr tvs)
1224 1224 {
1225 1225 Expr term_ints, term_ints_before, term_int_head, term_int_env, term_type, new_env, result;
1226 1226  
... ... @@ -1242,13 +1242,13 @@ Expr of_type_interpretations(Expr lc,
1242 1242  
1243 1243 /* unify given type with type of term */
1244 1244 new_env = unify(type,
1245   - nil,
1246   - term_type,
1247   - term_int_env);
  1245 + nil,
  1246 + term_type,
  1247 + term_int_env);
1248 1248  
1249   - if (new_env != not_unifiable)
1250   - result = cons(cons(term_int_head,new_env),result); // 10/08/2005
1251   - //result = cons(cons(mcons3(i_of_type,type,term_int_head),new_env),result);
  1249 + if (new_env != not_unifiable)
  1250 + result = cons(cons(term_int_head,new_env),result); // 10/08/2005
  1251 + //result = cons(cons(mcons3(i_of_type,type,term_int_head),new_env),result);
1252 1252 }
1253 1253  
1254 1254  
... ... @@ -1257,7 +1257,7 @@ Expr of_type_interpretations(Expr lc,
1257 1257 {
1258 1258 err_line_col(lc);
1259 1259 fprintf(errfile,
1260   - msgtext_incompatible_explicit_type[language]);
  1260 + msgtext_incompatible_explicit_type[language]);
1261 1261 show_type(errfile,type,env);
1262 1262 fprintf(errfile,
1263 1263 msgtext_incompatible_explicit_type_2[language]);
... ... @@ -1273,10 +1273,10 @@ Expr of_type_interpretations(Expr lc,
1273 1273  
1274 1274 #ifdef toto
1275 1275 Expr type_rep_interpretations(Expr lc,
1276   - Expr type,
1277   - Expr ctxt,
1278   - Expr env,
1279   - Expr tvs)
  1276 + Expr type,
  1277 + Expr ctxt,
  1278 + Expr env,
  1279 + Expr tvs)
1280 1280 {
1281 1281 /* check type */
1282 1282 if (!check_explicit_type(lc,type,tvs)) return nil;
... ... @@ -1291,9 +1291,9 @@ Expr type_rep_interpretations(Expr lc,
1291 1291  
1292 1292 /* Computing interpretations of the function of an applicative term */
1293 1293 Expr func_interpretations(Expr lc,
1294   - Expr ttype, /* required type */
  1294 + Expr ttype, /* required type */
1295 1295 Expr op, /* <term> */
1296   - int arity, /* required arity */
  1296 + int arity, /* required arity */
1297 1297 Expr ctxt,
1298 1298 Expr env,
1299 1299 Expr tvs)
... ... @@ -1312,11 +1312,11 @@ Expr func_interpretations(Expr lc,
1312 1312 type = type_from_interpretation(car(car(aux)),cdr(car(aux)));
1313 1313 dereference_type(type,cdr(car(aux)));
1314 1314 if (consp(type) &&
1315   - ( ((car(type) == functype) && length(second(type)) == arity)
  1315 + ( ((car(type) == functype) && length(second(type)) == arity)
1316 1316 || ((car(type) == type_MVar) && arity == 1)
1317 1317 )
1318 1318 )
1319   - result = cons(car(aux),result);
  1319 + result = cons(car(aux),result);
1320 1320 aux = cdr(aux);
1321 1321 }
1322 1322  
... ... @@ -1325,8 +1325,8 @@ Expr func_interpretations(Expr lc,
1325 1325 {
1326 1326 err_line_col(lc);
1327 1327 fprintf(errfile,
1328   - msgtext_not_a_function_of_arity[language],
1329   - arity);
  1328 + msgtext_not_a_function_of_arity[language],
  1329 + arity);
1330 1330 //debug(ints);
1331 1331 show_interpretations_types(errfile,ints);
1332 1332 }
... ... @@ -1472,12 +1472,12 @@ Expr lambda_interpretations (Expr lc,
1472 1472 Finally, we just have to concatenate these results. */
1473 1473  
1474 1474 Expr app_interpretations(Expr lc,
1475   - Expr ttype, /* required type */
1476   - Expr op, /* <term> */
1477   - Expr args, /* <terms> */
1478   - Expr ctxt,
1479   - Expr env,
1480   - Expr tvs)
  1475 + Expr ttype, /* required type */
  1476 + Expr op, /* <term> */
  1477 + Expr args, /* <terms> */
  1478 + Expr ctxt,
  1479 + Expr env,
  1480 + Expr tvs)
1481 1481 {
1482 1482 Expr op_ints, args_ints, ctxts, result, aux;
1483 1483 int arity = length(args);
... ... @@ -1509,12 +1509,12 @@ Expr app_interpretations(Expr lc,
1509 1509 while (consp(aux))
1510 1510 {
1511 1511 /* TODO: transmit ($1,...,$k), args, ctxts, env and tvs,
1512   - instead. app_interpretations_1 has to be rewritten. */
  1512 + instead. app_interpretations_1 has to be rewritten. */
1513 1513 result = append(app_interpretations_1(lc,
1514   - car(car(aux)),
1515   - cdr(car(aux)),
1516   - args_ints),
1517   - result);
  1514 + car(car(aux)),
  1515 + cdr(car(aux)),
  1516 + args_ints),
  1517 + result);
1518 1518 aux = cdr(aux);
1519 1519 }
1520 1520  
... ... @@ -1524,17 +1524,17 @@ Expr app_interpretations(Expr lc,
1524 1524 int n = 1;
1525 1525 err_line_col(lc);
1526 1526 fprintf(errfile,
1527   - msgtext_incompatible_args[language]);
  1527 + msgtext_incompatible_args[language]);
1528 1528 show_interpretations_types(errfile,op_ints);
1529 1529 fprintf(errfile,msgtext_args_interpretations[language]);
1530 1530 // show_tuple_interpretations_types(errfile,args_ints);
1531 1531 while (consp(args))
1532   - {
1533   - fprintf(errfile,msgtext_argument_number[language],n++);
1534   - show_interpretations_types(errfile,
1535   - term_interpretations(dummy,car(args),ctxt,env,tvs));
  1532 + {
  1533 + fprintf(errfile,msgtext_argument_number[language],n++);
  1534 + show_interpretations_types(errfile,
  1535 + term_interpretations(dummy,car(args),ctxt,env,tvs));
1536 1536 args = cdr(args);
1537   - }
  1537 + }
1538 1538 fprintf(errfile,"\n");
1539 1539 }
1540 1540  
... ... @@ -1558,9 +1558,9 @@ Expr app_interpretations_1(Expr lc,
1558 1558 /* Computing the interpretations of an applicative term, for a given
1559 1559 interpretation of the operation */
1560 1560 Expr app_interpretations_1(Expr lc,
1561   - Expr op_int_head,
1562   - Expr op_int_env,
1563   - Expr args_ints)
  1561 + Expr op_int_head,
  1562 + Expr op_int_env,
  1563 + Expr args_ints)
1564 1564 {
1565 1565 Expr new_env, args_int_heads, args_int_env, args_types, aux, sign, func_type;
1566 1566 Expr result = nil;
... ... @@ -1698,14 +1698,14 @@ Expr app_interpretations_1(Expr lc,
1698 1698  
1699 1699  
1700 1700 Expr with_interpretations(Expr keyword, /* with */
1701   - Expr lc,
1702   - Expr ttype,
1703   - Expr symbol,
1704   - Expr value,
1705   - Expr body,
1706   - Expr ctxt,
1707   - Expr env,
1708   - Expr tvs)
  1701 + Expr lc,
  1702 + Expr ttype,
  1703 + Expr symbol,
  1704 + Expr value,
  1705 + Expr body,
  1706 + Expr ctxt,
  1707 + Expr env,
  1708 + Expr tvs)
1709 1709 {
1710 1710 Expr value_ints, body_ints, result;
1711 1711  
... ... @@ -1726,9 +1726,9 @@ Expr with_interpretations(Expr keyword, /* with */
1726 1726 possibly unknown types */
1727 1727 value_ints = term_interpretations(dummy,
1728 1728 value,
1729   - ctxt,
1730   - env,
1731   - tvs);
  1729 + ctxt,
  1730 + env,
  1731 + tvs);
1732 1732 if (value_ints == nil) return nil;
1733 1733  
1734 1734 if (length(value_ints) >= 2)
... ... @@ -1736,9 +1736,9 @@ Expr with_interpretations(Expr keyword, /* with */
1736 1736 err_line_col(lc);
1737 1737 fprintf(errfile,
1738 1738 keyword == with
1739   - ? msgtext_ambiguous_local_def[language]
  1739 + ? msgtext_ambiguous_local_def[language]
1740 1740 : msgtext_ambiguous_local_init[language],
1741   - string_content(symbol));
  1741 + string_content(symbol));
1742 1742 show_interpretations_types(errfile,value_ints);
1743 1743 return nil;
1744 1744 }
... ... @@ -1746,14 +1746,14 @@ Expr with_interpretations(Expr keyword, /* with */
1746 1746 /* expand the context for the interpretation of the body */
1747 1747 ctxt =
1748 1748 cons(cons(symbol,type_from_interpretation(car(car(value_ints)),env)),
1749   - ctxt);
  1749 + ctxt);
1750 1750  
1751 1751 /* interpret the body */
1752 1752 body_ints = term_interpretations(dummy,
1753 1753 body,
1754   - ctxt, /* new context */
1755   - cdr(car(value_ints)), /* new environment */
1756   - tvs);
  1754 + ctxt, /* new context */
  1755 + cdr(car(value_ints)), /* new environment */
  1756 + tvs);
1757 1757 if (body_ints == nil) return nil;
1758 1758  
1759 1759 /* construct the resulting interpretations list. Each interpretation
... ... @@ -1766,13 +1766,13 @@ Expr with_interpretations(Expr keyword, /* with */
1766 1766 while (consp(body_ints))
1767 1767 {
1768 1768 result =
1769   - cons(cons(mcons5(keyword,
1770   - lc,
1771   - symbol,
1772   - car(car(value_ints)),
1773   - car(car(body_ints))),
1774   - cdr(car(body_ints))),
1775   - result);
  1769 + cons(cons(mcons5(keyword,
  1770 + lc,
  1771 + symbol,
  1772 + car(car(value_ints)),
  1773 + car(car(body_ints))),
  1774 + cdr(car(body_ints))),
  1775 + result);
1776 1776 body_ints = cdr(body_ints);
1777 1777 }
1778 1778  
... ... @@ -1786,11 +1786,11 @@ Expr with_interpretations(Expr keyword, /* with */
1786 1786 /* test_interpertation returns either nil, or the unique interpretation
1787 1787 of a term supposed to be the test of a conditional. */
1788 1788 static Expr test_interpretation(Expr lc,
1789   - Expr test,
1790   - Expr ctxt,
1791   - Expr env,
1792   - Expr tvs,
1793   - Expr *already_refreshed_addr)
  1789 + Expr test,
  1790 + Expr ctxt,
  1791 + Expr env,
  1792 + Expr tvs,
  1793 + Expr *already_refreshed_addr)
1794 1794 {
1795 1795 Expr test_ints, aux, aux2, aux3, test_int_head, test_type;
1796 1796 struct Type_struct *tt;
... ... @@ -1809,10 +1809,10 @@ static Expr test_interpretation(Expr lc,
1809 1809 aux3 = type_from_interpretation(car(car(aux)),cdr(car(aux)));
1810 1810 if (
1811 1811 !is_functional_type(aux3)
1812   - && !is_primitive_type(aux3)
1813   - && !is_address_type(aux3)
  1812 + && !is_primitive_type(aux3)
  1813 + && !is_address_type(aux3)
1814 1814 )
1815   - aux2 = cons(car(aux),aux2);
  1815 + aux2 = cons(car(aux),aux2);
1816 1816 aux = cdr(aux);
1817 1817 }
1818 1818 if (aux2 == nil)
... ... @@ -1820,7 +1820,7 @@ static Expr test_interpretation(Expr lc,
1820 1820 /* test has only non sum interpretations */
1821 1821 err_line_col(lc);
1822 1822 fprintf(errfile,
1823   - msgtext_test_is_not_a_sum[language]);
  1823 + msgtext_test_is_not_a_sum[language]);
1824 1824 show_interpretations_types(errfile,test_ints);
1825 1825 return nil;
1826 1826 }
... ... @@ -1830,8 +1830,8 @@ static Expr test_interpretation(Expr lc,
1830 1830 {
1831 1831 err_line_col(lc);
1832 1832 fprintf(errfile,
1833   - msgtext_test_has_several_interpretations[language],
1834   - i);
  1833 + msgtext_test_has_several_interpretations[language],
  1834 + i);
1835 1835 show_interpretations_types(errfile,test_ints);
1836 1836 fprintf(errfile,"\n");
1837 1837 return nil;
... ... @@ -1850,9 +1850,9 @@ static Expr test_interpretation(Expr lc,
1850 1850 {
1851 1851 aux = assoc(test_type,env);
1852 1852 if (aux == key_not_found)
1853   - break;
  1853 + break;
1854 1854 else
1855   - test_type = aux;
  1855 + test_type = aux;
1856 1856 }
1857 1857  
1858 1858 /* type of test cannot be unknown */
... ... @@ -1860,7 +1860,7 @@ static Expr test_interpretation(Expr lc,
1860 1860 {
1861 1861 err_line_col(lc);
1862 1862 fprintf(errfile,
1863   - msgtext_test_type_unknown[language]);
  1863 + msgtext_test_type_unknown[language]);
1864 1864 return nil;
1865 1865 }
1866 1866  
... ... @@ -1869,8 +1869,8 @@ static Expr test_interpretation(Expr lc,
1869 1869 {
1870 1870 err_line_col(lc);
1871 1871 fprintf(errfile,
1872   - msgtext_test_type_is_parameter[language],
1873   - utvar_name(test_type));
  1872 + msgtext_test_type_is_parameter[language],
  1873 + utvar_name(test_type));
1874 1874 return nil;
1875 1875 }
1876 1876  
... ... @@ -1883,7 +1883,7 @@ static Expr test_interpretation(Expr lc,
1883 1883 {
1884 1884 err_line_col(lc);
1885 1885 fprintf(errfile,
1886   - msgtext_test_type_not_complete[language]);
  1886 + msgtext_test_type_not_complete[language]);
1887 1887 return nil;
1888 1888 }
1889 1889  
... ... @@ -1891,9 +1891,9 @@ static Expr test_interpretation(Expr lc,
1891 1891 if (consp(test_type))
1892 1892 {
1893 1893 env = unify(refresh(tt->parms,already_refreshed_addr),
1894   - nil,
1895   - cdr(cdr(test_type)),
1896   - env);
  1894 + nil,
  1895 + cdr(cdr(test_type)),
  1896 + env);
1897 1897 assert(env != not_unifiable);
1898 1898 }
1899 1899  
... ... @@ -1928,12 +1928,12 @@ static Expr test_interpretation(Expr lc,
1928 1928 Finally, we construct the list of interpretations of the conditional. */
1929 1929  
1930 1930 Expr cond_interpretations(Expr lc,
1931   - Expr ttype,
1932   - Expr test,
1933   - Expr clauses,
1934   - Expr ctxt,
1935   - Expr env,
1936   - Expr tvs)
  1931 + Expr ttype,
  1932 + Expr test,
  1933 + Expr clauses,
  1934 + Expr ctxt,
  1935 + Expr env,
  1936 + Expr tvs)
1937 1937 {
1938 1938 Expr test_int_head, test_type, test_type_name, result, aux, alts;
1939 1939 int nclauses, nalt, i, j, k;
... ... @@ -1967,10 +1967,10 @@ Expr cond_interpretations(Expr lc,
1967 1967 /* alts have been obtained from the type description of the type of the test. alts has
1968 1968 the form:
1969 1969  
1970   - (
1971   - ((<sym>...) (<type> . <sym name>) ...)
1972   - ...
1973   - )
  1970 + (
  1971 + ((<sym>...) (<type> . <sym name>) ...)
  1972 + ...
  1973 + )
1974 1974  
1975 1975 The types in alts should be unified with the types in test_type.
1976 1976  
... ... @@ -1985,8 +1985,8 @@ Expr cond_interpretations(Expr lc,
1985 1985 err_line_col(lc);
1986 1986 fprintf(errfile,
1987 1987 msgtext_wrong_number_of_cases[language],
1988   - nclauses,
1989   - nalt);
  1988 + nclauses,
  1989 + nalt);
1990 1990 //show_type(errfile,test_type,env);
1991 1991 fprintf(errfile,"\n");
1992 1992 show_alts(errfile,alts,env);
... ... @@ -2007,99 +2007,107 @@ Expr cond_interpretations(Expr lc,
2007 2007  
2008 2008 /* check constructor name */
2009 2009 if (!member(car(car(car(clauses))),
2010   - car(car(alts)) ))
2011   - {
2012   - err_line_col(lc);
2013   - fprintf(errfile,
  2010 +
  2011 + car(car(alts)) ))
  2012 + {
  2013 + err_line_col(lc);
  2014 + fprintf(errfile,
2014 2015 msgtext_bad_case_name[language],
2015   - i,
2016   - string_content(car(car(car(clauses)))));
  2016 + i,
  2017 + string_content(car(car(car(clauses)))));
2017 2018 show_names(errfile,car(car(alts)) );
2018   - fprintf(errfile,"\n\n");
2019   - return nil;
2020   - }
2021   -
  2019 + fprintf(errfile,"\n\n");
  2020 + return nil;
  2021 + }
2022 2022  
2023 2023 //debug(car(car(clauses)));
2024 2024  
2025 2025 /* check constructor arity */
2026 2026 if ((j = length(cdr(car(alts))) )
2027   - != (k = length(cdr(car(car(clauses))))))
2028   - {
2029   - err_line_col(lc);
2030   - fprintf(errfile,
  2027 + != (k = length(cdr(car(car(clauses))))))
  2028 + {
  2029 + err_line_col(lc);
  2030 + fprintf(errfile,
2031 2031 msgtext_wrong_number_of_resurgent_variables[language],
2032   - i,
2033   - k,
2034   - j);
  2032 + i,
  2033 + k,
  2034 + j);
2035 2035 show_typed_resurgent_symbols(errfile,car(alts),env);
2036 2036 fprintf(errfile,"\n");
2037   - return nil;
2038   - }
  2037 + return nil;
  2038 + }
2039 2039  
2040 2040 /* record clause head, adding resurgent variables types.
2041 2041 Each clause head has the form:
2042 2042  
2043   - (<name> <sym> ... <sym>)
  2043 + (<name> <sym> ... <sym>)
2044 2044  
2045 2045 transform it into
2046 2046  
2047   - (<name> (<sym> . <type>) ... (<sym> . <type>))
  2047 + (<name> (<sym> . <type>) ... (<sym> . <type>))
2048 2048  
2049 2049 For 'else' case, keep 'else_case'.
2050 2050  
2051   - */
  2051 + */
2052 2052 if (car(car(clauses)) == else_case)
2053   - {
2054   - clauses_heads = cons(else_case,clauses_heads);
2055   - }
  2053 + {
  2054 + clauses_heads = cons(else_case,clauses_heads);
  2055 + }
2056 2056 else
2057   - {
2058   - aux = cdr(car(alts)); /* ((<type> . <destructor name>) ... ) */
2059   - aux2 = nil;
2060   - aux3 = cdr(car(car(clauses))); /* (<var name> ... <var name>) */
  2057 + {
  2058 + aux = cdr(car(alts)); /* ((<type> . <destructor name>) ... ) [components of alt] */
  2059 + aux2 = nil; /* ((<resur sym> . <type>) ... ) */
  2060 + aux3 = cdr(car(car(clauses))); /* (<var name> ... <var name>) [resurgent symbols] */
2061 2061 j = 1;
2062   - while (consp(aux))
2063   - {
2064   - /* at this point, car(car(aux)) is the type of the resurgent variable as it
  2062 + while (consp(aux))
  2063 + {
  2064 + /* at this point, car(car(aux)) is the type of the resurgent variable as it
2065 2065 is declared in the type definition.
2066   - */
  2066 + */
2067 2067  
2068   - /* if the resurgent symbol has a type declared, this type must be identical
  2068 + /* if the resurgent symbol has a type declared, this type must unify with
2069 2069 to the type declared in the type definition. */
2070 2070 if (consp(car(aux3)))
2071   - {
2072   - Expr drstype = car(car(aux3)); // declared type of resurgent symbol
2073   - Expr ctype = car(car(aux));
2074   - if (!same_type(drstype,env,ctype,env))
2075   - {
2076   - err_line_col(lc);
2077   - fprintf(errfile,
2078   - msgtext_wrong_resurgent_symbol_type_declaration1[language],i,j);
2079   - show_type(errfile,drstype,env);
2080   - fprintf(errfile,
2081   - msgtext_wrong_resurgent_symbol_type_declaration2[language]);
2082   - show_type(errfile,ctype,env);
2083   - fprintf(errfile,"\n\n");
2084   - return nil;
2085   - }
2086   - }
2087   -
2088   - aux2 = cons(cons(consp(car(aux3)) ?
2089   - cdr(car(aux3)) :
2090   - car(aux3),
  2071 + {
  2072 + Expr drstype = car(car(aux3)); // declared type of resurgent symbol
  2073 + Expr ctype = car(car(aux));
  2074 + Expr new_env = unify(drstype,env,ctype,env);
  2075 + if (new_env == not_unifiable)
  2076 + {
  2077 + err_line_col(lc);
  2078 + fprintf(errfile,
  2079 + msgtext_wrong_resurgent_symbol_type_declaration1[language],i,j);
  2080 + show_type(errfile,drstype,env);
  2081 + fprintf(errfile,
  2082 + msgtext_wrong_resurgent_symbol_type_declaration2[language]);
  2083 + show_type(errfile,ctype,env);
  2084 + fprintf(errfile,"\n\n");
  2085 + return nil;
  2086 + }
  2087 + else
  2088 + {
  2089 + env = new_env;
  2090 + }
  2091 + }
  2092 +
  2093 + aux2 = cons(cons(consp(car(aux3)) ?
  2094 + cdr(car(aux3)) :
  2095 + car(aux3),
2091 2096 car(car(aux))),
2092   - aux2);
2093   - aux = cdr(aux);
2094   - aux3 = cdr(aux3);
  2097 +
  2098 + aux2);
  2099 + aux = cdr(aux);
  2100 + aux3 = cdr(aux3);
2095 2101 j++;
2096   - }
2097   - aux2 = hard_reverse(aux2);
  2102 + }
  2103 + aux2 = hard_reverse(aux2); /* ((<resur sym> . <type>) ... ) */
  2104 +
  2105 +
  2106 + clauses_heads = cons(cons(car(car(car(clauses))), /* name of case */
  2107 + aux2), /* typed resurgent symbols */
  2108 + clauses_heads);
  2109 + }
2098 2110  
2099   - clauses_heads = cons(cons(car(car(car(clauses))),
2100   - aux2),
2101   - clauses_heads);
2102   - }
2103 2111  
2104 2112 /* construct context for body interpretations */
2105 2113 new_seg = nil;
... ... @@ -2107,12 +2115,14 @@ Expr cond_interpretations(Expr lc,
2107 2115 aux = cdr(car(car(clauses))); /* (<var> ... <var>) */
2108 2116 aux2 = cdr(car(alts)); /* ((<type> . <sym>) ... ) */
2109 2117 while (consp(aux))
2110   - {
  2118 +
  2119 + {
  2120 +
2111 2121 Expr sym = consp(car(aux)) ? cdr(car(aux)) : car(aux);
2112 2122  
2113   - new_seg = cons(cons(sym,
2114   - car(car(aux2))),
2115   - new_seg);
  2123 + new_seg = cons(cons(sym,
  2124 + car(car(aux2))),
  2125 + new_seg);
2116 2126  
2117 2127 if (no_preemption)
2118 2128 {
... ... @@ -2127,10 +2137,10 @@ Expr cond_interpretations(Expr lc,
2127 2137 }
2128 2138 }
2129 2139  
2130   - aux = cdr(aux);
2131   - aux2 = cdr(aux2);
2132   - j++;
2133   - }
  2140 + aux = cdr(aux);
  2141 + aux2 = cdr(aux2);
  2142 + j++;
  2143 + }
2134 2144 ctxts = cons(rappend(new_seg,ctxt),ctxts);
2135 2145  
2136 2146 /* record body of clause */
... ... @@ -2211,16 +2221,16 @@ Expr cond_interpretations(Expr lc,
2211 2221 int n = 1;
2212 2222 err_line_col(lc);
2213 2223 fprintf(errfile,
2214   - msgtext_cannot_interpret_cond_bodies[language]);
  2224 + msgtext_cannot_interpret_cond_bodies[language]);
2215 2225 // show_tuple_interpretations_types(errfile,aux2);
2216 2226 while (consp(bodies))
2217   - {
2218   - fprintf(errfile,msgtext_case[language],n++);
2219   - show_interpretations_types(errfile,
2220   - term_interpretations(dummy,car(bodies),car(ctxts),env,tvs));
2221   - bodies = cdr(bodies);
2222   - ctxts = cdr(ctxts);
2223   - }
  2227 + {
  2228 + fprintf(errfile,msgtext_case[language],n++);
  2229 + show_interpretations_types(errfile,
  2230 + term_interpretations(dummy,car(bodies),car(ctxts),env,tvs));
  2231 + bodies = cdr(bodies);
  2232 + ctxts = cdr(ctxts);
  2233 + }
2224 2234 return nil;
2225 2235 }
2226 2236  
... ... @@ -2235,14 +2245,14 @@ Expr cond_interpretations(Expr lc,
2235 2245 aux2 = clauses_heads;
2236 2246 clauses_int = nil;
2237 2247 while (consp(aux))
2238   - {
2239   - clauses_int = cons(mcons3(car(aux2), /* head */
2240   - new_integer(0), /* lc */
2241   - car(aux)), /* body */
2242   - clauses_int);
2243   - aux = cdr(aux);
2244   - aux2 = cdr(aux2);
2245   - }
  2248 + {
  2249 + clauses_int = cons(mcons3(car(aux2), /* head */
  2250 + new_integer(0), /* lc */
  2251 + car(aux)), /* body */
  2252 + clauses_int);
  2253 + aux = cdr(aux);
  2254 + aux2 = cdr(aux2);
  2255 + }
2246 2256 clauses_int = hard_reverse(clauses_int);
2247 2257  
2248 2258 /* store interpretation of conditional */
... ... @@ -2289,9 +2299,9 @@ static Expr matched_alternative
2289 2299 while (consp(typed_resurg))
2290 2300 {
2291 2301 if (consp(car(typed_resurg)))
2292   - case_types = cons(car(car(typed_resurg)),case_types);
  2302 + case_types = cons(car(car(typed_resurg)),case_types);
2293 2303 else
2294   - case_types = cons(fresh_unknown(),case_types);
  2304 + case_types = cons(fresh_unknown(),case_types);
2295 2305 typed_resurg = cdr(typed_resurg);
2296 2306 }
2297 2307  
... ... @@ -2312,9 +2322,9 @@ static Expr matched_alternative
2312 2322  
2313 2323 static int select_alternative(Expr lc,
2314 2324 Expr alts, /* refreshed alts */
2315   - Expr constructor_name,
2316   - Expr typed_resurg,
2317   - Expr *env_addr)
  2325 + Expr constructor_name,
  2326 + Expr typed_resurg,
  2327 + Expr *env_addr)
2318 2328 {
2319 2329 int i = 0;
2320 2330 Expr first_alt = nil;
... ... @@ -2325,9 +2335,9 @@ static int select_alternative(Expr lc,
2325 2335 while (consp(alts) && first_alt == nil)
2326 2336 {
2327 2337 if ((new_env = matched_alternative(car(alts),constructor_name,typed_resurg,*env_addr))
2328   - != not_unifiable)
2329   - /* a first alternative has been found */
2330   - first_alt = cons(new_integer(i),car(alts));
  2338 + != not_unifiable)
  2339 + /* a first alternative has been found */
  2340 + first_alt = cons(new_integer(i),car(alts));
2331 2341 alts = cdr(alts);
2332 2342 i++;
2333 2343 }
... ... @@ -2337,40 +2347,40 @@ static int select_alternative(Expr lc,
2337 2347 /* no alternative has been found */
2338 2348 err_line_col(lc);
2339 2349 fprintf(errfile,
2340   - msgtext_no_alt_match[language]);
  2350 + msgtext_no_alt_match[language]);
2341 2351 return -1;
2342 2352 }
2343 2353 else
2344 2354 {
2345 2355 /* a first alternative has been found. Try to find others */
2346 2356 while (consp(alts))
2347   - {
2348   - if (matched_alternative(car(alts),constructor_name,typed_resurg,*env_addr) != not_unifiable)
2349   - other_alts = cons(cons(new_integer(i),car(alts)),other_alts);
2350   - alts = cdr(alts);
2351   - i++;
2352   - }
  2357 + {
  2358 + if (matched_alternative(car(alts),constructor_name,typed_resurg,*env_addr) != not_unifiable)
  2359 + other_alts = cons(cons(new_integer(i),car(alts)),other_alts);
  2360 + alts = cdr(alts);
  2361 + i++;
  2362 + }
2353 2363  
2354 2364 if (other_alts == nil)
2355   - {
2356   - /* there is one and only one matching alternative: success */
2357   - *env_addr = new_env;
2358   - return integer_value(car(first_alt));
2359   - }
  2365 + {
  2366 + /* there is one and only one matching alternative: success */
  2367 + *env_addr = new_env;
  2368 + return integer_value(car(first_alt));
  2369 + }
2360 2370 else
2361   - {
2362   - /* other_alts is ((i . alt) ...) */
2363   -
2364   - /* get all matching alternatives */
2365   - other_alts = cons(first_alt,other_alts);
2366   - err_line_col(lc);
2367   - fprintf(errfile,
2368   - msgtext_several_alt_matches[language]);
2369   - show_alternatives(errfile,other_alts);
2370   - fprintf(errfile,msgtext_several_alt_matches_2[language]);
2371   - fprintf(errfile,"\n");
2372   - return -1;
2373   - }
  2371 + {
  2372 + /* other_alts is ((i . alt) ...) */
  2373 +
  2374 + /* get all matching alternatives */
  2375 + other_alts = cons(first_alt,other_alts);
  2376 + err_line_col(lc);
  2377 + fprintf(errfile,
  2378 + msgtext_several_alt_matches[language]);
  2379 + show_alternatives(errfile,other_alts);
  2380 + fprintf(errfile,msgtext_several_alt_matches_2[language]);
  2381 + fprintf(errfile,"\n");
  2382 + return -1;
  2383 + }
2374 2384 }
2375 2385 }
2376 2386  
... ... @@ -2379,14 +2389,14 @@ static int select_alternative(Expr lc,
2379 2389  
2380 2390  
2381 2391 Expr select_cond_interpretations (Expr lc,
2382   - Expr test,
2383   - Expr constructor_name,
2384   - Expr typed_resurg,
2385   - Expr case_body,
2386   - Expr else_term,
2387   - Expr ctxt,
2388   - Expr env,
2389   - Expr tvs)
  2392 + Expr test,
  2393 + Expr constructor_name,
  2394 + Expr typed_resurg,
  2395 + Expr case_body,
  2396 + Expr else_term,
  2397 + Expr ctxt,
  2398 + Expr env,
  2399 + Expr tvs)
2390 2400 {
2391 2401 Expr already_refreshed = nil;
2392 2402 Expr aux, test_int_head, test_type, test_type_name, alts, alt, new_ctxt;
... ... @@ -2417,7 +2427,7 @@ Expr select_cond_interpretations (Expr lc,
2417 2427 {
2418 2428 err_line_col(lc);
2419 2429 fprintf(errfile,
2420   - msgtext_select_cond_with_one_alternative[language]);
  2430 + msgtext_select_cond_with_one_alternative[language]);
2421 2431 return nil;
2422 2432 }
2423 2433  
... ... @@ -2438,8 +2448,8 @@ Expr select_cond_interpretations (Expr lc,
2438 2448 {
2439 2449 Expr sym = consp(car(aux2)) ? cdr(car(aux2)) : car(aux2);
2440 2450 new_seg = cons(cons(sym,
2441   - car(car(aux))), /* type of symbol */
2442   - new_seg);
  2451 + car(car(aux))), /* type of symbol */
  2452 + new_seg);
2443 2453  
2444 2454  
2445 2455 if (no_preemption)
... ... @@ -2467,10 +2477,10 @@ Expr select_cond_interpretations (Expr lc,
2467 2477 and else term. */
2468 2478  
2469 2479 terms_ints = tuple_interpretations(list2(dummy,dummy),
2470   - list2(case_body,else_term),
2471   - list2(new_ctxt,ctxt),
2472   - env,
2473   - tvs,
  2480 + list2(case_body,else_term),
  2481 + list2(new_ctxt,ctxt),
  2482 + env,
  2483 + tvs,
2474 2484 0/*1*/); /* must have same type */
2475 2485 if (terms_ints == nil) return nil;
2476 2486  
... ... @@ -2482,25 +2492,25 @@ Expr select_cond_interpretations (Expr lc,
2482 2492 while (consp(aux))
2483 2493 {
2484 2494 Expr env2 = unify(type_from_interpretation(car(car(car(aux))),cdr(car(aux))),
2485   - cdr(car(aux)),
2486   - type_from_interpretation(second(car(car(aux))),cdr(car(aux))),
2487   - nil);
  2495 + cdr(car(aux)),
  2496 + type_from_interpretation(second(car(car(aux))),cdr(car(aux))),
  2497 + nil);
2488 2498 if (env2 != not_unifiable)
2489   - terms_ints = cons(cons(car(car(aux)),env2),terms_ints);
  2499 + terms_ints = cons(cons(car(car(aux)),env2),terms_ints);
2490 2500 aux = cdr(aux);
2491 2501 }
2492 2502 if (terms_ints == nil)
2493 2503 {
2494 2504 err_line_col(lc);
2495 2505 fprintf(errfile,
2496   - msgtext_select_cond_incompatible_types[language]);
  2506 + msgtext_select_cond_incompatible_types[language]);
2497 2507 // show_tuple_interpretations_types(errfile,aux2);
2498 2508 fprintf(errfile,msgtext_case_term[language]);
2499 2509 show_interpretations_types(errfile,
2500   - term_interpretations(dummy,case_body,new_ctxt,env,tvs));
  2510 + term_interpretations(dummy,case_body,new_ctxt,env,tvs));
2501 2511 fprintf(errfile,msgtext_else_term[language]);
2502 2512 show_interpretations_types(errfile,
2503   - term_interpretations(dummy,else_term,ctxt,env,tvs));
  2513 + term_interpretations(dummy,else_term,ctxt,env,tvs));
2504 2514 return nil;
2505 2515 }
2506 2516  
... ... @@ -2518,17 +2528,17 @@ Expr select_cond_interpretations (Expr lc,
2518 2528 {
2519 2529 /* compute <clause head> */
2520 2530 aux = cons(car(car(alt)), /* name of alternative */
2521   - new_seg);
  2531 + new_seg);
2522 2532  
2523 2533 result = cons(cons(mcons7(select_cond_interp,
2524   - lc,
2525   - test_int_head,
2526   - new_integer(i),
2527   - aux,
2528   - car(car(car(terms_ints))),
2529   - second(car(car(terms_ints)))),
2530   - cdr(car(terms_ints))),
2531   - result);
  2534 + lc,
  2535 + test_int_head,
  2536 + new_integer(i),
  2537 + aux,
  2538 + car(car(car(terms_ints))),
  2539 + second(car(car(terms_ints)))),
  2540 + cdr(car(terms_ints))),
  2541 + result);
2532 2542 terms_ints = cdr(terms_ints);
2533 2543 }
2534 2544  
... ... @@ -2545,7 +2555,7 @@ Expr select_cond_interpretations (Expr lc,
2545 2555 which are acceptable as a readable connection (including local
2546 2556 variables) */
2547 2557 Expr select_readable_connection_interpretations(Expr lc,
2548   - Expr conn_ints)
  2558 + Expr conn_ints)
2549 2559 {
2550 2560 Expr result, aux;
2551 2561  
... ... @@ -2557,7 +2567,7 @@ Expr select_readable_connection_interpretations(Expr lc,
2557 2567 (consp(car(car(aux))) && (car(car(car(aux))) == mvar_access)) ||
2558 2568 (is_readable_address_type(type_from_interpretation(car(car(aux)),cdr(car(aux)))))
2559 2569 )
2560   - result = cons(car(aux),result);
  2570 + result = cons(car(aux),result);
2561 2571 aux = cdr(aux);
2562 2572 }
2563 2573  
... ... @@ -2567,7 +2577,7 @@ Expr select_readable_connection_interpretations(Expr lc,
2567 2577 {
2568 2578 err_line_col(lc);
2569 2579 fprintf(errfile,
2570   - msgtext_cannot_interpret_as_readable_connection[language]);
  2580 + msgtext_cannot_interpret_as_readable_connection[language]);
2571 2581 show_interpretations_types(errfile,conn_ints);
2572 2582 return nil;
2573 2583 }
... ... @@ -2580,7 +2590,7 @@ Expr select_readable_connection_interpretations(Expr lc,
2580 2590  
2581 2591  
2582 2592 Expr select_writable_connection_interpretations(Expr lc,
2583   - Expr conn_ints)
  2593 + Expr conn_ints)
2584 2594 {
2585 2595 Expr result, aux;
2586 2596  
... ... @@ -2592,7 +2602,7 @@ Expr select_writable_connection_interpretations(Expr lc,
2592 2602 (consp(car(car(aux))) && (car(car(car(aux))) == mvar_access)) ||
2593 2603 (is_writable_address_type(type_from_interpretation(car(car(aux)),cdr(car(aux)))))
2594 2604 )
2595   - result = cons(car(aux),result);
  2605 + result = cons(car(aux),result);
2596 2606 aux = cdr(aux);
2597 2607 }
2598 2608  
... ... @@ -2602,7 +2612,7 @@ Expr select_writable_connection_interpretations(Expr lc,
2602 2612 {
2603 2613 err_line_col(lc);
2604 2614 fprintf(errfile,
2605   - msgtext_cannot_interpret_as_writable_connection[language]);
  2615 + msgtext_cannot_interpret_as_writable_connection[language]);
2606 2616 show_interpretations_types(errfile,conn_ints);
2607 2617 return nil;
2608 2618 }
... ... @@ -2614,7 +2624,7 @@ Expr select_writable_connection_interpretations(Expr lc,
2614 2624  
2615 2625  
2616 2626 Expr select_exchangeable_connection_interpretations(Expr lc,
2617   - Expr conn_ints)
  2627 + Expr conn_ints)
2618 2628 {
2619 2629 Expr result, aux;
2620 2630  
... ... @@ -2623,9 +2633,9 @@ Expr select_exchangeable_connection_interpretations(Expr lc,
2623 2633 while (consp(aux))
2624 2634 {
2625 2635 Expr conn_type =
2626   - type_from_interpretation(car(car(aux)),cdr(car(aux)));
  2636 + type_from_interpretation(car(car(aux)),cdr(car(aux)));
2627 2637 if (is_exchangeable_address_type(conn_type))
2628   - result = cons(car(aux),result);
  2638 + result = cons(car(aux),result);
2629 2639 aux = cdr(aux);
2630 2640 }
2631 2641  
... ... @@ -2635,7 +2645,7 @@ Expr select_exchangeable_connection_interpretations(Expr lc,
2635 2645 {
2636 2646 err_line_col(lc);
2637 2647 fprintf(errfile,
2638   - msgtext_cannot_interpret_as_exchangeable_connection[language]);
  2648 + msgtext_cannot_interpret_as_exchangeable_connection[language]);
2639 2649 show_interpretations_types(errfile,conn_ints);
2640 2650 return nil;
2641 2651 }
... ... @@ -2651,11 +2661,11 @@ Expr select_exchangeable_connection_interpretations(Expr lc,
2651 2661 term which must represent a readable connection or a local variable.
2652 2662 */
2653 2663 Expr read_interpretations(Expr lc,
2654   - Expr ttype,
2655   - Expr conn,
2656   - Expr ctxt,
2657   - Expr env,
2658   - Expr tvs)
  2664 + Expr ttype,
  2665 + Expr conn,
  2666 + Expr ctxt,
  2667 + Expr env,
  2668 + Expr tvs)
2659 2669 {
2660 2670 Expr aux, conn_ints, result;
2661 2671  
... ... @@ -2674,7 +2684,7 @@ Expr read_interpretations(Expr lc,
2674 2684 while (consp(conn_ints))
2675 2685 {
2676 2686 result =
2677   - cons(cons(mcons3(anb_read,lc,car(car(conn_ints))),cdr(car(conn_ints))),result);
  2687 + cons(cons(mcons3(anb_read,lc,car(car(conn_ints))),cdr(car(conn_ints))),result);
2678 2688 conn_ints = cdr(conn_ints);
2679 2689 }
2680 2690  
... ... @@ -2688,12 +2698,12 @@ Expr read_interpretations(Expr lc,
2688 2698  
2689 2699  
2690 2700 Expr write_interpretations(Expr lc,
2691   - Expr ttype,
2692   - Expr conn, /* connection (including local variables) */
2693   - Expr value,
2694   - Expr ctxt,
2695   - Expr env,
2696   - Expr tvs)
  2701 + Expr ttype,
  2702 + Expr conn, /* connection (including local variables) */
  2703 + Expr value,
  2704 + Expr ctxt,
  2705 + Expr env,
  2706 + Expr tvs)
2697 2707 {
2698 2708 Expr aux, conn_ints, val_ints, result, aux2;
2699 2709 Expr conn_type, val_type, new_env;
... ... @@ -2720,32 +2730,32 @@ Expr write_interpretations(Expr lc,
2720 2730 {
2721 2731 aux2 = val_ints;
2722 2732 while (consp(aux2))
2723   - {
2724   - conn_type =
2725   - type_from_interpretation(car(car(aux)),cdr(car(aux)));
2726   - val_type =
2727   - type_from_interpretation(car(car(aux2)),cdr(car(aux2)));
2728   -
2729   - assert(is_address_type(conn_type)); /* (type_?Addr . T) */
2730   -
2731   - new_env = unify(cdr(conn_type),
2732   - cdr(car(aux)),
2733   - val_type,
2734   - cdr(car(aux2)));
2735   -
2736   - if (new_env != not_unifiable)
2737   - {
2738   - result =
2739   - cons(cons(mcons4(anb_write,
2740   - lc,
2741   - car(car(aux)),
2742   - car(car(aux2))),
2743   - new_env),
2744   - result);
2745   - }
2746   -
2747   - aux2 = cdr(aux2); /* next interpretation of value */
2748   - }
  2733 + {
  2734 + conn_type =
  2735 + type_from_interpretation(car(car(aux)),cdr(car(aux)));
  2736 + val_type =
  2737 + type_from_interpretation(car(car(aux2)),cdr(car(aux2)));
  2738 +
  2739 + assert(is_address_type(conn_type)); /* (type_?Addr . T) */
  2740 +
  2741 + new_env = unify(cdr(conn_type),
  2742 + cdr(car(aux)),
  2743 + val_type,
  2744 + cdr(car(aux2)));
  2745 +
  2746 + if (new_env != not_unifiable)
  2747 + {
  2748 + result =
  2749 + cons(cons(mcons4(anb_write,
  2750 + lc,
  2751 + car(car(aux)),
  2752 + car(car(aux2))),
  2753 + new_env),
  2754 + result);
  2755 + }
  2756 +
  2757 + aux2 = cdr(aux2); /* next interpretation of value */
  2758 + }
2749 2759 aux = cdr(aux); /* next interpretation of 'conn' */
2750 2760 }
2751 2761  
... ... @@ -2753,10 +2763,10 @@ Expr write_interpretations(Expr lc,
2753 2763 {
2754 2764 err_line_col(lc);
2755 2765 fprintf(errfile,
2756   - msgtext_incompatible_write_type[language]);
  2766 + msgtext_incompatible_write_type[language]);
2757 2767 show_interpretations_types(errfile,conn_ints);
2758 2768 fprintf(errfile,
2759   - msgtext_incompatible_write_type2[language]);
  2769 + msgtext_incompatible_write_type2[language]);
2760 2770 show_interpretations_types(errfile,val_ints);
2761 2771 }
2762 2772  
... ... @@ -2766,12 +2776,12 @@ Expr write_interpretations(Expr lc,
2766 2776  
2767 2777  
2768 2778 Expr exchange_interpretations(Expr lc,
2769   - Expr ttype,
2770   - Expr conn, /* connection (including local variables) */
2771   - Expr value,
2772   - Expr ctxt,
2773   - Expr env,
2774   - Expr tvs)
  2779 + Expr ttype,
  2780 + Expr conn, /* connection (including local variables) */
  2781 + Expr value,
  2782 + Expr ctxt,
  2783 + Expr env,
  2784 + Expr tvs)
2775 2785 {
2776 2786 Expr aux, conn_ints, val_ints, result, aux2;
2777 2787 Expr conn_type, val_type, new_env;
... ... @@ -2798,32 +2808,32 @@ Expr exchange_interpretations(Expr lc,
2798 2808 {
2799 2809 aux2 = val_ints;
2800 2810 while (consp(aux2))
2801   - {
2802   - conn_type =
2803   - type_from_interpretation(car(car(aux)),cdr(car(aux)));
2804   - val_type =
2805   - type_from_interpretation(car(car(aux2)),cdr(car(aux2)));
2806   -
2807   - assert(is_address_type(conn_type)); /* (type_?Addr . T) */
2808   -
2809   - new_env = unify(cdr(conn_type),
2810   - cdr(car(aux)),
2811   - val_type,
2812   - cdr(car(aux2)));
2813   -
2814   - if (new_env != not_unifiable)
2815   - {
2816   - result =
2817   - cons(cons(mcons4(anb_exchange,
2818   - lc,
2819   - car(car(aux)),
2820   - car(car(aux2))),
2821   - new_env),
2822   - result);
2823   - }
2824   -
2825   - aux2 = cdr(aux2); /* next interpretation of value */
2826   - }
  2811 + {
  2812 + conn_type =
  2813 + type_from_interpretation(car(car(aux)),cdr(car(aux)));
  2814 + val_type =
  2815 + type_from_interpretation(car(car(aux2)),cdr(car(aux2)));
  2816 +
  2817 + assert(is_address_type(conn_type)); /* (type_?Addr . T) */
  2818 +
  2819 + new_env = unify(cdr(conn_type),
  2820 + cdr(car(aux)),
  2821 + val_type,
  2822 + cdr(car(aux2)));
  2823 +
  2824 + if (new_env != not_unifiable)
  2825 + {
  2826 + result =
  2827 + cons(cons(mcons4(anb_exchange,
  2828 + lc,
  2829 + car(car(aux)),
  2830 + car(car(aux2))),
  2831 + new_env),
  2832 + result);
  2833 + }
  2834 +
  2835 + aux2 = cdr(aux2); /* next interpretation of value */
  2836 + }
2827 2837 aux = cdr(aux); /* next interpretation of 'conn' */
2828 2838 }
2829 2839  
... ... @@ -2831,10 +2841,10 @@ Expr exchange_interpretations(Expr lc,
2831 2841 {
2832 2842 err_line_col(lc);
2833 2843 fprintf(errfile,
2834   - msgtext_incompatible_write_type[language]);
  2844 + msgtext_incompatible_write_type[language]);
2835 2845 show_interpretations_types(errfile,conn_ints);
2836 2846 fprintf(errfile,
2837   - msgtext_incompatible_write_type2[language]);
  2847 + msgtext_incompatible_write_type2[language]);
2838 2848 show_interpretations_types(errfile,val_ints);
2839 2849 }
2840 2850  
... ... @@ -2846,11 +2856,11 @@ Expr exchange_interpretations(Expr lc,
2846 2856  
2847 2857  
2848 2858 Expr connect_file_interpretations(Expr lc,
2849   - Expr type,
2850   - Expr name, /* must be a String */
2851   - Expr ctxt,
2852   - Expr env,
2853   - Expr tvs)
  2859 + Expr type,
  2860 + Expr name, /* must be a String */
  2861 + Expr ctxt,
  2862 + Expr env,
  2863 + Expr tvs)
2854 2864 {
2855 2865 Expr name_ints, string_name_ints, aux;
2856 2866  
... ... @@ -2864,7 +2874,7 @@ Expr connect_file_interpretations(Expr lc,
2864 2874 {
2865 2875 err_line_col(lc);
2866 2876 fprintf(errfile,
2867   - msgtext_invalid_connect_return_type[language]);
  2877 + msgtext_invalid_connect_return_type[language]);
2868 2878 show_type(errfile,type,env);
2869 2879 return nil;
2870 2880 }
... ... @@ -2880,7 +2890,7 @@ Expr connect_file_interpretations(Expr lc,
2880 2890 //debug(cdr(car(aux)));
2881 2891 //debug(type_from_interpretation(car(car(aux)),cdr(car(aux))));
2882 2892 if (type_from_interpretation(car(car(aux)),cdr(car(aux))) == type_String)
2883   - string_name_ints = cons(car(aux),string_name_ints);
  2893 + string_name_ints = cons(car(aux),string_name_ints);
2884 2894 aux = cdr(aux);
2885 2895 }
2886 2896  
... ... @@ -2888,7 +2898,7 @@ Expr connect_file_interpretations(Expr lc,
2888 2898 {
2889 2899 err_line_col(lc);
2890 2900 fprintf(errfile,
2891   - msgtext_connection_name_not_a_string[language]);
  2901 + msgtext_connection_name_not_a_string[language]);
2892 2902 show_interpretations_types(errfile,name_ints);
2893 2903 return nil;
2894 2904 }
... ... @@ -2897,7 +2907,7 @@ Expr connect_file_interpretations(Expr lc,
2897 2907 {
2898 2908 err_line_col(lc);
2899 2909 fprintf(errfile,
2900   - msgtext_ambiguous_connection_name[language]);
  2910 + msgtext_ambiguous_connection_name[language]);
2901 2911 //show_interpretations_types(errfile,string_name_ints);
2902 2912 return nil;
2903 2913 }
... ... @@ -2912,9 +2922,9 @@ Expr connect_file_interpretations(Expr lc,
2912 2922  
2913 2923 return list1(cons(mcons4(aux,
2914 2924 lc,
2915   - type,
  2925 + type,
2916 2926 car(car(string_name_ints))),
2917   - cdr(car(string_name_ints))));
  2927 + cdr(car(string_name_ints))));
2918 2928  
2919 2929 }
2920 2930  
... ... @@ -2922,12 +2932,12 @@ Expr connect_file_interpretations(Expr lc,
2922 2932  
2923 2933  
2924 2934 Expr connect_IP_interpretations(Expr lc,
2925   - Expr type,
2926   - Expr addr, /* must be an Int32 */
2927   - Expr port, /* must be an Int32 */
2928   - Expr ctxt,
2929   - Expr env,
2930   - Expr tvs)
  2935 + Expr type,
  2936 + Expr addr, /* must be an Int32 */
  2937 + Expr port, /* must be an Int32 */
  2938 + Expr ctxt,
  2939 + Expr env,
  2940 + Expr tvs)
2931 2941 {
2932 2942 Expr bi_int_ints, ints, aux;
2933 2943  
... ... @@ -2943,7 +2953,7 @@ Expr connect_IP_interpretations(Expr lc,
2943 2953 {
2944 2954 err_line_col(lc);
2945 2955 fprintf(errfile,
2946   - msgtext_invalid_IP_connect_return_type[language]);
  2956 + msgtext_invalid_IP_connect_return_type[language]);
2947 2957 show_type(errfile,type,env);
2948 2958 fprintf(errfile,"\n");
2949 2959 return nil;
... ... @@ -2960,7 +2970,7 @@ Expr connect_IP_interpretations(Expr lc,
2960 2970 {
2961 2971 if (type_from_interpretation(car(car(car(aux))),cdr(car(aux))) == type_Int32 &&
2962 2972 type_from_interpretation(second(car(car(aux))),cdr(car(aux))) == type_Int32)
2963   - bi_int_ints = cons(car(aux),bi_int_ints);
  2973 + bi_int_ints = cons(car(aux),bi_int_ints);
2964 2974 aux = cdr(aux);
2965 2975 }
2966 2976  
... ... @@ -2968,7 +2978,7 @@ Expr connect_IP_interpretations(Expr lc,
2968 2978 {
2969 2979 err_line_col(lc);
2970 2980 fprintf(errfile,
2971   - msgtext_connection_addr_port_not_ints[language]);
  2981 + msgtext_connection_addr_port_not_ints[language]);
2972 2982 show_tuple_interpretations_types(errfile,ints);
2973 2983 return nil;
2974 2984 }
... ... @@ -2977,7 +2987,7 @@ Expr connect_IP_interpretations(Expr lc,
2977 2987 {
2978 2988 err_line_col(lc);
2979 2989 fprintf(errfile,
2980   - msgtext_ambiguous_connection_addr_port[language]);
  2990 + msgtext_ambiguous_connection_addr_port[language]);
2981 2991 show_tuple_interpretations_types(errfile,bi_int_ints);
2982 2992 return nil;
2983 2993 }
... ... @@ -2994,10 +3004,10 @@ Expr connect_IP_interpretations(Expr lc,
2994 3004  
2995 3005 return list1(cons(mcons5(aux,
2996 3006 lc,
2997   - type,
  3007 + type,
2998 3008 car(car(car(bi_int_ints))),
2999   - second(car(car(bi_int_ints)))),
3000   - cdr(car(bi_int_ints))));
  3009 + second(car(car(bi_int_ints)))),
  3010 + cdr(car(bi_int_ints))));
3001 3011  
3002 3012 }
3003 3013  
... ... @@ -3005,13 +3015,13 @@ Expr connect_IP_interpretations(Expr lc,
3005 3015  
3006 3016  
3007 3017 Expr wait_for_interpretations (Expr lc,
3008   - Expr ttype,
3009   - Expr condition,
  3018 + Expr ttype,
  3019 + Expr condition,
3010 3020 Expr milliseconds,
3011   - Expr after,
3012   - Expr ctxt,
3013   - Expr env,
3014   - Expr tvs)
  3021 + Expr after,
  3022 + Expr ctxt,
  3023 + Expr env,
  3024 + Expr tvs)
3015 3025 {
3016 3026 Expr cond_ints, bool_cond_ints, after_ints, aux, result, ms_ints, int32_ms_ints;
3017 3027  
... ... @@ -3028,7 +3038,7 @@ Expr wait_for_interpretations (Expr lc,
3028 3038 cdr(car(aux)),
3029 3039 pdstr_Bool,
3030 3040 nil))
3031   - bool_cond_ints = cons(car(aux),bool_cond_ints);
  3041 + bool_cond_ints = cons(car(aux),bool_cond_ints);
3032 3042 aux = cdr(aux);
3033 3043 }
3034 3044  
... ... @@ -3037,7 +3047,7 @@ Expr wait_for_interpretations (Expr lc,
3037 3047 {
3038 3048 err_line_col(lc);
3039 3049 fprintf(errfile,
3040   - msgtext_wait_condition_not_boolean[language]);
  3050 + msgtext_wait_condition_not_boolean[language]);
3041 3051 show_interpretations_types(errfile,cond_ints);
3042 3052 return nil;
3043 3053 }
... ... @@ -3047,7 +3057,7 @@ Expr wait_for_interpretations (Expr lc,
3047 3057 {
3048 3058 err_line_col(lc);
3049 3059 fprintf(errfile,
3050   - msgtext_wait_condition_ambiguous[language]);
  3060 + msgtext_wait_condition_ambiguous[language]);
3051 3061 show_simple_ambiguity(errfile,bool_cond_ints);
3052 3062 return nil;
3053 3063 }
... ... @@ -3068,7 +3078,7 @@ Expr wait_for_interpretations (Expr lc,
3068 3078 while (consp(aux))
3069 3079 {
3070 3080 if (type_from_interpretation(car(car(aux)),cdr(car(aux))) == type_Int32)
3071   - int32_ms_ints = cons(car(aux),int32_ms_ints);
  3081 + int32_ms_ints = cons(car(aux),int32_ms_ints);
3072 3082 aux = cdr(aux);
3073 3083 }
3074 3084  
... ... @@ -3077,7 +3087,7 @@ Expr wait_for_interpretations (Expr lc,
3077 3087 {
3078 3088 err_line_col(lc);
3079 3089 fprintf(errfile,
3080   - msgtext_wait_milliseconds_not_integer[language]);
  3090 + msgtext_wait_milliseconds_not_integer[language]);
3081 3091 show_interpretations_types(errfile,ms_ints);
3082 3092 return nil;
3083 3093 }
... ... @@ -3087,7 +3097,7 @@ Expr wait_for_interpretations (Expr lc,
3087 3097 {
3088 3098 err_line_col(lc);
3089 3099 fprintf(errfile,
3090   - msgtext_wait_milliseconds_ambiguous[language]);
  3100 + msgtext_wait_milliseconds_ambiguous[language]);
3091 3101 show_simple_ambiguity(errfile,int32_ms_ints);
3092 3102 return nil;
3093 3103 }
... ... @@ -3107,12 +3117,12 @@ Expr wait_for_interpretations (Expr lc,
3107 3117 {
3108 3118 /* each interpretation head is (wait_for lc Icond Itime . Iafter) */
3109 3119 result = cons(cons(mcons5(wait_for,
3110   - lc,
3111   - car(car(bool_cond_ints)),
  3120 + lc,
  3121 + car(car(bool_cond_ints)),
3112 3122 car(car(int32_ms_ints)),
3113   - car(car(after_ints))),
3114   - cdr(car(after_ints))),
3115   - result);
  3123 + car(car(after_ints))),
  3124 + cdr(car(after_ints))),
  3125 + result);
3116 3126 after_ints = cdr(after_ints);
3117 3127 }
3118 3128 return result;
... ... @@ -3122,12 +3132,12 @@ Expr wait_for_interpretations (Expr lc,
3122 3132  
3123 3133  
3124 3134 Expr delegate_interpretations (Expr lc,
3125   - Expr ttype,
3126   - Expr delegated,
3127   - Expr body,
3128   - Expr ctxt,
3129   - Expr env,
3130   - Expr tvs)
  3135 + Expr ttype,
  3136 + Expr delegated,
  3137 + Expr body,
  3138 + Expr ctxt,
  3139 + Expr env,
  3140 + Expr tvs)
3131 3141 {
3132 3142 /* 'delegate u, v' is correct if 'u' has a unique interpretation of type
3133 3143 'One', and if 'v' may be interpreted. */
... ... @@ -3144,7 +3154,7 @@ Expr delegate_interpretations (Expr lc,
3144 3154 while (consp(aux))
3145 3155 {
3146 3156 if (type_from_interpretation(car(car(aux)),cdr(car(aux))) == pdstr_One)
3147   - one_deleg_ints = cons(car(aux),one_deleg_ints);
  3157 + one_deleg_ints = cons(car(aux),one_deleg_ints);
3148 3158 aux = cdr(aux);
3149 3159 }
3150 3160  
... ... @@ -3153,7 +3163,7 @@ Expr delegate_interpretations (Expr lc,
3153 3163 {
3154 3164 err_line_col(lc);
3155 3165 fprintf(errfile,
3156   - msgtext_delegated_not_one[language]);
  3166 + msgtext_delegated_not_one[language]);
3157 3167 show_interpretations_types(errfile,deleg_ints);
3158 3168 return nil;
3159 3169 }
... ... @@ -3163,7 +3173,7 @@ Expr delegate_interpretations (Expr lc,
3163 3173 {
3164 3174 err_line_col(lc);
3165 3175 fprintf(errfile,
3166   - msgtext_delegated_ambiguous[language]);
  3176 + msgtext_delegated_ambiguous[language]);
3167 3177 show_simple_ambiguity(errfile,one_deleg_ints);
3168 3178 return nil;
3169 3179 }
... ... @@ -3183,11 +3193,11 @@ Expr delegate_interpretations (Expr lc,
3183 3193 {
3184 3194 /* each interpretation head is (delegate lc Ideleg . Ibody) */
3185 3195 result = cons(cons(mcons4(delegate,
3186   - lc,
3187   - car(car(one_deleg_ints)),
3188   - car(car(body_ints))),
3189   - cdr(car(body_ints))),
3190   - result);
  3196 + lc,
  3197 + car(car(one_deleg_ints)),
  3198 + car(car(body_ints))),
  3199 + cdr(car(body_ints))),
  3200 + result);
3191 3201 body_ints = cdr(body_ints);
3192 3202 }
3193 3203 return result;
... ... @@ -3197,13 +3207,13 @@ Expr delegate_interpretations (Expr lc,
3197 3207  
3198 3208 #ifdef toto
3199 3209 Expr set_interpretations (Expr lc,
3200   - Expr ttype,
3201   - Expr x,
3202   - Expr type,
3203   - Expr body,
3204   - Expr ctxt,
3205   - Expr env,
3206   - Expr tvs)
  3210 + Expr ttype,
  3211 + Expr x,
  3212 + Expr type,
  3213 + Expr body,
  3214 + Expr ctxt,
  3215 + Expr env,
  3216 + Expr tvs)
3207 3217 {
3208 3218 Expr aux, body_ints, omega_body_ints, result;
3209 3219  
... ... @@ -3219,7 +3229,7 @@ Expr set_interpretations (Expr lc,
3219 3229 while (consp(aux))
3220 3230 {
3221 3231 if (type_from_interpretation(car(car(aux)),cdr(car(aux))) == type_Omega)
3222   - omega_body_ints = cons(car(aux),omega_body_ints);
  3232 + omega_body_ints = cons(car(aux),omega_body_ints);
3223 3233 aux = cdr(aux);
3224 3234 }
3225 3235  
... ... @@ -3228,7 +3238,7 @@ Expr set_interpretations (Expr lc,
3228 3238 {
3229 3239 err_line_col(lc);
3230 3240 fprintf(errfile,
3231   - msgtext_no_omega_interpretation[language]);
  3241 + msgtext_no_omega_interpretation[language]);
3232 3242 show_interpretations_types(errfile,body_ints);
3233 3243 return nil;
3234 3244 }
... ... @@ -3237,7 +3247,7 @@ Expr set_interpretations (Expr lc,
3237 3247 {
3238 3248 err_line_col(lc);
3239 3249 fprintf(errfile,
3240   - msgtext_several_omega_interpretations[language]);
  3250 + msgtext_several_omega_interpretations[language]);
3241 3251 show_interpretations_types(errfile,omega_body_ints);
3242 3252 return nil;
3243 3253 }
... ... @@ -3247,8 +3257,8 @@ Expr set_interpretations (Expr lc,
3247 3257 while (consp(omega_body_ints))
3248 3258 {
3249 3259 result = cons(cons(mcons5(set,lc,x,type,car(car(omega_body_ints))),
3250   - cdr(car(omega_body_ints))),
3251   - result);
  3260 + cdr(car(omega_body_ints))),
  3261 + result);
3252 3262 omega_body_ints = cdr(omega_body_ints);
3253 3263 }
3254 3264  
... ... @@ -3263,8 +3273,8 @@ Expr serialize_interpretations (Expr lc,
3263 3273 Expr ttype,
3264 3274 Expr datum,
3265 3275 Expr ctxt,
3266   - Expr env,
3267   - Expr tvs)
  3276 + Expr env,
  3277 + Expr tvs)
3268 3278 {
3269 3279 Expr datum_ints;
3270 3280  
... ... @@ -3285,7 +3295,7 @@ Expr serialize_interpretations (Expr lc,
3285 3295 {
3286 3296 err_line_col(lc);
3287 3297 fprintf(errfile,
3288   - msgtext_serialize_ambiguous[language]);
  3298 + msgtext_serialize_ambiguous[language]);
3289 3299 show_interpretations_types(errfile,datum_ints);
3290 3300 return nil;
3291 3301 }
... ... @@ -3296,20 +3306,20 @@ Expr serialize_interpretations (Expr lc,
3296 3306  
3297 3307 */
3298 3308 return list1(cons(mcons3(serialize,
3299   - lc,
3300   - car(car(datum_ints))),
3301   - cdr(car(datum_ints))));
  3309 + lc,
  3310 + car(car(datum_ints))),
  3311 + cdr(car(datum_ints))));
3302 3312 }
3303 3313  
3304 3314  
3305 3315  
3306 3316  
3307 3317 Expr unserialize_interpretations (Expr lc,
3308   - Expr ttype,
3309   - Expr bytes,
3310   - Expr ctxt,
3311   - Expr env,
3312   - Expr tvs)
  3318 + Expr ttype,
  3319 + Expr bytes,
  3320 + Expr ctxt,
  3321 + Expr env,
  3322 + Expr tvs)
3313 3323 {
3314 3324 Expr bytes_ints, aux, byte_array_ints;
3315 3325  
... ... @@ -3326,12 +3336,12 @@ Expr unserialize_interpretations (Expr lc,
3326 3336 Expr type = type_from_interpretation(car(car(aux)),cdr(car(aux)));
3327 3337  
3328 3338 new_env = unify(type,
3329   - cdr(car(aux)),
3330   - type_ByteArray,
3331   - nil);
  3339 + cdr(car(aux)),
  3340 + type_ByteArray,
  3341 + nil);
3332 3342 if (new_env != not_unifiable)
3333   - byte_array_ints = cons(cons(car(car(aux)),new_env),
3334   - byte_array_ints);
  3343 + byte_array_ints = cons(cons(car(car(aux)),new_env),
  3344 + byte_array_ints);
3335 3345  
3336 3346 aux = cdr(aux);
3337 3347 }
... ... @@ -3342,7 +3352,7 @@ Expr unserialize_interpretations (Expr lc,
3342 3352 {
3343 3353 err_line_col(lc);
3344 3354 fprintf(errfile,
3345   - msgtext_no_ByteArray_interpretation[language]);
  3355 + msgtext_no_ByteArray_interpretation[language]);
3346 3356 show_interpretations_types(errfile,bytes_ints);
3347 3357 return nil;
3348 3358 }
... ... @@ -3351,7 +3361,7 @@ Expr unserialize_interpretations (Expr lc,
3351 3361 {
3352 3362 err_line_col(lc);
3353 3363 fprintf(errfile,
3354   - msgtext_several_ByteArray_interpretations[language]);
  3364 + msgtext_several_ByteArray_interpretations[language]);
3355 3365 show_interpretations_types(errfile,byte_array_ints);
3356 3366 return nil;
3357 3367 }
... ... @@ -3369,10 +3379,10 @@ Expr unserialize_interpretations (Expr lc,
3369 3379 */
3370 3380  
3371 3381 return list1(cons(mcons4(unserialize,
3372   - lc,
3373   - fresh_unknown(),
3374   - car(car(byte_array_ints))),
3375   - cdr(car(byte_array_ints))));
  3382 + lc,
  3383 + fresh_unknown(),
  3384 + car(car(byte_array_ints))),
  3385 + cdr(car(byte_array_ints))));
3376 3386 }
3377 3387  
3378 3388  
... ...
anubis_dev/compiler/src/lex.yy.c
  Show/Hide comments   View file @e69a754
1 1  
2   -#line 3 "lex.yy.c"
3   -
4   -#define YY_INT_ALIGNED short int
5   -
6 2 /* A lexical scanner generated by flex */
7 3  
  4 +/* Scanner skeleton version:
  5 + * $Header$
  6 + */
  7 +
8 8 #define FLEX_SCANNER
9 9 #define YY_FLEX_MAJOR_VERSION 2
10 10 #define YY_FLEX_MINOR_VERSION 5
11   -#define YY_FLEX_SUBMINOR_VERSION 31
12   -#if YY_FLEX_SUBMINOR_VERSION > 0
13   -#define FLEX_BETA
14   -#endif
15   -
16   -/* First, we deal with platform-specific or compiler-specific issues. */
17 11  
18   -/* begin standard C headers. */
19 12 #include <stdio.h>
20   -#include <string.h>
21 13 #include <errno.h>
22   -#include <stdlib.h>
23   -
24   -/* end standard C headers. */
25   -
26   -/* flex integer type definitions */
27 14  
28   -#ifndef FLEXINT_H
29   -#define FLEXINT_H
30   -
31   -/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
32   -
33   -#if defined __STDC_VERSION__ && __STDC_VERSION__ >= 199901L
34   -#include <inttypes.h>
35   -typedef int8_t flex_int8_t;
36   -typedef uint8_t flex_uint8_t;
37   -typedef int16_t flex_int16_t;
38   -typedef uint16_t flex_uint16_t;
39   -typedef int32_t flex_int32_t;
40   -typedef uint32_t flex_uint32_t;
41   -#else
42   -typedef signed char flex_int8_t;
43   -typedef short int flex_int16_t;
44   -typedef int flex_int32_t;
45   -typedef unsigned char flex_uint8_t;
46   -typedef unsigned short int flex_uint16_t;
47   -typedef unsigned int flex_uint32_t;
48   -#endif /* ! C99 */
49   -
50   -/* Limits of integral types. */
51   -#ifndef INT8_MIN
52   -#define INT8_MIN (-128)
53   -#endif
54   -#ifndef INT16_MIN
55   -#define INT16_MIN (-32767-1)
56   -#endif
57   -#ifndef INT32_MIN
58   -#define INT32_MIN (-2147483647-1)
59   -#endif
60   -#ifndef INT8_MAX
61   -#define INT8_MAX (127)
62   -#endif
63   -#ifndef INT16_MAX
64   -#define INT16_MAX (32767)
65   -#endif
66   -#ifndef INT32_MAX
67   -#define INT32_MAX (2147483647)
68   -#endif
69   -#ifndef UINT8_MAX
70   -#define UINT8_MAX (255U)
71   -#endif
72   -#ifndef UINT16_MAX
73   -#define UINT16_MAX (65535U)
  15 +/* cfront 1.2 defines "c_plusplus" instead of "__cplusplus" */
  16 +#ifdef c_plusplus
  17 +#ifndef __cplusplus
  18 +#define __cplusplus
74 19 #endif
75   -#ifndef UINT32_MAX
76   -#define UINT32_MAX (4294967295U)
77 20 #endif
78 21  
79   -#endif /* ! FLEXINT_H */
80 22  
81 23 #ifdef __cplusplus
82 24  
  25 +#include <stdlib.h>
  26 +#ifndef _WIN32
  27 +#include <unistd.h>
  28 +#endif
  29 +
  30 +/* Use prototypes in function declarations. */
  31 +#define YY_USE_PROTOS
  32 +
83 33 /* The "const" storage-class-modifier is valid. */
84 34 #define YY_USE_CONST
85 35  
... ... @@ -87,17 +37,35 @@ typedef unsigned int flex_uint32_t;
87 37  
88 38 #if __STDC__
89 39  
  40 +#define YY_USE_PROTOS
90 41 #define YY_USE_CONST
91 42  
92 43 #endif /* __STDC__ */
93 44 #endif /* ! __cplusplus */
94 45  
  46 +#ifdef __TURBOC__
  47 + #pragma warn -rch
  48 + #pragma warn -use
  49 +#include <io.h>
  50 +#include <stdlib.h>
  51 +#define YY_USE_CONST
  52 +#define YY_USE_PROTOS
  53 +#endif
  54 +
95 55 #ifdef YY_USE_CONST
96 56 #define yyconst const
97 57 #else
98 58 #define yyconst
99 59 #endif
100 60  
  61 +
  62 +#ifdef YY_USE_PROTOS
  63 +#define YY_PROTO(proto) proto
  64 +#else
  65 +#define YY_PROTO(proto) ()
  66 +#endif
  67 +
  68 +
101 69 /* Returned upon end-of-file. */
102 70 #define YY_NULL 0
103 71  
... ... @@ -112,71 +80,71 @@ typedef unsigned int flex_uint32_t;
112 80 * but we do it the disgusting crufty way forced on us by the ()-less
113 81 * definition of BEGIN.
114 82 */
115   -#define BEGIN (yy_start) = 1 + 2 *
  83 +#define BEGIN yy_start = 1 + 2 *
116 84  
117 85 /* Translate the current start state into a value that can be later handed
118 86 * to BEGIN to return to the state. The YYSTATE alias is for lex
119 87 * compatibility.
120 88 */
121   -#define YY_START (((yy_start) - 1) / 2)
  89 +#define YY_START ((yy_start - 1) / 2)
122 90 #define YYSTATE YY_START
123 91  
124 92 /* Action number for EOF rule of a given start state. */
125 93 #define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
126 94  
127 95 /* Special action meaning "start processing a new file". */
128   -#define YY_NEW_FILE yyrestart(yyin )
  96 +#define YY_NEW_FILE yyrestart( yyin )
129 97  
130 98 #define YY_END_OF_BUFFER_CHAR 0
131 99  
132 100 /* Size of default input buffer. */
133   -#ifndef YY_BUF_SIZE
134 101 #define YY_BUF_SIZE 16384
135   -#endif
136 102  
137   -#ifndef YY_TYPEDEF_YY_BUFFER_STATE
138   -#define YY_TYPEDEF_YY_BUFFER_STATE
139 103 typedef struct yy_buffer_state *YY_BUFFER_STATE;
140   -#endif
141 104  
142 105 extern int yyleng;
143   -
144 106 extern FILE *yyin, *yyout;
145 107  
146 108 #define EOB_ACT_CONTINUE_SCAN 0
147 109 #define EOB_ACT_END_OF_FILE 1
148 110 #define EOB_ACT_LAST_MATCH 2
149 111  
150   - #define YY_LESS_LINENO(n)
151   -
152   -/* Return all but the first "n" matched characters back to the input stream. */
  112 +/* The funky do-while in the following #define is used to turn the definition
  113 + * int a single C statement (which needs a semi-colon terminator). This
  114 + * avoids problems with code like:
  115 + *
  116 + * if ( condition_holds )
  117 + * yyless( 5 );
  118 + * else
  119 + * do_something_else();
  120 + *
  121 + * Prior to using the do-while the compiler would get upset at the
  122 + * "else" because it interpreted the "if" statement as being all
  123 + * done when it reached the ';' after the yyless() call.
  124 + */
  125 +
  126 +/* Return all but the first 'n' matched characters back to the input stream. */
  127 +
153 128 #define yyless(n) \
154 129 do \
155 130 { \
156 131 /* Undo effects of setting up yytext. */ \
157   - int yyless_macro_arg = (n); \
158   - YY_LESS_LINENO(yyless_macro_arg);\
159   - *yy_cp = (yy_hold_char); \
  132 + *yy_cp = yy_hold_char; \
160 133 YY_RESTORE_YY_MORE_OFFSET \
161   - (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
  134 + yy_c_buf_p = yy_cp = yy_bp + n - YY_MORE_ADJ; \
162 135 YY_DO_BEFORE_ACTION; /* set up yytext again */ \
163 136 } \
164 137 while ( 0 )
165 138  
166   -#define unput(c) yyunput( c, (yytext_ptr) )
  139 +#define unput(c) yyunput( c, yytext_ptr )
167 140  
168 141 /* The following is because we cannot portably get our hands on size_t
169 142 * (without autoconf's help, which isn't available because we want
170 143 * flex-generated scanners to compile on their own).
171 144 */
172   -
173   -#ifndef YY_TYPEDEF_YY_SIZE_T
174   -#define YY_TYPEDEF_YY_SIZE_T
175 145 typedef unsigned int yy_size_t;
176   -#endif
177 146  
178   -#ifndef YY_STRUCT_YY_BUFFER_STATE
179   -#define YY_STRUCT_YY_BUFFER_STATE
  147 +
180 148 struct yy_buffer_state
181 149 {
182 150 FILE *yy_input_file;
... ... @@ -213,16 +181,12 @@ struct yy_buffer_state
213 181 */
214 182 int yy_at_bol;
215 183  
216   - int yy_bs_lineno; /**< The line count. */
217   - int yy_bs_column; /**< The column count. */
218   -
219 184 /* Whether to try to fill the input buffer when we reach the
220 185 * end of it.
221 186 */
222 187 int yy_fill_buffer;
223 188  
224 189 int yy_buffer_status;
225   -
226 190 #define YY_BUFFER_NEW 0
227 191 #define YY_BUFFER_NORMAL 1
228 192 /* When an EOF's been seen but there's still some text to process
... ... @@ -236,33 +200,23 @@ struct yy_buffer_state
236 200 * just pointing yyin at a new input file.
237 201 */
238 202 #define YY_BUFFER_EOF_PENDING 2
239   -
240 203 };
241   -#endif /* !YY_STRUCT_YY_BUFFER_STATE */
242 204  
243   -/* Stack of input buffers. */
244   -static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
245   -static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
246   -static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
  205 +static YY_BUFFER_STATE yy_current_buffer = 0;
247 206  
248 207 /* We provide macros for accessing buffer states in case in the
249 208 * future we want to put the buffer states in a more general
250 209 * "scanner state".
251   - *
252   - * Returns the top of the stack, or NULL.
253 210 */
254   -#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
255   - ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
256   - : NULL)
  211 +#define YY_CURRENT_BUFFER yy_current_buffer
257 212  
258   -/* Same as previous macro, but useful when we know that the buffer stack is not
259   - * NULL or when we need an lvalue. For internal use only.
260   - */
261   -#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
262 213  
263 214 /* yy_hold_char holds the character lost when yytext is formed. */
264 215 static char yy_hold_char;
  216 +
265 217 static int yy_n_chars; /* number of characters read into yy_ch_buf */
  218 +
  219 +
266 220 int yyleng;
267 221  
268 222 /* Points to current character in buffer. */
... ... @@ -275,95 +229,69 @@ static int yy_start = 0; /* start state number */
275 229 */
276 230 static int yy_did_buffer_switch_on_eof;
277 231  
278   -void yyrestart (FILE *input_file );
279   -void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer );
280   -YY_BUFFER_STATE yy_create_buffer (FILE *file,int size );
281   -void yy_delete_buffer (YY_BUFFER_STATE b );
282   -void yy_flush_buffer (YY_BUFFER_STATE b );
283   -void yypush_buffer_state (YY_BUFFER_STATE new_buffer );
284   -void yypop_buffer_state (void );
  232 +void yyrestart YY_PROTO(( FILE *input_file ));
285 233  
286   -static void yyensure_buffer_stack (void );
287   -static void yy_load_buffer_state (void );
288   -static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file );
  234 +void yy_switch_to_buffer YY_PROTO(( YY_BUFFER_STATE new_buffer ));
  235 +void yy_load_buffer_state YY_PROTO(( void ));
  236 +YY_BUFFER_STATE yy_create_buffer YY_PROTO(( FILE *file, int size ));
  237 +void yy_delete_buffer YY_PROTO(( YY_BUFFER_STATE b ));
  238 +void yy_init_buffer YY_PROTO(( YY_BUFFER_STATE b, FILE *file ));
  239 +void yy_flush_buffer YY_PROTO(( YY_BUFFER_STATE b ));
  240 +#define YY_FLUSH_BUFFER yy_flush_buffer( yy_current_buffer )
289 241  
290   -#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
  242 +YY_BUFFER_STATE yy_scan_buffer YY_PROTO(( char *base, yy_size_t size ));
  243 +YY_BUFFER_STATE yy_scan_string YY_PROTO(( yyconst char *yy_str ));
  244 +YY_BUFFER_STATE yy_scan_bytes YY_PROTO(( yyconst char *bytes, int len ));
291 245  
292   -YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size );
293   -YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str );
294   -YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len );
295   -
296   -void *yyalloc (yy_size_t );
297   -void *yyrealloc (void *,yy_size_t );
298   -void yyfree (void * );
  246 +static void *yy_flex_alloc YY_PROTO(( yy_size_t ));
  247 +static void *yy_flex_realloc YY_PROTO(( void *, yy_size_t ));
  248 +static void yy_flex_free YY_PROTO(( void * ));
299 249  
300 250 #define yy_new_buffer yy_create_buffer
301 251  
302 252 #define yy_set_interactive(is_interactive) \
303 253 { \
304   - if ( ! YY_CURRENT_BUFFER ){ \
305   - yyensure_buffer_stack (); \
306   - YY_CURRENT_BUFFER_LVALUE = \
307   - yy_create_buffer(yyin,YY_BUF_SIZE ); \
308   - } \
309   - YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
  254 + if ( ! yy_current_buffer ) \
  255 + yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE ); \
  256 + yy_current_buffer->yy_is_interactive = is_interactive; \
310 257 }
311 258  
312 259 #define yy_set_bol(at_bol) \
313 260 { \
314   - if ( ! YY_CURRENT_BUFFER ){\
315   - yyensure_buffer_stack (); \
316   - YY_CURRENT_BUFFER_LVALUE = \
317   - yy_create_buffer(yyin,YY_BUF_SIZE ); \
318   - } \
319   - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
  261 + if ( ! yy_current_buffer ) \
  262 + yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE ); \
  263 + yy_current_buffer->yy_at_bol = at_bol; \
320 264 }
321 265  
322   -#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
  266 +#define YY_AT_BOL() (yy_current_buffer->yy_at_bol)
323 267  
324   -/* Begin user sect3 */
325 268  
326   -#define yywrap(n) 1
  269 +#define yywrap() 1
327 270 #define YY_SKIP_YYWRAP
328   -
329 271 typedef unsigned char YY_CHAR;
330   -
331 272 FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
332   -
333 273 typedef int yy_state_type;
334   -
335   -extern int yylineno;
336   -
337   -int yylineno = 1;
338   -
339 274 extern char *yytext;
340 275 #define yytext_ptr yytext
341 276  
342   -static yy_state_type yy_get_previous_state (void );
343   -static yy_state_type yy_try_NUL_trans (yy_state_type current_state );
344   -static int yy_get_next_buffer (void );
345   -static void yy_fatal_error (yyconst char msg[] );
  277 +static yy_state_type yy_get_previous_state YY_PROTO(( void ));
  278 +static yy_state_type yy_try_NUL_trans YY_PROTO(( yy_state_type current_state ));
  279 +static int yy_get_next_buffer YY_PROTO(( void ));
  280 +static void yy_fatal_error YY_PROTO(( yyconst char msg[] ));
346 281  
347 282 /* Done after the current pattern has been matched and before the
348 283 * corresponding action - sets up yytext.
349 284 */
350 285 #define YY_DO_BEFORE_ACTION \
351   - (yytext_ptr) = yy_bp; \
352   - yyleng = (size_t) (yy_cp - yy_bp); \
353   - (yy_hold_char) = *yy_cp; \
  286 + yytext_ptr = yy_bp; \
  287 + yyleng = (int) (yy_cp - yy_bp); \
  288 + yy_hold_char = *yy_cp; \
354 289 *yy_cp = '\0'; \
355   - (yy_c_buf_p) = yy_cp;
  290 + yy_c_buf_p = yy_cp;
356 291  
357 292 #define YY_NUM_RULES 161
358 293 #define YY_END_OF_BUFFER 162
359   -/* This struct is not used in this scanner,
360   - but its presence is necessary. */
361   -struct yy_trans_info
362   - {
363   - flex_int32_t yy_verify;
364   - flex_int32_t yy_nxt;
365   - };
366   -static yyconst flex_int16_t yy_accept[646] =
  294 +static yyconst short int yy_accept[646] =
367 295 { 0,
368 296 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
369 297 0, 0, 0, 0, 0, 0, 162, 160, 159, 160,
... ... @@ -438,7 +366,7 @@ static yyconst flex_int16_t yy_accept[646] =
438 366 0, 0, 0, 111, 0
439 367 } ;
440 368  
441   -static yyconst flex_int32_t yy_ec[256] =
  369 +static yyconst int yy_ec[256] =
442 370 { 0,
443 371 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
444 372 1, 1, 4, 1, 1, 1, 1, 1, 1, 1,
... ... @@ -470,7 +398,7 @@ static yyconst flex_int32_t yy_ec[256] =
470 398 1, 1, 1, 1, 1
471 399 } ;
472 400  
473   -static yyconst flex_int32_t yy_meta[82] =
  401 +static yyconst int yy_meta[82] =
474 402 { 0,
475 403 1, 2, 2, 2, 3, 1, 4, 1, 1, 1,
476 404 4, 1, 1, 1, 1, 1, 5, 6, 6, 7,
... ... @@ -483,7 +411,7 @@ static yyconst flex_int32_t yy_meta[82] =
483 411 1
484 412 } ;
485 413  
486   -static yyconst flex_int16_t yy_base[667] =
  414 +static yyconst short int yy_base[667] =
487 415 { 0,
488 416 1045, 0, 1, 2, 73, 5, 4, 8, 11, 16,
489 417 19, 21, 154, 0, 1044, 233, 1046, 1049, 1049, 25,
... ... @@ -560,7 +488,7 @@ static yyconst flex_int16_t yy_base[667] =
560 488 716, 719, 723, 727, 733, 743
561 489 } ;
562 490  
563   -static yyconst flex_int16_t yy_def[667] =
  491 +static yyconst short int yy_def[667] =
564 492 { 0,
565 493 646, 646, 647, 647, 645, 5, 648, 648, 649, 649,
566 494 650, 650, 645, 13, 651, 652, 645, 645, 645, 645,
... ... @@ -637,7 +565,7 @@ static yyconst flex_int16_t yy_def[667] =
637 565 645, 645, 645, 645, 645, 645
638 566 } ;
639 567  
640   -static yyconst flex_int16_t yy_nxt[1131] =
  568 +static yyconst short int yy_nxt[1131] =
641 569 { 0,
642 570 645, 645, 19, 30, 30, 96, 97, 96, 96, 96,
643 571 97, 96, 96, 99, 31, 31, 150, 100, 99, 32,
... ... @@ -765,7 +693,7 @@ static yyconst flex_int16_t yy_nxt[1131] =
765 693 645, 645, 645, 645, 645, 645, 645, 645, 645, 645
766 694 } ;
767 695  
768   -static yyconst flex_int16_t yy_chk[1131] =
  696 +static yyconst short int yy_chk[1131] =
769 697 { 0,
770 698 0, 0, 2, 3, 4, 7, 7, 7, 7, 8,
771 699 8, 8, 8, 9, 3, 4, 53, 9, 10, 3,
... ... @@ -896,9 +824,6 @@ static yyconst flex_int16_t yy_chk[1131] =
896 824 static yy_state_type yy_last_accepting_state;
897 825 static char *yy_last_accepting_cpos;
898 826  
899   -extern int yy_flex_debug;
900   -int yy_flex_debug = 0;
901   -
902 827 /* The intent behind this definition is that it'll catch
903 828 * any uses of REJECT which flex missed.
904 829 */
... ... @@ -908,6 +833,7 @@ int yy_flex_debug = 0;
908 833 #define YY_RESTORE_YY_MORE_OFFSET
909 834 char *yytext;
910 835 #line 1 "lexer.y"
  836 +#define INITIAL 0
911 837 /* lexer.y *******************************************************************************
912 838  
913 839 Anubis 1.
... ... @@ -1446,38 +1372,24 @@ static char *rec_name(char *s, int del)
1446 1372  
1447 1373  
1448 1374 /* states ------------------------------------------------------------------------------*/
  1375 +#define COM 1
1449 1376  
  1377 +#define PAR 2
1450 1378  
  1379 +#define INCL 3
1451 1380  
  1381 +#define STR 4
1452 1382  
  1383 +#define STRTL 5
1453 1384  
  1385 +#define CONF 6
1454 1386  
  1387 +#define CONFCOM 7
1455 1388  
1456 1389 /* state STRTL is used when a string is too long. */
1457 1390 /* states CONF and CONFCOM are used to read 'compiler.conf'.*/
1458 1391 /* the lexer ----------------------------------------------------------------------------*/
1459   -#line 1460 "lex.yy.c"
1460   -
1461   -#define INITIAL 0
1462   -#define COM 1
1463   -#define PAR 2
1464   -#define INCL 3
1465   -#define STR 4
1466   -#define STRTL 5
1467   -#define CONF 6
1468   -#define CONFCOM 7
1469   -
1470   -#ifndef YY_NO_UNISTD_H
1471   -/* Special case for "unistd.h", since it is non-ANSI. We include it way
1472   - * down here because we want the user's section 1 to have been scanned first.
1473   - * The user has a chance to override it with an option.
1474   - */
1475   -#include <unistd.h>
1476   -#endif
1477   -
1478   -#ifndef YY_EXTRA_TYPE
1479   -#define YY_EXTRA_TYPE void *
1480   -#endif
  1392 +#line 1392 "lex.yy.c"
1481 1393  
1482 1394 /* Macros after this point can all be overridden by user definitions in
1483 1395 * section 1.
... ... @@ -1485,30 +1397,65 @@ static char *rec_name(char *s, int del)
1485 1397  
1486 1398 #ifndef YY_SKIP_YYWRAP
1487 1399 #ifdef __cplusplus
1488   -extern "C" int yywrap (void );
  1400 +extern "C" int yywrap YY_PROTO(( void ));
1489 1401 #else
1490   -extern int yywrap (void );
  1402 +extern int yywrap YY_PROTO(( void ));
1491 1403 #endif
1492 1404 #endif
1493 1405  
1494   - static void yyunput (int c,char *buf_ptr );
1495   -
  1406 +#ifndef YY_NO_UNPUT
  1407 +static void yyunput YY_PROTO(( int c, char *buf_ptr ));
  1408 +#endif
  1409 +
1496 1410 #ifndef yytext_ptr
1497   -static void yy_flex_strncpy (char *,yyconst char *,int );
  1411 +static void yy_flex_strncpy YY_PROTO(( char *, yyconst char *, int ));
1498 1412 #endif
1499 1413  
1500 1414 #ifdef YY_NEED_STRLEN
1501   -static int yy_flex_strlen (yyconst char * );
  1415 +static int yy_flex_strlen YY_PROTO(( yyconst char * ));
1502 1416 #endif
1503 1417  
1504 1418 #ifndef YY_NO_INPUT
1505   -
1506 1419 #ifdef __cplusplus
1507   -static int yyinput (void );
  1420 +static int yyinput YY_PROTO(( void ));
  1421 +#else
  1422 +static int input YY_PROTO(( void ));
  1423 +#endif
  1424 +#endif
  1425 +
  1426 +#if YY_STACK_USED
  1427 +static int yy_start_stack_ptr = 0;
  1428 +static int yy_start_stack_depth = 0;
  1429 +static int *yy_start_stack = 0;
  1430 +#ifndef YY_NO_PUSH_STATE
  1431 +static void yy_push_state YY_PROTO(( int new_state ));
  1432 +#endif
  1433 +#ifndef YY_NO_POP_STATE
  1434 +static void yy_pop_state YY_PROTO(( void ));
  1435 +#endif
  1436 +#ifndef YY_NO_TOP_STATE
  1437 +static int yy_top_state YY_PROTO(( void ));
  1438 +#endif
  1439 +
1508 1440 #else
1509   -static int input (void );
  1441 +#define YY_NO_PUSH_STATE 1
  1442 +#define YY_NO_POP_STATE 1
  1443 +#define YY_NO_TOP_STATE 1
1510 1444 #endif
1511 1445  
  1446 +#ifdef YY_MALLOC_DECL
  1447 +YY_MALLOC_DECL
  1448 +#else
  1449 +#if __STDC__
  1450 +#ifndef __cplusplus
  1451 +#include <stdlib.h>
  1452 +#endif
  1453 +#else
  1454 +/* Just try to get by without declaring the routines. This will fail
  1455 + * miserably on non-ANSI systems for which sizeof(size_t) != sizeof(int)
  1456 + * or sizeof(void*) != sizeof(int).
  1457 + */
  1458 +#endif
1512 1459 #endif
1513 1460  
1514 1461 /* Amount of stuff to slurp up with each read. */
... ... @@ -1517,6 +1464,7 @@ static int input (void );
1517 1464 #endif
1518 1465  
1519 1466 /* Copy whatever the last rule matched to the standard output. */
  1467 +
1520 1468 #ifndef ECHO
1521 1469 /* This used to be an fputs(), but since the string might contain NUL's,
1522 1470 * we now use fwrite().
... ... @@ -1529,10 +1477,9 @@ static int input (void );
1529 1477 */
1530 1478 #ifndef YY_INPUT
1531 1479 #define YY_INPUT(buf,result,max_size) \
1532   - if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
  1480 + if ( yy_current_buffer->yy_is_interactive ) \
1533 1481 { \
1534   - int c = '*'; \
1535   - size_t n; \
  1482 + int c = '*', n; \
1536 1483 for ( n = 0; n < max_size && \
1537 1484 (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
1538 1485 buf[n] = (char) c; \
... ... @@ -1555,9 +1502,7 @@ static int input (void );
1555 1502 errno=0; \
1556 1503 clearerr(yyin); \
1557 1504 } \
1558   - }\
1559   -\
1560   -
  1505 + }
1561 1506 #endif
1562 1507  
1563 1508 /* No semi-colon after return; correct usage is to write "yyterminate();" -
... ... @@ -1578,18 +1523,12 @@ static int input (void );
1578 1523 #define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
1579 1524 #endif
1580 1525  
1581   -/* end tables serialization structures and prototypes */
1582   -
1583 1526 /* Default declaration of generated scanner - a define so the user can
1584 1527 * easily add parameters.
1585 1528 */
1586 1529 #ifndef YY_DECL
1587   -#define YY_DECL_IS_OURS 1
1588   -
1589   -extern int yylex (void);
1590   -
1591   -#define YY_DECL int yylex (void)
1592   -#endif /* !YY_DECL */
  1530 +#define YY_DECL int yylex YY_PROTO(( void ))
  1531 +#endif
1593 1532  
1594 1533 /* Code executed at the beginning of each rule, after yytext and yyleng
1595 1534 * have been set up.
... ... @@ -1605,32 +1544,30 @@ extern int yylex (void);
1605 1544  
1606 1545 #define YY_RULE_SETUP \
1607 1546 if ( yyleng > 0 ) \
1608   - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
  1547 + yy_current_buffer->yy_at_bol = \
1609 1548 (yytext[yyleng - 1] == '\n'); \
1610 1549 YY_USER_ACTION
1611 1550  
1612   -/** The main scanner function which does all the work.
1613   - */
1614 1551 YY_DECL
1615   -{
  1552 + {
1616 1553 register yy_state_type yy_current_state;
1617 1554 register char *yy_cp, *yy_bp;
1618 1555 register int yy_act;
1619   -
  1556 +
1620 1557 #line 562 "lexer.y"
1621 1558  
1622   -#line 1623 "lex.yy.c"
  1559 +#line 1559 "lex.yy.c"
1623 1560  
1624   - if ( (yy_init) )
  1561 + if ( yy_init )
1625 1562 {
1626   - (yy_init) = 0;
  1563 + yy_init = 0;
1627 1564  
1628 1565 #ifdef YY_USER_INIT
1629 1566 YY_USER_INIT;
1630 1567 #endif
1631 1568  
1632   - if ( ! (yy_start) )
1633   - (yy_start) = 1; /* first start state */
  1569 + if ( ! yy_start )
  1570 + yy_start = 1; /* first start state */
1634 1571  
1635 1572 if ( ! yyin )
1636 1573 yyin = stdin;
... ... @@ -1638,28 +1575,26 @@ YY_DECL
1638 1575 if ( ! yyout )
1639 1576 yyout = stdout;
1640 1577  
1641   - if ( ! YY_CURRENT_BUFFER ) {
1642   - yyensure_buffer_stack ();
1643   - YY_CURRENT_BUFFER_LVALUE =
1644   - yy_create_buffer(yyin,YY_BUF_SIZE );
1645   - }
  1578 + if ( ! yy_current_buffer )
  1579 + yy_current_buffer =
  1580 + yy_create_buffer( yyin, YY_BUF_SIZE );
1646 1581  
1647   - yy_load_buffer_state( );
  1582 + yy_load_buffer_state();
1648 1583 }
1649 1584  
1650 1585 while ( 1 ) /* loops until end-of-file is reached */
1651 1586 {
1652   - yy_cp = (yy_c_buf_p);
  1587 + yy_cp = yy_c_buf_p;
1653 1588  
1654 1589 /* Support of yytext. */
1655   - *yy_cp = (yy_hold_char);
  1590 + *yy_cp = yy_hold_char;
1656 1591  
1657 1592 /* yy_bp points to the position in yy_ch_buf of the start of
1658 1593 * the current run.
1659 1594 */
1660 1595 yy_bp = yy_cp;
1661 1596  
1662   - yy_current_state = (yy_start);
  1597 + yy_current_state = yy_start;
1663 1598 yy_current_state += YY_AT_BOL();
1664 1599 yy_match:
1665 1600 do
... ... @@ -1667,8 +1602,8 @@ yy_match:
1667 1602 register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
1668 1603 if ( yy_accept[yy_current_state] )
1669 1604 {
1670   - (yy_last_accepting_state) = yy_current_state;
1671   - (yy_last_accepting_cpos) = yy_cp;
  1605 + yy_last_accepting_state = yy_current_state;
  1606 + yy_last_accepting_cpos = yy_cp;
1672 1607 }
1673 1608 while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
1674 1609 {
... ... @@ -1685,22 +1620,24 @@ yy_find_action:
1685 1620 yy_act = yy_accept[yy_current_state];
1686 1621 if ( yy_act == 0 )
1687 1622 { /* have to back up */
1688   - yy_cp = (yy_last_accepting_cpos);
1689   - yy_current_state = (yy_last_accepting_state);
  1623 + yy_cp = yy_last_accepting_cpos;
  1624 + yy_current_state = yy_last_accepting_state;
1690 1625 yy_act = yy_accept[yy_current_state];
1691 1626 }
1692 1627  
1693 1628 YY_DO_BEFORE_ACTION;
1694 1629  
  1630 +
1695 1631 do_action: /* This label is used only to access EOF actions. */
1696 1632  
  1633 +
1697 1634 switch ( yy_act )
1698 1635 { /* beginning of action switch */
1699 1636 case 0: /* must back up */
1700 1637 /* undo the effects of YY_DO_BEFORE_ACTION */
1701   - *yy_cp = (yy_hold_char);
1702   - yy_cp = (yy_last_accepting_cpos);
1703   - yy_current_state = (yy_last_accepting_state);
  1638 + *yy_cp = yy_hold_char;
  1639 + yy_cp = yy_last_accepting_cpos;
  1640 + yy_current_state = yy_last_accepting_state;
1704 1641 goto yy_find_action;
1705 1642  
1706 1643 case 1:
... ... @@ -1719,7 +1656,6 @@ YY_RULE_SETUP
1719 1656 { comlevel--; if (!comlevel) { BEGIN PAR; } }
1720 1657 YY_BREAK
1721 1658 case 4:
1722   -/* rule 4 can match eol */
1723 1659 YY_RULE_SETUP
1724 1660 #line 566 "lexer.y"
1725 1661 { }
... ... @@ -1730,8 +1666,8 @@ YY_RULE_SETUP
1730 1666 { }
1731 1667 YY_BREAK
1732 1668 case 6:
1733   -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */
1734   -(yy_c_buf_p) = yy_cp -= 1;
  1669 +*yy_cp = yy_hold_char; /* undo effects of setting up yytext */
  1670 +yy_c_buf_p = yy_cp -= 1;
1735 1671 YY_DO_BEFORE_ACTION; /* set up yytext again */
1736 1672 YY_RULE_SETUP
1737 1673 #line 568 "lexer.y"
... ... @@ -1776,7 +1712,6 @@ YY_RULE_SETUP
1776 1712 { store_str_char('\\'); }
1777 1713 YY_BREAK
1778 1714 case 14:
1779   -/* rule 14 can match eol */
1780 1715 YY_RULE_SETUP
1781 1716 #line 579 "lexer.y"
1782 1717 { store_str_char('\n'); }
... ... @@ -1792,7 +1727,6 @@ YY_RULE_SETUP
1792 1727 { BEGIN PAR; }
1793 1728 YY_BREAK
1794 1729 case 17:
1795   -/* rule 17 can match eol */
1796 1730 YY_RULE_SETUP
1797 1731 #line 582 "lexer.y"
1798 1732 { }
... ... @@ -1848,7 +1782,6 @@ YY_RULE_SETUP
1848 1782 { yylval.expr = linecol(); return yy__rpar; }
1849 1783 YY_BREAK
1850 1784 case 28:
1851   -/* rule 28 can match eol */
1852 1785 YY_RULE_SETUP
1853 1786 #line 593 "lexer.y"
1854 1787 { yylval.expr = linecol(); return yy__rpar; }
... ... @@ -1864,7 +1797,6 @@ YY_RULE_SETUP
1864 1797 { yylval.expr = linecol(); return yy__rbrace; }
1865 1798 YY_BREAK
1866 1799 case 31:
1867   -/* rule 31 can match eol */
1868 1800 YY_RULE_SETUP
1869 1801 #line 596 "lexer.y"
1870 1802 { yylval.expr = linecol(); return yy__rbrace; }
... ... @@ -1880,7 +1812,6 @@ YY_RULE_SETUP
1880 1812 { yylval.expr = linecol(); return yy__rbracket; }
1881 1813 YY_BREAK
1882 1814 case 34:
1883   -/* rule 34 can match eol */
1884 1815 YY_RULE_SETUP
1885 1816 #line 599 "lexer.y"
1886 1817 { yylval.expr = linecol(); return yy__rbracket; }
... ... @@ -2051,7 +1982,6 @@ YY_RULE_SETUP
2051 1982 { yylval.expr = linecol(); return yy__dots; }
2052 1983 YY_BREAK
2053 1984 case 68:
2054   -/* rule 68 can match eol */
2055 1985 YY_RULE_SETUP
2056 1986 #line 633 "lexer.y"
2057 1987 { yylval.expr = linecol(); return yy__rpar_arrow; }
... ... @@ -2191,19 +2121,16 @@ YY_RULE_SETUP
2191 2121 { yylval.expr = linecol(); return yy__succeeds; }
2192 2122 YY_BREAK
2193 2123 case 93:
2194   -/* rule 93 can match eol */
2195 2124 YY_RULE_SETUP
2196 2125 #line 672 "lexer.y"
2197 2126 { yylval.expr = linecol(); return yy__succeeds_as; }
2198 2127 YY_BREAK
2199 2128 case 94:
2200   -/* rule 94 can match eol */
2201 2129 YY_RULE_SETUP
2202 2130 #line 673 "lexer.y"
2203 2131 { yylval.expr = linecol(); return yy__wait_for; }
2204 2132 YY_BREAK
2205 2133 case 95:
2206   -/* rule 95 can match eol */
2207 2134 YY_RULE_SETUP
2208 2135 #line 674 "lexer.y"
2209 2136 { yylval.expr = linecol(); return yy__checking_every; }
... ... @@ -2259,13 +2186,11 @@ YY_RULE_SETUP
2259 2186 { yylval.expr = linecol(); return yy__MVar; }
2260 2187 YY_BREAK
2261 2188 case 106:
2262   -/* rule 106 can match eol */
2263 2189 YY_RULE_SETUP
2264 2190 #line 685 "lexer.y"
2265 2191 { yylval.expr = linecol(); return yy__connect_to_file; }
2266 2192 YY_BREAK
2267 2193 case 107:
2268   -/* rule 107 can match eol */
2269 2194 YY_RULE_SETUP
2270 2195 #line 686 "lexer.y"
2271 2196 { yylval.expr = linecol(); return yy__connect_to_IP; }
... ... @@ -2281,13 +2206,11 @@ YY_RULE_SETUP
2281 2206 { yylval.expr = linecol(); return yy__terminal; }
2282 2207 YY_BREAK
2283 2208 case 110:
2284   -/* rule 110 can match eol */
2285 2209 YY_RULE_SETUP
2286 2210 #line 689 "lexer.y"
2287 2211 { yylval.expr = linecol(); return yy__we_have; }
2288 2212 YY_BREAK
2289 2213 case 111:
2290   -/* rule 111 can match eol */
2291 2214 YY_RULE_SETUP
2292 2215 #line 690 "lexer.y"
2293 2216 { yylval.expr = linecol();
... ... @@ -2299,7 +2222,6 @@ YY_RULE_SETUP
2299 2222 { yylval.expr = linecol(); return yy__let; }
2300 2223 YY_BREAK
2301 2224 case 113:
2302   -/* rule 113 can match eol */
2303 2225 YY_RULE_SETUP
2304 2226 #line 693 "lexer.y"
2305 2227 { yylval.expr = linecol(); return yy__assume; }
... ... @@ -2341,7 +2263,6 @@ YY_RULE_SETUP
2341 2263 my_anubis_directory,lineno); anb_exit(1); }
2342 2264 YY_BREAK
2343 2265 case 121:
2344   -/* rule 121 can match eol */
2345 2266 YY_RULE_SETUP
2346 2267 #line 702 "lexer.y"
2347 2268 { }
... ... @@ -2352,7 +2273,6 @@ YY_RULE_SETUP
2352 2273 { }
2353 2274 YY_BREAK
2354 2275 case 123:
2355   -/* rule 123 can match eol */
2356 2276 YY_RULE_SETUP
2357 2277 #line 704 "lexer.y"
2358 2278 {
... ... @@ -2379,7 +2299,6 @@ YY_RULE_SETUP
2379 2299 { }
2380 2300 YY_BREAK
2381 2301 case 127:
2382   -/* rule 127 can match eol */
2383 2302 YY_RULE_SETUP
2384 2303 #line 714 "lexer.y"
2385 2304 { BEGIN CONFCOM; }
... ... @@ -2391,7 +2310,6 @@ YY_RULE_SETUP
2391 2310 my_anubis_directory,lineno); anb_exit(1); }
2392 2311 YY_BREAK
2393 2312 case 129:
2394   -/* rule 129 can match eol */
2395 2313 YY_RULE_SETUP
2396 2314 #line 717 "lexer.y"
2397 2315 { printf(yytext); fflush(stdout); }
... ... @@ -2403,7 +2321,6 @@ YY_RULE_SETUP
2403 2321 yylval.expr = linecol(); return yy__type; }
2404 2322 YY_BREAK
2405 2323 case 131:
2406   -/* rule 131 can match eol */
2407 2324 YY_RULE_SETUP
2408 2325 #line 720 "lexer.y"
2409 2326 { BEGIN PAR; par_seen = 1; current_par_line = lineno;
... ... @@ -2416,7 +2333,6 @@ YY_RULE_SETUP
2416 2333 yylval.expr = linecol(); return yy__variable; }
2417 2334 YY_BREAK
2418 2335 case 133:
2419   -/* rule 133 can match eol */
2420 2336 YY_RULE_SETUP
2421 2337 #line 724 "lexer.y"
2422 2338 { BEGIN PAR; par_seen = 1; current_par_line = lineno;
... ... @@ -2429,7 +2345,6 @@ YY_RULE_SETUP
2429 2345 yylval.expr = linecol(); return yy__theorem; }
2430 2346 YY_BREAK
2431 2347 case 135:
2432   -/* rule 135 can match eol */
2433 2348 YY_RULE_SETUP
2434 2349 #line 728 "lexer.y"
2435 2350 { BEGIN PAR; par_seen = 1; current_par_line = lineno;
... ... @@ -2442,7 +2357,6 @@ YY_RULE_SETUP
2442 2357 yylval.expr = linecol(); return yy__operation; }
2443 2358 YY_BREAK
2444 2359 case 137:
2445   -/* rule 137 can match eol */
2446 2360 YY_RULE_SETUP
2447 2361 #line 732 "lexer.y"
2448 2362 { BEGIN PAR; par_seen = 1; current_par_line = lineno;
... ... @@ -2455,14 +2369,12 @@ YY_RULE_SETUP
2455 2369 yylval.expr = linecol(); return yy__operation; }
2456 2370 YY_BREAK
2457 2371 case 139:
2458   -/* rule 139 can match eol */
2459 2372 YY_RULE_SETUP
2460 2373 #line 736 "lexer.y"
2461 2374 { BEGIN PAR; par_seen = 1; current_par_line = lineno;
2462 2375 yylval.expr = linecol(); return yy__g_operation; }
2463 2376 YY_BREAK
2464 2377 case 140:
2465   -/* rule 140 can match eol */
2466 2378 YY_RULE_SETUP
2467 2379 #line 738 "lexer.y"
2468 2380 { BEGIN PAR; par_seen = 1; current_par_line = lineno;
... ... @@ -2537,7 +2449,6 @@ YY_RULE_SETUP
2537 2449 BEGIN INITIAL; }}
2538 2450 YY_BREAK
2539 2451 case 144:
2540   -/* rule 144 can match eol */
2541 2452 YY_RULE_SETUP
2542 2453 #line 796 "lexer.y"
2543 2454 { lexical_kwread_error(); }
... ... @@ -2653,7 +2564,6 @@ YY_RULE_SETUP
2653 2564 { }
2654 2565 YY_BREAK
2655 2566 case 157:
2656   -/* rule 157 can match eol */
2657 2567 YY_RULE_SETUP
2658 2568 #line 849 "lexer.y"
2659 2569 { }
... ... @@ -2664,7 +2574,6 @@ YY_RULE_SETUP
2664 2574 { lexical_error(); }
2665 2575 YY_BREAK
2666 2576 case 159:
2667   -/* rule 159 can match eol */
2668 2577 YY_RULE_SETUP
2669 2578 #line 851 "lexer.y"
2670 2579 { if (gindex) store_external_comment('\n'); }
... ... @@ -2679,31 +2588,31 @@ YY_RULE_SETUP
2679 2588 #line 853 "lexer.y"
2680 2589 ECHO;
2681 2590 YY_BREAK
2682   -#line 2683 "lex.yy.c"
  2591 +#line 2591 "lex.yy.c"
2683 2592  
2684 2593 case YY_END_OF_BUFFER:
2685 2594 {
2686 2595 /* Amount of text matched not including the EOB char. */
2687   - int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
  2596 + int yy_amount_of_matched_text = (int) (yy_cp - yytext_ptr) - 1;
2688 2597  
2689 2598 /* Undo the effects of YY_DO_BEFORE_ACTION. */
2690   - *yy_cp = (yy_hold_char);
  2599 + *yy_cp = yy_hold_char;
2691 2600 YY_RESTORE_YY_MORE_OFFSET
2692 2601  
2693   - if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
  2602 + if ( yy_current_buffer->yy_buffer_status == YY_BUFFER_NEW )
2694 2603 {
2695 2604 /* We're scanning a new file or input source. It's
2696 2605 * possible that this happened because the user
2697 2606 * just pointed yyin at a new source and called
2698 2607 * yylex(). If so, then we have to assure
2699   - * consistency between YY_CURRENT_BUFFER and our
  2608 + * consistency between yy_current_buffer and our
2700 2609 * globals. Here is the right place to do so, because
2701 2610 * this is the first action (other than possibly a
2702 2611 * back-up) that will match for the new input source.
2703 2612 */
2704   - (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
2705   - YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
2706   - YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
  2613 + yy_n_chars = yy_current_buffer->yy_n_chars;
  2614 + yy_current_buffer->yy_input_file = yyin;
  2615 + yy_current_buffer->yy_buffer_status = YY_BUFFER_NORMAL;
2707 2616 }
2708 2617  
2709 2618 /* Note that here we test for yy_c_buf_p "<=" to the position
... ... @@ -2713,13 +2622,13 @@ ECHO;
2713 2622 * end-of-buffer state). Contrast this with the test
2714 2623 * in input().
2715 2624 */
2716   - if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
  2625 + if ( yy_c_buf_p <= &yy_current_buffer->yy_ch_buf[yy_n_chars] )
2717 2626 { /* This was really a NUL. */
2718 2627 yy_state_type yy_next_state;
2719 2628  
2720   - (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
  2629 + yy_c_buf_p = yytext_ptr + yy_amount_of_matched_text;
2721 2630  
2722   - yy_current_state = yy_get_previous_state( );
  2631 + yy_current_state = yy_get_previous_state();
2723 2632  
2724 2633 /* Okay, we're now positioned to make the NUL
2725 2634 * transition. We couldn't have
... ... @@ -2732,30 +2641,30 @@ ECHO;
2732 2641  
2733 2642 yy_next_state = yy_try_NUL_trans( yy_current_state );
2734 2643  
2735   - yy_bp = (yytext_ptr) + YY_MORE_ADJ;
  2644 + yy_bp = yytext_ptr + YY_MORE_ADJ;
2736 2645  
2737 2646 if ( yy_next_state )
2738 2647 {
2739 2648 /* Consume the NUL. */
2740   - yy_cp = ++(yy_c_buf_p);
  2649 + yy_cp = ++yy_c_buf_p;
2741 2650 yy_current_state = yy_next_state;
2742 2651 goto yy_match;
2743 2652 }
2744 2653  
2745 2654 else
2746 2655 {
2747   - yy_cp = (yy_c_buf_p);
  2656 + yy_cp = yy_c_buf_p;
2748 2657 goto yy_find_action;
2749 2658 }
2750 2659 }
2751 2660  
2752   - else switch ( yy_get_next_buffer( ) )
  2661 + else switch ( yy_get_next_buffer() )
2753 2662 {
2754 2663 case EOB_ACT_END_OF_FILE:
2755 2664 {
2756   - (yy_did_buffer_switch_on_eof) = 0;
  2665 + yy_did_buffer_switch_on_eof = 0;
2757 2666  
2758   - if ( yywrap( ) )
  2667 + if ( yywrap() )
2759 2668 {
2760 2669 /* Note: because we've taken care in
2761 2670 * yy_get_next_buffer() to have set up
... ... @@ -2766,7 +2675,7 @@ ECHO;
2766 2675 * YY_NULL, it'll still work - another
2767 2676 * YY_NULL will get returned.
2768 2677 */
2769   - (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
  2678 + yy_c_buf_p = yytext_ptr + YY_MORE_ADJ;
2770 2679  
2771 2680 yy_act = YY_STATE_EOF(YY_START);
2772 2681 goto do_action;
... ... @@ -2774,30 +2683,30 @@ ECHO;
2774 2683  
2775 2684 else
2776 2685 {
2777   - if ( ! (yy_did_buffer_switch_on_eof) )
  2686 + if ( ! yy_did_buffer_switch_on_eof )
2778 2687 YY_NEW_FILE;
2779 2688 }
2780 2689 break;
2781 2690 }
2782 2691  
2783 2692 case EOB_ACT_CONTINUE_SCAN:
2784   - (yy_c_buf_p) =
2785   - (yytext_ptr) + yy_amount_of_matched_text;
  2693 + yy_c_buf_p =
  2694 + yytext_ptr + yy_amount_of_matched_text;
2786 2695  
2787   - yy_current_state = yy_get_previous_state( );
  2696 + yy_current_state = yy_get_previous_state();
2788 2697  
2789   - yy_cp = (yy_c_buf_p);
2790   - yy_bp = (yytext_ptr) + YY_MORE_ADJ;
  2698 + yy_cp = yy_c_buf_p;
  2699 + yy_bp = yytext_ptr + YY_MORE_ADJ;
2791 2700 goto yy_match;
2792 2701  
2793 2702 case EOB_ACT_LAST_MATCH:
2794   - (yy_c_buf_p) =
2795   - &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
  2703 + yy_c_buf_p =
  2704 + &yy_current_buffer->yy_ch_buf[yy_n_chars];
2796 2705  
2797   - yy_current_state = yy_get_previous_state( );
  2706 + yy_current_state = yy_get_previous_state();
2798 2707  
2799   - yy_cp = (yy_c_buf_p);
2800   - yy_bp = (yytext_ptr) + YY_MORE_ADJ;
  2708 + yy_cp = yy_c_buf_p;
  2709 + yy_bp = yytext_ptr + YY_MORE_ADJ;
2801 2710 goto yy_find_action;
2802 2711 }
2803 2712 break;
... ... @@ -2808,7 +2717,8 @@ ECHO;
2808 2717 "fatal flex scanner internal error--no action found" );
2809 2718 } /* end of action switch */
2810 2719 } /* end of scanning one token */
2811   -} /* end of yylex */
  2720 + } /* end of yylex */
  2721 +
2812 2722  
2813 2723 /* yy_get_next_buffer - try to read in a new buffer
2814 2724 *
... ... @@ -2817,20 +2727,21 @@ ECHO;
2817 2727 * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
2818 2728 * EOB_ACT_END_OF_FILE - end of file
2819 2729 */
2820   -static int yy_get_next_buffer (void)
2821   -{
2822   - register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
2823   - register char *source = (yytext_ptr);
  2730 +
  2731 +static int yy_get_next_buffer()
  2732 + {
  2733 + register char *dest = yy_current_buffer->yy_ch_buf;
  2734 + register char *source = yytext_ptr;
2824 2735 register int number_to_move, i;
2825 2736 int ret_val;
2826 2737  
2827   - if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
  2738 + if ( yy_c_buf_p > &yy_current_buffer->yy_ch_buf[yy_n_chars + 1] )
2828 2739 YY_FATAL_ERROR(
2829 2740 "fatal flex scanner internal error--end of buffer missed" );
2830 2741  
2831   - if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
  2742 + if ( yy_current_buffer->yy_fill_buffer == 0 )
2832 2743 { /* Don't try to fill the buffer, so this is an EOF. */
2833   - if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
  2744 + if ( yy_c_buf_p - yytext_ptr - YY_MORE_ADJ == 1 )
2834 2745 {
2835 2746 /* We matched a single character, the EOB, so
2836 2747 * treat this as a final EOF.
... ... @@ -2850,30 +2761,34 @@ static int yy_get_next_buffer (void)
2850 2761 /* Try to read more data. */
2851 2762  
2852 2763 /* First move last chars to start of buffer. */
2853   - number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
  2764 + number_to_move = (int) (yy_c_buf_p - yytext_ptr) - 1;
2854 2765  
2855 2766 for ( i = 0; i < number_to_move; ++i )
2856 2767 *(dest++) = *(source++);
2857 2768  
2858   - if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
  2769 + if ( yy_current_buffer->yy_buffer_status == YY_BUFFER_EOF_PENDING )
2859 2770 /* don't do the read, it's not guaranteed to return an EOF,
2860 2771 * just force an EOF
2861 2772 */
2862   - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
  2773 + yy_current_buffer->yy_n_chars = yy_n_chars = 0;
2863 2774  
2864 2775 else
2865 2776 {
2866   - size_t num_to_read =
2867   - YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
  2777 + int num_to_read =
  2778 + yy_current_buffer->yy_buf_size - number_to_move - 1;
2868 2779  
2869 2780 while ( num_to_read <= 0 )
2870 2781 { /* Not enough room in the buffer - grow it. */
  2782 +#ifdef YY_USES_REJECT
  2783 + YY_FATAL_ERROR(
  2784 +"input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
  2785 +#else
2871 2786  
2872 2787 /* just a shorter name for the current buffer */
2873   - YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
  2788 + YY_BUFFER_STATE b = yy_current_buffer;
2874 2789  
2875 2790 int yy_c_buf_p_offset =
2876   - (int) ((yy_c_buf_p) - b->yy_ch_buf);
  2791 + (int) (yy_c_buf_p - b->yy_ch_buf);
2877 2792  
2878 2793 if ( b->yy_is_our_buffer )
2879 2794 {
... ... @@ -2886,7 +2801,8 @@ static int yy_get_next_buffer (void)
2886 2801  
2887 2802 b->yy_ch_buf = (char *)
2888 2803 /* Include room in for 2 EOB chars. */
2889   - yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2 );
  2804 + yy_flex_realloc( (void *) b->yy_ch_buf,
  2805 + b->yy_buf_size + 2 );
2890 2806 }
2891 2807 else
2892 2808 /* Can't grow it, we don't own it. */
... ... @@ -2896,35 +2812,35 @@ static int yy_get_next_buffer (void)
2896 2812 YY_FATAL_ERROR(
2897 2813 "fatal error - scanner input buffer overflow" );
2898 2814  
2899   - (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
  2815 + yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset];
2900 2816  
2901   - num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
  2817 + num_to_read = yy_current_buffer->yy_buf_size -
2902 2818 number_to_move - 1;
2903   -
  2819 +#endif
2904 2820 }
2905 2821  
2906 2822 if ( num_to_read > YY_READ_BUF_SIZE )
2907 2823 num_to_read = YY_READ_BUF_SIZE;
2908 2824  
2909 2825 /* Read in more data. */
2910   - YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
2911   - (yy_n_chars), num_to_read );
  2826 + YY_INPUT( (&yy_current_buffer->yy_ch_buf[number_to_move]),
  2827 + yy_n_chars, num_to_read );
2912 2828  
2913   - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
  2829 + yy_current_buffer->yy_n_chars = yy_n_chars;
2914 2830 }
2915 2831  
2916   - if ( (yy_n_chars) == 0 )
  2832 + if ( yy_n_chars == 0 )
2917 2833 {
2918 2834 if ( number_to_move == YY_MORE_ADJ )
2919 2835 {
2920 2836 ret_val = EOB_ACT_END_OF_FILE;
2921   - yyrestart(yyin );
  2837 + yyrestart( yyin );
2922 2838 }
2923 2839  
2924 2840 else
2925 2841 {
2926 2842 ret_val = EOB_ACT_LAST_MATCH;
2927   - YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
  2843 + yy_current_buffer->yy_buffer_status =
2928 2844 YY_BUFFER_EOF_PENDING;
2929 2845 }
2930 2846 }
... ... @@ -2932,32 +2848,33 @@ static int yy_get_next_buffer (void)
2932 2848 else
2933 2849 ret_val = EOB_ACT_CONTINUE_SCAN;
2934 2850  
2935   - (yy_n_chars) += number_to_move;
2936   - YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
2937   - YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
  2851 + yy_n_chars += number_to_move;
  2852 + yy_current_buffer->yy_ch_buf[yy_n_chars] = YY_END_OF_BUFFER_CHAR;
  2853 + yy_current_buffer->yy_ch_buf[yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR;
2938 2854  
2939   - (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
  2855 + yytext_ptr = &yy_current_buffer->yy_ch_buf[0];
2940 2856  
2941 2857 return ret_val;
2942   -}
  2858 + }
  2859 +
2943 2860  
2944 2861 /* yy_get_previous_state - get the state just before the EOB char was reached */
2945 2862  
2946   - static yy_state_type yy_get_previous_state (void)
2947   -{
  2863 +static yy_state_type yy_get_previous_state()
  2864 + {
2948 2865 register yy_state_type yy_current_state;
2949 2866 register char *yy_cp;
2950   -
2951   - yy_current_state = (yy_start);
  2867 +
  2868 + yy_current_state = yy_start;
2952 2869 yy_current_state += YY_AT_BOL();
2953 2870  
2954   - for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
  2871 + for ( yy_cp = yytext_ptr + YY_MORE_ADJ; yy_cp < yy_c_buf_p; ++yy_cp )
2955 2872 {
2956 2873 register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
2957 2874 if ( yy_accept[yy_current_state] )
2958 2875 {
2959   - (yy_last_accepting_state) = yy_current_state;
2960   - (yy_last_accepting_cpos) = yy_cp;
  2876 + yy_last_accepting_state = yy_current_state;
  2877 + yy_last_accepting_cpos = yy_cp;
2961 2878 }
2962 2879 while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
2963 2880 {
... ... @@ -2969,23 +2886,30 @@ static int yy_get_next_buffer (void)
2969 2886 }
2970 2887  
2971 2888 return yy_current_state;
2972   -}
  2889 + }
  2890 +
2973 2891  
2974 2892 /* yy_try_NUL_trans - try to make a transition on the NUL character
2975 2893 *
2976 2894 * synopsis
2977 2895 * next_state = yy_try_NUL_trans( current_state );
2978 2896 */
2979   - static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )
2980   -{
  2897 +
  2898 +#ifdef YY_USE_PROTOS
  2899 +static yy_state_type yy_try_NUL_trans( yy_state_type yy_current_state )
  2900 +#else
  2901 +static yy_state_type yy_try_NUL_trans( yy_current_state )
  2902 +yy_state_type yy_current_state;
  2903 +#endif
  2904 + {
2981 2905 register int yy_is_jam;
2982   - register char *yy_cp = (yy_c_buf_p);
  2906 + register char *yy_cp = yy_c_buf_p;
2983 2907  
2984 2908 register YY_CHAR yy_c = 1;
2985 2909 if ( yy_accept[yy_current_state] )
2986 2910 {
2987   - (yy_last_accepting_state) = yy_current_state;
2988   - (yy_last_accepting_cpos) = yy_cp;
  2911 + yy_last_accepting_state = yy_current_state;
  2912 + yy_last_accepting_cpos = yy_cp;
2989 2913 }
2990 2914 while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
2991 2915 {
... ... @@ -2997,73 +2921,80 @@ static int yy_get_next_buffer (void)
2997 2921 yy_is_jam = (yy_current_state == 645);
2998 2922  
2999 2923 return yy_is_jam ? 0 : yy_current_state;
3000   -}
  2924 + }
3001 2925  
3002   - static void yyunput (int c, register char * yy_bp )
3003   -{
3004   - register char *yy_cp;
3005   -
3006   - yy_cp = (yy_c_buf_p);
  2926 +
  2927 +#ifndef YY_NO_UNPUT
  2928 +#ifdef YY_USE_PROTOS
  2929 +static void yyunput( int c, register char *yy_bp )
  2930 +#else
  2931 +static void yyunput( c, yy_bp )
  2932 +int c;
  2933 +register char *yy_bp;
  2934 +#endif
  2935 + {
  2936 + register char *yy_cp = yy_c_buf_p;
3007 2937  
3008 2938 /* undo effects of setting up yytext */
3009   - *yy_cp = (yy_hold_char);
  2939 + *yy_cp = yy_hold_char;
3010 2940  
3011   - if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
  2941 + if ( yy_cp < yy_current_buffer->yy_ch_buf + 2 )
3012 2942 { /* need to shift things up to make room */
3013 2943 /* +2 for EOB chars. */
3014   - register int number_to_move = (yy_n_chars) + 2;
3015   - register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
3016   - YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
  2944 + register int number_to_move = yy_n_chars + 2;
  2945 + register char *dest = &yy_current_buffer->yy_ch_buf[
  2946 + yy_current_buffer->yy_buf_size + 2];
3017 2947 register char *source =
3018   - &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
  2948 + &yy_current_buffer->yy_ch_buf[number_to_move];
3019 2949  
3020   - while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
  2950 + while ( source > yy_current_buffer->yy_ch_buf )
3021 2951 *--dest = *--source;
3022 2952  
3023 2953 yy_cp += (int) (dest - source);
3024 2954 yy_bp += (int) (dest - source);
3025   - YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
3026   - (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
  2955 + yy_current_buffer->yy_n_chars =
  2956 + yy_n_chars = yy_current_buffer->yy_buf_size;
3027 2957  
3028   - if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
  2958 + if ( yy_cp < yy_current_buffer->yy_ch_buf + 2 )
3029 2959 YY_FATAL_ERROR( "flex scanner push-back overflow" );
3030 2960 }
3031 2961  
3032 2962 *--yy_cp = (char) c;
3033 2963  
3034   - (yytext_ptr) = yy_bp;
3035   - (yy_hold_char) = *yy_cp;
3036   - (yy_c_buf_p) = yy_cp;
3037   -}
3038 2964  
3039   -#ifndef YY_NO_INPUT
  2965 + yytext_ptr = yy_bp;
  2966 + yy_hold_char = *yy_cp;
  2967 + yy_c_buf_p = yy_cp;
  2968 + }
  2969 +#endif /* ifndef YY_NO_UNPUT */
  2970 +
  2971 +
3040 2972 #ifdef __cplusplus
3041   - static int yyinput (void)
  2973 +static int yyinput()
3042 2974 #else
3043   - static int input (void)
  2975 +static int input()
3044 2976 #endif
3045   -
3046   -{
  2977 + {
3047 2978 int c;
3048   -
3049   - *(yy_c_buf_p) = (yy_hold_char);
3050 2979  
3051   - if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
  2980 + *yy_c_buf_p = yy_hold_char;
  2981 +
  2982 + if ( *yy_c_buf_p == YY_END_OF_BUFFER_CHAR )
3052 2983 {
3053 2984 /* yy_c_buf_p now points to the character we want to return.
3054 2985 * If this occurs *before* the EOB characters, then it's a
3055 2986 * valid NUL; if not, then we've hit the end of the buffer.
3056 2987 */
3057   - if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
  2988 + if ( yy_c_buf_p < &yy_current_buffer->yy_ch_buf[yy_n_chars] )
3058 2989 /* This was really a NUL. */
3059   - *(yy_c_buf_p) = ' = '\0';';
  2990 + *yy_c_buf_p = ' = '\0';';
3060 2991  
3061 2992 else
3062 2993 { /* need more input */
3063   - int offset = (yy_c_buf_p) - (yytext_ptr);
3064   - ++(yy_c_buf_p);
  2994 + int offset = yy_c_buf_p - yytext_ptr;
  2995 + ++yy_c_buf_p;
3065 2996  
3066   - switch ( yy_get_next_buffer( ) )
  2997 + switch ( yy_get_next_buffer() )
3067 2998 {
3068 2999 case EOB_ACT_LAST_MATCH:
3069 3000 /* This happens because yy_g_n_b()
... ... @@ -3077,16 +3008,16 @@ static int yy_get_next_buffer (void)
3077 3008 */
3078 3009  
3079 3010 /* Reset buffer status. */
3080   - yyrestart(yyin );
  3011 + yyrestart( yyin );
3081 3012  
3082   - /*FALLTHROUGH*/
  3013 + /* fall through */
3083 3014  
3084 3015 case EOB_ACT_END_OF_FILE:
3085 3016 {
3086   - if ( yywrap( ) )
  3017 + if ( yywrap() )
3087 3018 return EOF;
3088 3019  
3089   - if ( ! (yy_did_buffer_switch_on_eof) )
  3020 + if ( ! yy_did_buffer_switch_on_eof )
3090 3021 YY_NEW_FILE;
3091 3022 #ifdef __cplusplus
3092 3023 return yyinput();
... ... @@ -3096,94 +3027,91 @@ static int yy_get_next_buffer (void)
3096 3027 }
3097 3028  
3098 3029 case EOB_ACT_CONTINUE_SCAN:
3099   - (yy_c_buf_p) = (yytext_ptr) + offset;
  3030 + yy_c_buf_p = yytext_ptr + offset;
3100 3031 break;
3101 3032 }
3102 3033 }
3103 3034 }
3104 3035  
3105   - c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */
3106   - *(yy_c_buf_p) = '\0'; /* preserve yytext */
3107   - (yy_hold_char) = *++(yy_c_buf_p);
  3036 + c = *(unsigned char *) yy_c_buf_p; /* cast for 8-bit char's */
  3037 + *yy_c_buf_p = '\0'; /* preserve yytext */
  3038 + yy_hold_char = *++yy_c_buf_p;
3108 3039  
3109   - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n');
  3040 + yy_current_buffer->yy_at_bol = (c == '\n');
3110 3041  
3111 3042 return c;
3112   -}
3113   -#endif /* ifndef YY_NO_INPUT */
  3043 + }
3114 3044  
3115   -/** Immediately switch to a different input stream.
3116   - * @param input_file A readable stream.
3117   - *
3118   - * @note This function does not reset the start condition to @c INITIAL .
3119   - */
3120   - void yyrestart (FILE * input_file )
3121   -{
3122   -
3123   - if ( ! YY_CURRENT_BUFFER ){
3124   - yyensure_buffer_stack ();
3125   - YY_CURRENT_BUFFER_LVALUE =
3126   - yy_create_buffer(yyin,YY_BUF_SIZE );
  3045 +
  3046 +#ifdef YY_USE_PROTOS
  3047 +void yyrestart( FILE *input_file )
  3048 +#else
  3049 +void yyrestart( input_file )
  3050 +FILE *input_file;
  3051 +#endif
  3052 + {
  3053 + if ( ! yy_current_buffer )
  3054 + yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE );
  3055 +
  3056 + yy_init_buffer( yy_current_buffer, input_file );
  3057 + yy_load_buffer_state();
3127 3058 }
3128 3059  
3129   - yy_init_buffer(YY_CURRENT_BUFFER,input_file );
3130   - yy_load_buffer_state( );
3131   -}
3132 3060  
3133   -/** Switch to a different input buffer.
3134   - * @param new_buffer The new input buffer.
3135   - *
3136   - */
3137   - void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )
3138   -{
3139   -
3140   - /* TODO. We should be able to replace this entire function body
3141   - * with
3142   - * yypop_buffer_state();
3143   - * yypush_buffer_state(new_buffer);
3144   - */
3145   - yyensure_buffer_stack ();
3146   - if ( YY_CURRENT_BUFFER == new_buffer )
  3061 +#ifdef YY_USE_PROTOS
  3062 +void yy_switch_to_buffer( YY_BUFFER_STATE new_buffer )
  3063 +#else
  3064 +void yy_switch_to_buffer( new_buffer )
  3065 +YY_BUFFER_STATE new_buffer;
  3066 +#endif
  3067 + {
  3068 + if ( yy_current_buffer == new_buffer )
3147 3069 return;
3148 3070  
3149   - if ( YY_CURRENT_BUFFER )
  3071 + if ( yy_current_buffer )
3150 3072 {
3151 3073 /* Flush out information for old buffer. */
3152   - *(yy_c_buf_p) = (yy_hold_char);
3153   - YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
3154   - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
  3074 + *yy_c_buf_p = yy_hold_char;
  3075 + yy_current_buffer->yy_buf_pos = yy_c_buf_p;
  3076 + yy_current_buffer->yy_n_chars = yy_n_chars;
3155 3077 }
3156 3078  
3157   - YY_CURRENT_BUFFER_LVALUE = new_buffer;
3158   - yy_load_buffer_state( );
  3079 + yy_current_buffer = new_buffer;
  3080 + yy_load_buffer_state();
3159 3081  
3160 3082 /* We don't actually know whether we did this switch during
3161 3083 * EOF (yywrap()) processing, but the only time this flag
3162 3084 * is looked at is after yywrap() is called, so it's safe
3163 3085 * to go ahead and always set it.
3164 3086 */
3165   - (yy_did_buffer_switch_on_eof) = 1;
3166   -}
  3087 + yy_did_buffer_switch_on_eof = 1;
  3088 + }
3167 3089  
3168   -static void yy_load_buffer_state (void)
3169   -{
3170   - (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
3171   - (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
3172   - yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
3173   - (yy_hold_char) = *(yy_c_buf_p);
3174   -}
3175 3090  
3176   -/** Allocate and initialize an input buffer state.
3177   - * @param file A readable stream.
3178   - * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
3179   - *
3180   - * @return the allocated buffer state.
3181   - */
3182   - YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )
3183   -{
  3091 +#ifdef YY_USE_PROTOS
  3092 +void yy_load_buffer_state( void )
  3093 +#else
  3094 +void yy_load_buffer_state()
  3095 +#endif
  3096 + {
  3097 + yy_n_chars = yy_current_buffer->yy_n_chars;
  3098 + yytext_ptr = yy_c_buf_p = yy_current_buffer->yy_buf_pos;
  3099 + yyin = yy_current_buffer->yy_input_file;
  3100 + yy_hold_char = *yy_c_buf_p;
  3101 + }
  3102 +
  3103 +
  3104 +#ifdef YY_USE_PROTOS
  3105 +YY_BUFFER_STATE yy_create_buffer( FILE *file, int size )
  3106 +#else
  3107 +YY_BUFFER_STATE yy_create_buffer( file, size )
  3108 +FILE *file;
  3109 +int size;
  3110 +#endif
  3111 + {
3184 3112 YY_BUFFER_STATE b;
3185   -
3186   - b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
  3113 +
  3114 + b = (YY_BUFFER_STATE) yy_flex_alloc( sizeof( struct yy_buffer_state ) );
3187 3115 if ( ! b )
3188 3116 YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
3189 3117  
... ... @@ -3192,75 +3120,84 @@ static void yy_load_buffer_state (void)
3192 3120 /* yy_ch_buf has to be 2 characters longer than the size given because
3193 3121 * we need to put in 2 end-of-buffer characters.
3194 3122 */
3195   - b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 );
  3123 + b->yy_ch_buf = (char *) yy_flex_alloc( b->yy_buf_size + 2 );
3196 3124 if ( ! b->yy_ch_buf )
3197 3125 YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
3198 3126  
3199 3127 b->yy_is_our_buffer = 1;
3200 3128  
3201   - yy_init_buffer(b,file );
  3129 + yy_init_buffer( b, file );
3202 3130  
3203 3131 return b;
3204   -}
  3132 + }
3205 3133  
3206   -/** Destroy the buffer.
3207   - * @param b a buffer created with yy_create_buffer()
3208   - *
3209   - */
3210   - void yy_delete_buffer (YY_BUFFER_STATE b )
3211   -{
3212   -
  3134 +
  3135 +#ifdef YY_USE_PROTOS
  3136 +void yy_delete_buffer( YY_BUFFER_STATE b )
  3137 +#else
  3138 +void yy_delete_buffer( b )
  3139 +YY_BUFFER_STATE b;
  3140 +#endif
  3141 + {
3213 3142 if ( ! b )
3214 3143 return;
3215 3144  
3216   - if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
3217   - YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
  3145 + if ( b == yy_current_buffer )
  3146 + yy_current_buffer = (YY_BUFFER_STATE) 0;
3218 3147  
3219 3148 if ( b->yy_is_our_buffer )
3220   - yyfree((void *) b->yy_ch_buf );
  3149 + yy_flex_free( (void *) b->yy_ch_buf );
3221 3150  
3222   - yyfree((void *) b );
3223   -}
  3151 + yy_flex_free( (void *) b );
  3152 + }
3224 3153  
3225   -#ifndef __cplusplus
3226   -extern int isatty (int );
3227   -#endif /* __cplusplus */
3228   -
3229   -/* Initializes or reinitializes a buffer.
3230   - * This function is sometimes called more than once on the same buffer,
3231   - * such as during a yyrestart() or at EOF.
3232   - */
3233   - static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )
3234 3154  
3235   -{
3236   - int oerrno = errno;
3237   -
3238   - yy_flush_buffer(b );
  3155 +#ifndef _WIN32
  3156 +#include <unistd.h>
  3157 +#else
  3158 +#ifndef YY_ALWAYS_INTERACTIVE
  3159 +#ifndef YY_NEVER_INTERACTIVE
  3160 +extern int isatty YY_PROTO(( int ));
  3161 +#endif
  3162 +#endif
  3163 +#endif
  3164 +
  3165 +#ifdef YY_USE_PROTOS
  3166 +void yy_init_buffer( YY_BUFFER_STATE b, FILE *file )
  3167 +#else
  3168 +void yy_init_buffer( b, file )
  3169 +YY_BUFFER_STATE b;
  3170 +FILE *file;
  3171 +#endif
  3172 +
  3173 +
  3174 + {
  3175 + yy_flush_buffer( b );
3239 3176  
3240 3177 b->yy_input_file = file;
3241 3178 b->yy_fill_buffer = 1;
3242 3179  
3243   - /* If b is the current buffer, then yy_init_buffer was _probably_
3244   - * called from yyrestart() or through yy_get_next_buffer.
3245   - * In that case, we don't want to reset the lineno or column.
3246   - */
3247   - if (b != YY_CURRENT_BUFFER){
3248   - b->yy_bs_lineno = 1;
3249   - b->yy_bs_column = 0;
3250   - }
  3180 +#if YY_ALWAYS_INTERACTIVE
  3181 + b->yy_is_interactive = 1;
  3182 +#else
  3183 +#if YY_NEVER_INTERACTIVE
  3184 + b->yy_is_interactive = 0;
  3185 +#else
  3186 + b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
  3187 +#endif
  3188 +#endif
  3189 + }
3251 3190  
3252   - b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
3253   -
3254   - errno = oerrno;
3255   -}
3256 3191  
3257   -/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
3258   - * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
3259   - *
3260   - */
3261   - void yy_flush_buffer (YY_BUFFER_STATE b )
3262   -{
3263   - if ( ! b )
  3192 +#ifdef YY_USE_PROTOS
  3193 +void yy_flush_buffer( YY_BUFFER_STATE b )
  3194 +#else
  3195 +void yy_flush_buffer( b )
  3196 +YY_BUFFER_STATE b;
  3197 +#endif
  3198 +
  3199 + {
  3200 + if ( ! b )
3264 3201 return;
3265 3202  
3266 3203 b->yy_n_chars = 0;
... ... @@ -3277,121 +3214,29 @@ extern int isatty (int );
3277 3214 b->yy_at_bol = 1;
3278 3215 b->yy_buffer_status = YY_BUFFER_NEW;
3279 3216  
3280   - if ( b == YY_CURRENT_BUFFER )
3281   - yy_load_buffer_state( );
3282   -}
3283   -
3284   -/** Pushes the new state onto the stack. The new state becomes
3285   - * the current state. This function will allocate the stack
3286   - * if necessary.
3287   - * @param new_buffer The new state.
3288   - *
3289   - */
3290   -void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
3291   -{
3292   - if (new_buffer == NULL)
3293   - return;
3294   -
3295   - yyensure_buffer_stack();
3296   -
3297   - /* This block is copied from yy_switch_to_buffer. */
3298   - if ( YY_CURRENT_BUFFER )
3299   - {
3300   - /* Flush out information for old buffer. */
3301   - *(yy_c_buf_p) = (yy_hold_char);
3302   - YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
3303   - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
3304   - }
3305   -
3306   - /* Only push if top exists. Otherwise, replace top. */
3307   - if (YY_CURRENT_BUFFER)
3308   - (yy_buffer_stack_top)++;
3309   - YY_CURRENT_BUFFER_LVALUE = new_buffer;
3310   -
3311   - /* copied from yy_switch_to_buffer. */
3312   - yy_load_buffer_state( );
3313   - (yy_did_buffer_switch_on_eof) = 1;
3314   -}
3315   -
3316   -/** Removes and deletes the top of the stack, if present.
3317   - * The next element becomes the new top.
3318   - *
3319   - */
3320   -void yypop_buffer_state (void)
3321   -{
3322   - if (!YY_CURRENT_BUFFER)
3323   - return;
3324   -
3325   - yy_delete_buffer(YY_CURRENT_BUFFER );
3326   - YY_CURRENT_BUFFER_LVALUE = NULL;
3327   - if ((yy_buffer_stack_top) > 0)
3328   - --(yy_buffer_stack_top);
3329   -
3330   - if (YY_CURRENT_BUFFER) {
3331   - yy_load_buffer_state( );
3332   - (yy_did_buffer_switch_on_eof) = 1;
3333   - }
3334   -}
3335   -
3336   -/* Allocates the stack if it does not exist.
3337   - * Guarantees space for at least one push.
3338   - */
3339   -static void yyensure_buffer_stack (void)
3340   -{
3341   - int num_to_alloc;
3342   -
3343   - if (!(yy_buffer_stack)) {
3344   -
3345   - /* First allocation is just for 2 elements, since we don't know if this
3346   - * scanner will even need a stack. We use 2 instead of 1 to avoid an
3347   - * immediate realloc on the next call.
3348   - */
3349   - num_to_alloc = 1;
3350   - (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
3351   - (num_to_alloc * sizeof(struct yy_buffer_state*)
3352   - );
3353   -
3354   - memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
3355   -
3356   - (yy_buffer_stack_max) = num_to_alloc;
3357   - (yy_buffer_stack_top) = 0;
3358   - return;
  3217 + if ( b == yy_current_buffer )
  3218 + yy_load_buffer_state();
3359 3219 }
3360 3220  
3361   - if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
3362   -
3363   - /* Increase the buffer to prepare for a possible push. */
3364   - int grow_size = 8 /* arbitrary grow size */;
3365 3221  
3366   - num_to_alloc = (yy_buffer_stack_max) + grow_size;
3367   - (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
3368   - ((yy_buffer_stack),
3369   - num_to_alloc * sizeof(struct yy_buffer_state*)
3370   - );
3371   -
3372   - /* zero only the new slots.*/
3373   - memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
3374   - (yy_buffer_stack_max) = num_to_alloc;
3375   - }
3376   -}
3377   -
3378   -/** Setup the input buffer state to scan directly from a user-specified character buffer.
3379   - * @param base the character buffer
3380   - * @param size the size in bytes of the character buffer
3381   - *
3382   - * @return the newly allocated buffer state object.
3383   - */
3384   -YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
3385   -{
  3222 +#ifndef YY_NO_SCAN_BUFFER
  3223 +#ifdef YY_USE_PROTOS
  3224 +YY_BUFFER_STATE yy_scan_buffer( char *base, yy_size_t size )
  3225 +#else
  3226 +YY_BUFFER_STATE yy_scan_buffer( base, size )
  3227 +char *base;
  3228 +yy_size_t size;
  3229 +#endif
  3230 + {
3386 3231 YY_BUFFER_STATE b;
3387   -
  3232 +
3388 3233 if ( size < 2 ||
3389 3234 base[size-2] != YY_END_OF_BUFFER_CHAR ||
3390 3235 base[size-1] != YY_END_OF_BUFFER_CHAR )
3391 3236 /* They forgot to leave room for the EOB's. */
3392 3237 return 0;
3393 3238  
3394   - b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
  3239 + b = (YY_BUFFER_STATE) yy_flex_alloc( sizeof( struct yy_buffer_state ) );
3395 3240 if ( ! b )
3396 3241 YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
3397 3242  
... ... @@ -3405,42 +3250,47 @@ YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
3405 3250 b->yy_fill_buffer = 0;
3406 3251 b->yy_buffer_status = YY_BUFFER_NEW;
3407 3252  
3408   - yy_switch_to_buffer(b );
  3253 + yy_switch_to_buffer( b );
3409 3254  
3410 3255 return b;
3411   -}
  3256 + }
  3257 +#endif
3412 3258  
3413   -/** Setup the input buffer state to scan a string. The next call to yylex() will
3414   - * scan from a @e copy of @a str.
3415   - * @param str a NUL-terminated string to scan
3416   - *
3417   - * @return the newly allocated buffer state object.
3418   - * @note If you want to scan bytes that may contain NUL values, then use
3419   - * yy_scan_bytes() instead.
3420   - */
3421   -YY_BUFFER_STATE yy_scan_string (yyconst char * yy_str )
3422   -{
3423   -
3424   - return yy_scan_bytes(yy_str,strlen(yy_str) );
3425   -}
3426 3259  
3427   -/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
3428   - * scan from a @e copy of @a bytes.
3429   - * @param bytes the byte buffer to scan
3430   - * @param len the number of bytes in the buffer pointed to by @a bytes.
3431   - *
3432   - * @return the newly allocated buffer state object.
3433   - */
3434   -YY_BUFFER_STATE yy_scan_bytes (yyconst char * bytes, int len )
3435   -{
  3260 +#ifndef YY_NO_SCAN_STRING
  3261 +#ifdef YY_USE_PROTOS
  3262 +YY_BUFFER_STATE yy_scan_string( yyconst char *yy_str )
  3263 +#else
  3264 +YY_BUFFER_STATE yy_scan_string( yy_str )
  3265 +yyconst char *yy_str;
  3266 +#endif
  3267 + {
  3268 + int len;
  3269 + for ( len = 0; yy_str[len]; ++len )
  3270 + ;
  3271 +
  3272 + return yy_scan_bytes( yy_str, len );
  3273 + }
  3274 +#endif
  3275 +
  3276 +
  3277 +#ifndef YY_NO_SCAN_BYTES
  3278 +#ifdef YY_USE_PROTOS
  3279 +YY_BUFFER_STATE yy_scan_bytes( yyconst char *bytes, int len )
  3280 +#else
  3281 +YY_BUFFER_STATE yy_scan_bytes( bytes, len )
  3282 +yyconst char *bytes;
  3283 +int len;
  3284 +#endif
  3285 + {
3436 3286 YY_BUFFER_STATE b;
3437 3287 char *buf;
3438 3288 yy_size_t n;
3439 3289 int i;
3440   -
  3290 +
3441 3291 /* Get memory for full buffer, including space for trailing EOB's. */
3442 3292 n = len + 2;
3443   - buf = (char *) yyalloc(n );
  3293 + buf = (char *) yy_flex_alloc( n );
3444 3294 if ( ! buf )
3445 3295 YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
3446 3296  
... ... @@ -3449,7 +3299,7 @@ YY_BUFFER_STATE yy_scan_bytes (yyconst char * bytes, int len )
3449 3299  
3450 3300 buf[len] = buf[len+1] = YY_END_OF_BUFFER_CHAR;
3451 3301  
3452   - b = yy_scan_buffer(buf,n );
  3302 + b = yy_scan_buffer( buf, n );
3453 3303 if ( ! b )
3454 3304 YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
3455 3305  
... ... @@ -3459,164 +3309,148 @@ YY_BUFFER_STATE yy_scan_bytes (yyconst char * bytes, int len )
3459 3309 b->yy_is_our_buffer = 1;
3460 3310  
3461 3311 return b;
3462   -}
  3312 + }
  3313 +#endif
3463 3314  
3464   -#ifndef YY_EXIT_FAILURE
3465   -#define YY_EXIT_FAILURE 2
  3315 +
  3316 +#ifndef YY_NO_PUSH_STATE
  3317 +#ifdef YY_USE_PROTOS
  3318 +static void yy_push_state( int new_state )
  3319 +#else
  3320 +static void yy_push_state( new_state )
  3321 +int new_state;
3466 3322 #endif
  3323 + {
  3324 + if ( yy_start_stack_ptr >= yy_start_stack_depth )
  3325 + {
  3326 + yy_size_t new_size;
3467 3327  
3468   -static void yy_fatal_error (yyconst char* msg )
3469   -{
3470   - (void) fprintf( stderr, "%s\n", msg );
3471   - exit( YY_EXIT_FAILURE );
3472   -}
  3328 + yy_start_stack_depth += YY_START_STACK_INCR;
  3329 + new_size = yy_start_stack_depth * sizeof( int );
3473 3330  
3474   -/* Redefine yyless() so it works in section 3 code. */
  3331 + if ( ! yy_start_stack )
  3332 + yy_start_stack = (int *) yy_flex_alloc( new_size );
3475 3333  
3476   -#undef yyless
3477   -#define yyless(n) \
3478   - do \
3479   - { \
3480   - /* Undo effects of setting up yytext. */ \
3481   - int yyless_macro_arg = (n); \
3482   - YY_LESS_LINENO(yyless_macro_arg);\
3483   - yytext[yyleng] = (yy_hold_char); \
3484   - (yy_c_buf_p) = yytext + yyless_macro_arg; \
3485   - (yy_hold_char) = *(yy_c_buf_p); \
3486   - *(yy_c_buf_p) = '\0'; \
3487   - yyleng = yyless_macro_arg; \
3488   - } \
3489   - while ( 0 )
  3334 + else
  3335 + yy_start_stack = (int *) yy_flex_realloc(
  3336 + (void *) yy_start_stack, new_size );
3490 3337  
3491   -/* Accessor methods (get/set functions) to struct members. */
  3338 + if ( ! yy_start_stack )
  3339 + YY_FATAL_ERROR(
  3340 + "out of memory expanding start-condition stack" );
  3341 + }
3492 3342  
3493   -/** Get the current line number.
3494   - *
3495   - */
3496   -int yyget_lineno (void)
3497   -{
3498   -
3499   - return yylineno;
3500   -}
  3343 + yy_start_stack[yy_start_stack_ptr++] = YY_START;
3501 3344  
3502   -/** Get the input stream.
3503   - *
3504   - */
3505   -FILE *yyget_in (void)
3506   -{
3507   - return yyin;
3508   -}
  3345 + BEGIN(new_state);
  3346 + }
  3347 +#endif
3509 3348  
3510   -/** Get the output stream.
3511   - *
3512   - */
3513   -FILE *yyget_out (void)
3514   -{
3515   - return yyout;
3516   -}
3517 3349  
3518   -/** Get the length of the current token.
3519   - *
3520   - */
3521   -int yyget_leng (void)
3522   -{
3523   - return yyleng;
3524   -}
  3350 +#ifndef YY_NO_POP_STATE
  3351 +static void yy_pop_state()
  3352 + {
  3353 + if ( --yy_start_stack_ptr < 0 )
  3354 + YY_FATAL_ERROR( "start-condition stack underflow" );
3525 3355  
3526   -/** Get the current token.
3527   - *
3528   - */
  3356 + BEGIN(yy_start_stack[yy_start_stack_ptr]);
  3357 + }
  3358 +#endif
3529 3359  
3530   -char *yyget_text (void)
3531   -{
3532   - return yytext;
3533   -}
3534 3360  
3535   -/** Set the current line number.
3536   - * @param line_number
3537   - *
3538   - */
3539   -void yyset_lineno (int line_number )
3540   -{
3541   -
3542   - yylineno = line_number;
3543   -}
  3361 +#ifndef YY_NO_TOP_STATE
  3362 +static int yy_top_state()
  3363 + {
  3364 + return yy_start_stack[yy_start_stack_ptr - 1];
  3365 + }
  3366 +#endif
3544 3367  
3545   -/** Set the input stream. This does not discard the current
3546   - * input buffer.
3547   - * @param in_str A readable stream.
3548   - *
3549   - * @see yy_switch_to_buffer
3550   - */
3551   -void yyset_in (FILE * in_str )
3552   -{
3553   - yyin = in_str ;
3554   -}
  3368 +#ifndef YY_EXIT_FAILURE
  3369 +#define YY_EXIT_FAILURE 2
  3370 +#endif
3555 3371  
3556   -void yyset_out (FILE * out_str )
3557   -{
3558   - yyout = out_str ;
3559   -}
  3372 +#ifdef YY_USE_PROTOS
  3373 +static void yy_fatal_error( yyconst char msg[] )
  3374 +#else
  3375 +static void yy_fatal_error( msg )
  3376 +char msg[];
  3377 +#endif
  3378 + {
  3379 + (void) fprintf( stderr, "%s\n", msg );
  3380 + exit( YY_EXIT_FAILURE );
  3381 + }
3560 3382  
3561   -int yyget_debug (void)
3562   -{
3563   - return yy_flex_debug;
3564   -}
3565 3383  
3566   -void yyset_debug (int bdebug )
3567   -{
3568   - yy_flex_debug = bdebug ;
3569   -}
3570 3384  
3571   -/* yylex_destroy is for both reentrant and non-reentrant scanners. */
3572   -int yylex_destroy (void)
3573   -{
3574   -
3575   - /* Pop the buffer stack, destroying each element. */
3576   - while(YY_CURRENT_BUFFER){
3577   - yy_delete_buffer(YY_CURRENT_BUFFER );
3578   - YY_CURRENT_BUFFER_LVALUE = NULL;
3579   - yypop_buffer_state();
3580   - }
  3385 +/* Redefine yyless() so it works in section 3 code. */
3581 3386  
3582   - /* Destroy the stack itself. */
3583   - yyfree((yy_buffer_stack) );
3584   - (yy_buffer_stack) = NULL;
  3387 +#undef yyless
  3388 +#define yyless(n) \
  3389 + do \
  3390 + { \
  3391 + /* Undo effects of setting up yytext. */ \
  3392 + yytext[yyleng] = yy_hold_char; \
  3393 + yy_c_buf_p = yytext + n; \
  3394 + yy_hold_char = *yy_c_buf_p; \
  3395 + *yy_c_buf_p = '\0'; \
  3396 + yyleng = n; \
  3397 + } \
  3398 + while ( 0 )
3585 3399  
3586   - return 0;
3587   -}
3588 3400  
3589   -/*
3590   - * Internal utility routines.
3591   - */
  3401 +/* Internal utility routines. */
3592 3402  
3593 3403 #ifndef yytext_ptr
3594   -static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
3595   -{
  3404 +#ifdef YY_USE_PROTOS
  3405 +static void yy_flex_strncpy( char *s1, yyconst char *s2, int n )
  3406 +#else
  3407 +static void yy_flex_strncpy( s1, s2, n )
  3408 +char *s1;
  3409 +yyconst char *s2;
  3410 +int n;
  3411 +#endif
  3412 + {
3596 3413 register int i;
3597   - for ( i = 0; i < n; ++i )
  3414 + for ( i = 0; i < n; ++i )
3598 3415 s1[i] = s2[i];
3599   -}
  3416 + }
3600 3417 #endif
3601 3418  
3602 3419 #ifdef YY_NEED_STRLEN
3603   -static int yy_flex_strlen (yyconst char * s )
3604   -{
  3420 +#ifdef YY_USE_PROTOS
  3421 +static int yy_flex_strlen( yyconst char *s )
  3422 +#else
  3423 +static int yy_flex_strlen( s )
  3424 +yyconst char *s;
  3425 +#endif
  3426 + {
3605 3427 register int n;
3606   - for ( n = 0; s[n]; ++n )
  3428 + for ( n = 0; s[n]; ++n )
3607 3429 ;
3608 3430  
3609 3431 return n;
3610   -}
  3432 + }
3611 3433 #endif
3612 3434  
3613   -void *yyalloc (yy_size_t size )
3614   -{
  3435 +
  3436 +#ifdef YY_USE_PROTOS
  3437 +static void *yy_flex_alloc( yy_size_t size )
  3438 +#else
  3439 +static void *yy_flex_alloc( size )
  3440 +yy_size_t size;
  3441 +#endif
  3442 + {
3615 3443 return (void *) malloc( size );
3616   -}
  3444 + }
3617 3445  
3618   -void *yyrealloc (void * ptr, yy_size_t size )
3619   -{
  3446 +#ifdef YY_USE_PROTOS
  3447 +static void *yy_flex_realloc( void *ptr, yy_size_t size )
  3448 +#else
  3449 +static void *yy_flex_realloc( ptr, size )
  3450 +void *ptr;
  3451 +yy_size_t size;
  3452 +#endif
  3453 + {
3620 3454 /* The cast to (char *) in the following accommodates both
3621 3455 * implementations that use char* generic pointers, and those
3622 3456 * that use void* generic pointers. It works with the latter
... ... @@ -3625,32 +3459,29 @@ void *yyrealloc (void * ptr, yy_size_t size )
3625 3459 * as though doing an assignment.
3626 3460 */
3627 3461 return (void *) realloc( (char *) ptr, size );
3628   -}
3629   -
3630   -void yyfree (void * ptr )
3631   -{
3632   - free( (char *) ptr ); /* see yyrealloc() for (char *) cast */
3633   -}
3634   -
3635   -#define YYTABLES_NAME "yytables"
  3462 + }
3636 3463  
3637   -#undef YY_NEW_FILE
3638   -#undef YY_FLUSH_BUFFER
3639   -#undef yy_set_bol
3640   -#undef yy_new_buffer
3641   -#undef yy_set_interactive
3642   -#undef yytext_ptr
3643   -#undef YY_DO_BEFORE_ACTION
  3464 +#ifdef YY_USE_PROTOS
  3465 +static void yy_flex_free( void *ptr )
  3466 +#else
  3467 +static void yy_flex_free( ptr )
  3468 +void *ptr;
  3469 +#endif
  3470 + {
  3471 + free( ptr );
  3472 + }
3644 3473  
3645   -#ifdef YY_DECL_IS_OURS
3646   -#undef YY_DECL_IS_OURS
3647   -#undef YY_DECL
  3474 +#if YY_MAIN
  3475 +int main()
  3476 + {
  3477 + yylex();
  3478 + return 0;
  3479 + }
3648 3480 #endif
3649 3481 #line 853 "lexer.y"
3650 3482  
3651 3483  
3652 3484  
3653   -
3654 3485 void end_of_par(void)
3655 3486 {
3656 3487 BEGIN INITIAL;
... ... @@ -3696,5 +3527,4 @@ void begin_INITIAL(void)
3696 3527 }
3697 3528  
3698 3529 /* end of lexer -----------------------------------------------------------------------*/
3699   -
3700 3530  
... ...
anubis_dev/compiler/src/main.c
  Show/Hide comments   View file @e69a754
... ... @@ -66,7 +66,7 @@ int initializing = 1;
66 66 int configure = 0;
67 67 int no_config_file_found = 0;
68 68 int make_awp = 1;
69   -int read1 = 0;
  69 +int read1 = 1;
70 70 int phase = 1;
71 71 int check_only = 0;
72 72 int standard_error_output = 0;
... ... @@ -139,9 +139,9 @@ static void read_command_line(int argc, char **argv)
139 139 int i;
140 140 for (i = 1; i < argc; i++)
141 141 if (argv[i][0] == '-')
142   - read_option(argv[i]+1);
  142 + read_option(argv[i]+1);
143 143 else
144   - source_file_name = argv[i];
  144 + source_file_name = argv[i];
145 145 }
146 146  
147 147  
... ... @@ -327,12 +327,16 @@ static void init(int argc, char **argv)
327 327 else
328 328 {
329 329 no_config_file_found = 1;
330   - unput_token = 0; // required when config file not read in
  330 + unput_token = 0; // required when config file not read in
331 331 }
332 332 }
333 333 if (configure) configure_compiler();
334 334  
  335 +#ifdef _no_predef_dat_
  336 +#else
335 337 read_predef_dat();
  338 +#endif
  339 +
336 340 }
337 341 source_file_name = actual_source_file_name;
338 342 }
... ... @@ -402,10 +406,10 @@ int main(int argc, char **argv)
402 406 }
403 407  
404 408 if (anubis_directory == NULL)
405   - anubis_directory = getenv("ANUBIS");
406   -
  409 + anubis_directory = getenv("ANUBIS");
  410 +
407 411 if (my_anubis_directory == NULL)
408   - my_anubis_directory = getenv("MY_ANUBIS");
  412 + my_anubis_directory = getenv("MY_ANUBIS");
409 413  
410 414 if (anubis_directory == NULL)
411 415 {
... ... @@ -438,7 +442,7 @@ int main(int argc, char **argv)
438 442  
439 443 board_headers();
440 444  
441   - //if need, create missing directories
  445 + //if need, create missing directories
442 446 mkdirz(my_anubis_directory);
443 447 snprintf(buf,990,"%s/configuration",my_anubis_directory);
444 448 mkdirz(buf);
... ... @@ -457,13 +461,13 @@ int main(int argc, char **argv)
457 461  
458 462 /* do a special stuff for MS-Windows */
459 463 //#ifdef WIN32
460   -// errfile = stderr; // to avoid a NULL file in all cases
461   -// if (standard_error_output)
462   -// {
463   -// //errfile = stderr;
464   -// }
465   -// else
466   -// {
  464 +// errfile = stderr; // to avoid a NULL file in all cases
  465 +// if (standard_error_output)
  466 +// {
  467 +// //errfile = stderr;
  468 +// }
  469 +// else
  470 +// {
467 471 // if (source_file_name[0] != 0)
468 472 //// anb_exit(1);
469 473 // {
... ... @@ -474,17 +478,17 @@ int main(int argc, char **argv)
474 478 // buf[i] = source_file_name[i]; i++;
475 479 // }
476 480 // while (buf[i] != '.' && i > 0) i--;
477   -// i++;
  481 +// i++;
478 482 // while (err_file_name[j] != 0)
479 483 // {
480 484 // buf[i++] = err_file_name[j++];
481 485 // }
482 486 // buf[i] = 0;
483 487 // errfile = fopenz(buf,"wt"); /* if file cannot be opened 'fopenz' will print into
484   -// 'errfile' making a violation if errfile has no default
485   -// value. Fortunately the default value is 'stderr' */
  488 +// 'errfile' making a violation if errfile has no default
  489 +// value. Fortunately the default value is 'stderr' */
486 490 // }
487   -// }
  491 +// }
488 492 //#else
489 493 errfile = stderr;
490 494 //#endif
... ... @@ -525,6 +529,8 @@ int main(int argc, char **argv)
525 529 unput_token = 0;
526 530 snprintf(buf,buf_size,"predef.aux");
527 531 predef_aux = fopenz(buf,"wt");
  532 + snprintf(buf,buf_size,"predef_npd.aux");
  533 + predef_npd_aux = fopenz(buf,"wt");
528 534 snprintf(buf,buf_size,"predef_1_%d.dat",min_version);
529 535 predef_dat = fopenz(buf,"wb");
530 536 put32(predef_dat,condensate_version(1,min_version,0));
... ... @@ -536,6 +542,7 @@ int main(int argc, char **argv)
536 542 yyparse();
537 543 fclose(yyin);
538 544 fclose(predef_aux);
  545 + fclose(predef_npd_aux);
539 546 fclose(predef_dat);
540 547 if (dct) dump_C_types();
541 548 if (board_option) fprintf(stderr,"\n");
... ... @@ -585,7 +592,7 @@ int main(int argc, char **argv)
585 592 if (incorrect_pars)
586 593 {
587 594 if (tab_seen)
588   - fprintf(errfile,msgtext_tab_seen[language],tab_width);
  595 + fprintf(errfile,msgtext_tab_seen[language],tab_width);
589 596 finish_show_reads();
590 597 return 1;
591 598 }
... ... @@ -609,12 +616,12 @@ int main(int argc, char **argv)
609 616 {
610 617 int i;
611 618 for (i = 0; i < next_implem; i++)
612   - {
613   - printf("\n\n[%d] (at label %d) Implementation of ",i,integer_value(implems[i].addr));
614   - show_type(stdout,implems[i].type,implems[i].env);
615   - printf(":\n ");
616   - print_expr(stdout,implems[i].implem);
617   - }
  619 + {
  620 + printf("\n\n[%d] (at label %d) Implementation of ",i,integer_value(implems[i].addr));
  621 + show_type(stdout,implems[i].type,implems[i].env);
  622 + printf(":\n ");
  623 + print_expr(stdout,implems[i].implem);
  624 + }
618 625 printf("\n");
619 626  
620 627 }
... ... @@ -702,7 +709,7 @@ int main(int argc, char **argv)
702 709 if (errors)
703 710 {
704 711 if (tab_seen)
705   - fprintf(errfile,msgtext_tab_seen[language],tab_width);
  712 + fprintf(errfile,msgtext_tab_seen[language],tab_width);
706 713 finish_show_reads();
707 714 return 1;
708 715 }
... ...
anubis_dev/compiler/src/mallocz.c
  Show/Hide comments   View file @e69a754
... ... @@ -19,7 +19,7 @@ void *mallocz1(int n)
19 19 if (result == NULL)
20 20 {
21 21 fprintf(errfile,
22   - msgtext_not_enough_memory[language]);
  22 + msgtext_not_enough_memory[language]);
23 23 anb_exit(1);
24 24 }
25 25 memset(result,255,n);
... ... @@ -35,7 +35,7 @@ void *reallocz1(void *old, size_t new_size)
35 35 if (result == NULL)
36 36 {
37 37 fprintf(errfile,
38   - msgtext_not_enough_memory[language]);
  38 + msgtext_not_enough_memory[language]);
39 39 anb_exit(1);
40 40 }
41 41  
... ...
anubis_dev/compiler/src/new_var.c
  Show/Hide comments   View file @e69a754
... ... @@ -21,8 +21,8 @@ void new_variable (Expr lc,
21 21  
22 22 if (verbose && par_seen)
23 23 printf(msgtext_checking_variable[language],
24   - string_content(name),
25   - line_in(lc));
  24 + string_content(name),
  25 + line_in(lc));
26 26  
27 27 /* parameters are forbidden in type and init */
28 28 aux = nil;
... ... @@ -32,9 +32,9 @@ void new_variable (Expr lc,
32 32 {
33 33 err_line_col(lc);
34 34 fprintf(errfile,
35   - msgtext_variable_with_parms[language],
36   - string_content(name));
37   - return;
  35 + msgtext_variable_with_parms[language],
  36 + string_content(name));
  37 + return;
38 38 }
39 39  
40 40 /* check type */
... ... @@ -45,13 +45,13 @@ void new_variable (Expr lc,
45 45 for (i = 0; i < next_variable; i++)
46 46 if (variables[i].name == name)
47 47 if (same_type(variables[i].type,nil,type,nil))
48   - {
49   - err_line_col(lc);
50   - fprintf(errfile,
51   - msgtext_variable_redeclaration[language],
52   - name);
53   - return ;
54   - }
  48 + {
  49 + err_line_col(lc);
  50 + fprintf(errfile,
  51 + msgtext_variable_redeclaration[language],
  52 + name);
  53 + return ;
  54 + }
55 55  
56 56 /* interpret initial value */
57 57 init_ints = term_interpretations(type,
... ... @@ -68,13 +68,13 @@ void new_variable (Expr lc,
68 68 Expr new_env;
69 69  
70 70 new_env = unify(type_from_interpretation(car(car(aux)),cdr(car(aux))),
71   - cdr(car(aux)),
72   - type,
73   - nil);
  71 + cdr(car(aux)),
  72 + type,
  73 + nil);
74 74  
75 75  
76 76 if (new_env != not_unifiable)
77   - init_ints = cons(cons(car(car(aux)),new_env),init_ints);
  77 + init_ints = cons(cons(car(car(aux)),new_env),init_ints);
78 78 aux = cdr(aux);
79 79 }
80 80  
... ... @@ -86,7 +86,7 @@ void new_variable (Expr lc,
86 86 {
87 87 max_variable += 100;
88 88 variables = (struct Variable_struct *)reallocz(variables,
89   - max_variable*sizeof(struct Variable_struct));
  89 + max_variable*sizeof(struct Variable_struct));
90 90 }
91 91  
92 92 variables[next_variable].name = name;
... ... @@ -109,4 +109,15 @@ void new_variable (Expr lc,
109 109 fprintf(predef_aux,"\n");
110 110 }
111 111  
  112 + if (predef_npd_aux != NULL)
  113 + {
  114 + fprintf(predef_npd_aux,"\nnew_variable(new_integer(0),%d,\n",global);
  115 + print_expr_to_C(predef_npd_aux,type);
  116 + fprintf(predef_npd_aux,"\n");
  117 + print_expr_to_C(predef_npd_aux,name);
  118 + fprintf(predef_npd_aux,"\n");
  119 + print_expr_to_C(predef_npd_aux,init);
  120 + fprintf(predef_npd_aux,"\n");
  121 + }
  122 +
112 123 }
... ...
anubis_dev/compiler/src/opdef.c
  Show/Hide comments   View file @e69a754
... ... @@ -36,13 +36,13 @@ void collect_type_variables(Expr *result, Expr expr)
36 36 if (is_user_type_variable(expr))
37 37 {
38 38 if (!member(expr,*result))
39   - *result = cons(expr,*result);
  39 + *result = cons(expr,*result);
40 40 }
41 41  
42 42 else if (consp(expr))
43 43 {
44 44 if (car(expr) == integer ||
45   - car(expr) == int32 ||
  45 + car(expr) == anb_int32 ||
46 46 car(expr) == small_datum)
47 47 {
48 48 }
... ... @@ -58,11 +58,11 @@ void collect_type_variables(Expr *result, Expr expr)
58 58  
59 59  
60 60 void new_op_scheme(Expr lc, /* <lc> */
61   - int global,
62   - Expr ttype, /* target type */
63   - Expr names,
64   - Expr args, /* ((type . sym) ... (type . sym)) */
65   - Expr body) /* body is 'no_term' in case of a declaration */
  61 + int global,
  62 + Expr ttype, /* target type */
  63 + Expr names,
  64 + Expr args, /* ((type . sym) ... (type . sym)) */
  65 + Expr body) /* body is 'no_term' in case of a declaration */
66 66 {
67 67 Expr aux, parms, hidden_parms, sign, ctxt;
68 68 int n;
... ... @@ -83,9 +83,9 @@ void new_op_scheme(Expr lc, /* &lt;lc&gt; */
83 83  
84 84 if (verbose && par_seen)
85 85 printf(msgtext_checking_operation[language],
86   - string_content(car(names)),
  86 + string_content(car(names)),
87 87 file_in(lc),
88   - line_in(lc));
  88 + line_in(lc));
89 89  
90 90 /* collect_type_variables into parms (without repetition) */
91 91 parms = nil;
... ... @@ -124,8 +124,8 @@ void new_op_scheme(Expr lc, /* &lt;lc&gt; */
124 124 {
125 125 err_line_col(lc);
126 126 fprintf(errfile,
127   - msgtext_global_with_parms[language],
128   - string_content(car(names)));
  127 + msgtext_global_with_parms[language],
  128 + string_content(car(names)));
129 129 return;
130 130 }
131 131  
... ... @@ -227,20 +227,20 @@ void new_op_scheme(Expr lc, /* &lt;lc&gt; */
227 227 {
228 228 /* signature must be ((app_ts pdstr_List type_String)) */
229 229 if (!consp(sign) ||
230   - !consp(car(sign)) ||
  230 + !consp(car(sign)) ||
231 231 car(car(sign)) != app_ts ||
232 232 second(car(sign)) != pdstr_List ||
233 233 third(car(sign)) != type_String ||
234 234 cdr(sign) != nil ||
235 235 cdr3(car(sign)) != nil)
236   - {
237   - err_line_col(lc);
238   - fprintf(errfile,
239   - msgtext_bad_global_signature[language]);
240   - show_types(errfile,sign,nil);
  236 + {
  237 + err_line_col(lc);
  238 + fprintf(errfile,
  239 + msgtext_bad_global_signature[language]);
  240 + show_types(errfile,sign,nil);
241 241 fprintf(errfile,"\n\n");
242   - return;
243   - }
  242 + return;
  243 + }
244 244 }
245 245  
246 246 /* operation may have been declared already (same name,
... ... @@ -255,15 +255,15 @@ void new_op_scheme(Expr lc, /* &lt;lc&gt; */
255 255 if (accessible_op(opid,file_name) &&
256 256 is_visible(string_content(operations[opid].file_name)) &&
257 257 have_common_element(names,operations[opid].names) &&
258   - equal(ttype,operations[opid].target_type) &&
259   - equal(sign,operations[opid].signature) &&
  258 + equal(ttype,operations[opid].target_type) &&
  259 + equal(sign,operations[opid].signature) &&
260 260 equal(parms,operations[opid].parms)
261   - /* TODO: refresh target types and signatures, so that names
262   - of user type variables are no more part of the
263   - definition. */
264   - )
265   - {
266   - /* definition found */
  261 + /* TODO: refresh target types and signatures, so that names
  262 + of user type variables are no more part of the
  263 + definition. */
  264 + )
  265 + {
  266 + /* definition found */
267 267  
268 268 /*
269 269 printf("operation already seen: %d '%s' (%s, line %d)\n",
... ... @@ -297,8 +297,8 @@ void new_op_scheme(Expr lc, /* &lt;lc&gt; */
297 297 operations[opid].definition = save(body);
298 298 }
299 299  
300   - break; /* the for (opid ...) loop */
301   - }
  300 + break; /* the for (opid ...) loop */
  301 + }
302 302 }
303 303  
304 304 n = length(args);
... ... @@ -315,11 +315,11 @@ void new_op_scheme(Expr lc, /* &lt;lc&gt; */
315 315 */
316 316  
317 317 if (next_operation == max_operation)
318   - {
319   - max_operation += 500;
320   - operations = (struct Operation_struct *)reallocz(operations,
321   - max_operation*sizeof(struct Operation_struct));
322   - }
  318 + {
  319 + max_operation += 500;
  320 + operations = (struct Operation_struct *)reallocz(operations,
  321 + max_operation*sizeof(struct Operation_struct));
  322 + }
323 323  
324 324 if (gindex)
325 325 {
... ... @@ -373,7 +373,6 @@ void new_op_scheme(Expr lc, /* &lt;lc&gt; */
373 373 print_expr_to_C(predef_aux,args);
374 374 fprintf(predef_aux,",\n");
375 375  
376   - //print_expr_to_C(predef_aux,body);
377 376 print_expr_to_C(predef_aux,no_term);
378 377  
379 378 if (operations[opid].checked == checked_correct && operations[opid].definition != no_term)
... ... @@ -381,7 +380,25 @@ void new_op_scheme(Expr lc, /* &lt;lc&gt; */
381 380  
382 381 fprintf(predef_aux,");\n");
383 382 }
384   - //printf("Leaving new_op_scheme\n"); fflush(stdout);
  383 +
  384 + if (predef_npd_aux != NULL)
  385 + {
  386 + //fprintf(predef_npd_aux,"\nprintf(\">>>>> 'predef_npd.aux' line %%d\\n\",__LINE__); fflush(stdout);\n");
  387 +
  388 + fprintf(predef_npd_aux,"\nnew_op_scheme(%d,%d,\n",lc,global);
  389 + print_expr_to_C(predef_npd_aux,ttype);
  390 + fprintf(predef_npd_aux,",\n");
  391 + print_expr_to_C(predef_npd_aux,names);
  392 + fprintf(predef_npd_aux,",\n");
  393 + print_expr_to_C(predef_npd_aux,args);
  394 + fprintf(predef_npd_aux,",\n");
  395 +
  396 + print_expr_to_C(predef_npd_aux,body);
  397 +
  398 + fprintf(predef_npd_aux,");\n");
  399 + }
  400 +
  401 + //printf("Leaving new_op_scheme\n"); fflush(stdout);
385 402  
386 403 }
387 404  
... ... @@ -439,34 +456,34 @@ void check_operation(int opid)
439 456  
440 457  
441 458 if (errors)
442   - {
443   - /* this happens if a term had no interpretation */
  459 + {
  460 + /* this happens if a term had no interpretation */
444 461 operations[opid].checked = checked_incorrect;
445   - return;
446   - }
  462 + return;
  463 + }
447 464  
448 465 /* keep only those interpretations whose type unify to the declared
449   - type */
  466 + type */
450 467 aux = interps;
451 468 interps = nil;
452 469 while (consp(aux))
453   - {
454   - body_int = car(car(aux));
455   - body_env = cdr(car(aux));
456   - aux = cdr(aux);
457   -
458   - pttype = ttype;
459   -
460   - env = unify(type_from_interpretation(body_int,body_env),
461   - body_env,
462   - pttype,
463   - nil);
464   -
465   - if (env != not_unifiable)
466   - {
467   - interps = cons(cons(body_int,env),interps);
468   - }
469   - }
  470 + {
  471 + body_int = car(car(aux));
  472 + body_env = cdr(car(aux));
  473 + aux = cdr(aux);
  474 +
  475 + pttype = ttype;
  476 +
  477 + env = unify(type_from_interpretation(body_int,body_env),
  478 + body_env,
  479 + pttype,
  480 + nil);
  481 +
  482 + if (env != not_unifiable)
  483 + {
  484 + interps = cons(cons(body_int,env),interps);
  485 + }
  486 + }
470 487 }
471 488  
472 489  
... ... @@ -478,13 +495,13 @@ void check_operation(int opid)
478 495 {
479 496 err_line_col(lc);
480 497 fprintf(errfile,
481   - msgtext_definition_body_not_type_compatible[language]);
  498 + msgtext_definition_body_not_type_compatible[language]);
482 499 fprintf(errfile,
483   - msgtext_given_type[language]);
  500 + msgtext_given_type[language]);
484 501 show_type(errfile,ttype,nil);
485 502 fprintf(errfile,"\n");
486 503 fprintf(errfile,
487   - msgtext_body_interpretations_types[language]);
  504 + msgtext_body_interpretations_types[language]);
488 505 show_interpretations_types(errfile,body_ints);
489 506 fprintf(errfile,"\n");
490 507  
... ... @@ -500,7 +517,7 @@ void check_operation(int opid)
500 517 err_line_col(lc);
501 518 fprintf(errfile,
502 519 msgtext_ambiguous_definition_body[language],
503   - n);
  520 + n);
504 521 show_simple_ambiguity(errfile,interps);
505 522 fprintf(errfile,"\n");
506 523 operations[opid].checked = checked_incorrect;
... ... @@ -510,24 +527,24 @@ void check_operation(int opid)
510 527 {
511 528 /* we have one interpretation, and we must check for unknowns */
512 529 if (has_unknowns(car(car(interps)),
513   - cdr(car(interps))))
514   - {
515   - err_line_col(lc);
516   - fprintf(errfile,
517   - msgtext_definition_body_has_unknowns[language]);
518   -
519   - show_parametric_ambiguity(errfile,car(car(interps)),cdr(car(interps)));
520   - fprintf(errfile,"\n");
  530 + cdr(car(interps))))
  531 + {
  532 + err_line_col(lc);
  533 + fprintf(errfile,
  534 + msgtext_definition_body_has_unknowns[language]);
  535 +
  536 + show_parametric_ambiguity(errfile,car(car(interps)),cdr(car(interps)));
  537 + fprintf(errfile,"\n");
521 538 operations[opid].checked = checked_incorrect;
522 539 return;
523   - }
  540 + }
524 541  
525 542 else
526   - {
  543 + {
527 544 /* definition is accepted */
528 545  
529 546  
530   - operations[opid].definition = save(substitute(car(car(interps)),cdr(car(interps))));
  547 + operations[opid].definition = save(substitute(car(car(interps)),cdr(car(interps))));
531 548  
532 549 //check_head(operations[opid].definition);
533 550  
... ... @@ -536,7 +553,7 @@ void check_operation(int opid)
536 553 //debug(operations[opid].definition);
537 554 operations[opid].checked = checked_correct;
538 555 return;
539   - }
  556 + }
540 557 }
541 558 operations[opid].checked = checked_incorrect;
542 559 }
... ...
anubis_dev/compiler/src/output.c
  Show/Hide comments   View file @e69a754
... ... @@ -109,8 +109,8 @@ char *backslash_spaces(char *name)
109 109  
110 110  
111 111 static U8 *translate_dynamic_code(Expr code,
112   - Expr start_label,
113   - U8 *sha1_ident,
  112 + Expr start_label,
  113 + U8 *sha1_ident,
114 114 Expr initialization_address_value,
115 115 Expr variables_deletion_address_value)
116 116 {
... ... @@ -444,8 +444,8 @@ static void dump_dynamic_compiled_op(int iid) /* compiled op id */
444 444  
445 445 /* translate offline symbolic code */
446 446 translation = translate_dynamic_code(sym_code,
447   - start_label,
448   - compiled_ops[iid].sha1_digest,
  447 + start_label,
  448 + compiled_ops[iid].sha1_digest,
449 449 initialization_address_value,
450 450 variables_deletion_address_value);
451 451  
... ... @@ -495,8 +495,8 @@ static void dump_dynamic_compiled_op(int iid) /* compiled op id */
495 495 snprintf(buf,995,"%s.sc",opname);
496 496 symfile = fopenz(buf,"wt");
497 497 fprintf(symfile,
498   - "\n This file was generated by the Anubis compiler (version 1.%d)\n\n",
499   - min_version);
  498 + "\n This file was generated by the Anubis compiler (version 1.%d)\n\n",
  499 + min_version);
500 500 fprintf(symfile,
501 501 " Symbolic code for module '%s.%s'\n\n",opname,module_ext);
502 502 fprintf(symfile,
... ... @@ -506,7 +506,7 @@ static void dump_dynamic_compiled_op(int iid) /* compiled op id */
506 506 " size of code: %lu bytes\n"
507 507 " starting point at offset: %lu (executing '%s' from file '%s' at line %u)\n",
508 508 *((U32 *)(translation+4)),
509   - (ta->tm_year)+1900,
  509 + (ta->tm_year)+1900,
510 510 (ta->tm_mon)+1,
511 511 ta->tm_mday,
512 512 ta->tm_hour,
... ... @@ -516,12 +516,12 @@ static void dump_dynamic_compiled_op(int iid) /* compiled op id */
516 516 ((*((U32 *)(translation+4+4))) & mf_using_graphism) ? "yes" : "no",
517 517 *((U32 *)(translation+4+4+4)),
518 518 *((U32 *)(translation+4+4+4+4)),
519   - opname,
  519 + opname,
520 520 string_content(operations[compiled_ops[iid].op_id].file_name),
521   - integer_value(operations[compiled_ops[iid].op_id].line));
  521 + integer_value(operations[compiled_ops[iid].op_id].line));
522 522 fprintf(symfile,
523 523 " module checksum: %s\n\n",
524   - sha1_to_ascii(checksum));
  524 + sha1_to_ascii(checksum));
525 525 fprintf(symfile,
526 526 " offsets | symbolic code");
527 527 offa = 0;
... ... @@ -536,7 +536,7 @@ static void dump_dynamic_compiled_op(int iid) /* compiled op id */
536 536 char finalString[2048];
537 537 snprintf(buf,995,"%s/%s", my_shells_directory, opname);
538 538 #ifdef WIN32
539   - strcat(buf,".bat");
  539 + strcat(buf,".bat");
540 540 #endif
541 541 shell_file = fopenz(buf,"wt");
542 542 #ifdef WIN32
... ... @@ -586,7 +586,7 @@ static void dump_dynamic_compiled_op(int iid) /* compiled op id */
586 586 "\n| using graphism: %s"
587 587 "\n| size of code: %lu"
588 588 "\n| starting point: %lu",
589   - buf,
  589 + buf,
590 590 get_maj_version(*((U32 *)translation)),
591 591 get_min_version(*((U32 *)translation)),
592 592 get_rel_version(*((U32 *)translation)),
... ... @@ -597,7 +597,7 @@ static void dump_dynamic_compiled_op(int iid) /* compiled op id */
597 597 *((U32 *)(translation+4+4+4+4)));
598 598 printf("\n| checksum: %s"
599 599 "\n|__________________\n",
600   - sha1_to_ascii(checksum));
  600 + sha1_to_ascii(checksum));
601 601 fflush(stdout);
602 602 }
603 603 freez(buf);
... ... @@ -737,11 +737,11 @@ void dump_dynamic_modules(void)
737 737 /* mark all types ops and variables as not used */
738 738 if (dump_used) mark_all_as_not_used();
739 739  
740   - /* get the id of the compiled operation */
741   - iid = get_op_instance_id(
  740 + /* get the id of the compiled operation */
  741 + iid = get_op_instance_id(
742 742 new_integer(((get_file_id(string_content(operations[i].file_name)))<<23) |
743 743 (integer_value(operations[i].line)<<8)),
744   - i,nil,nil);
  744 + i,nil,nil);
745 745  
746 746 /* dump a list of things used by this module */
747 747 if (dump_used) do_dump_used(string_content(car(operations[i].names)));
... ... @@ -750,9 +750,9 @@ void dump_dynamic_modules(void)
750 750  
751 751 //debug(compiled_ops[iid].offline_code);
752 752  
753   - /* dump the module */
  753 + /* dump the module */
754 754 if ((compiled_ops[iid].global == op_adm))
755   - dump_dynamic_compiled_op(iid);
  755 + dump_dynamic_compiled_op(iid);
756 756  
757 757 /* clean_up */
758 758 clean_up_pairs();
... ...
anubis_dev/compiler/src/predef.c
  Show/Hide comments   View file @e69a754
... ... @@ -2,7 +2,7 @@
2 2  
3 3 Anubis
4 4 Predefined types and operations.
5   -
  5 +
6 6 ********************************************************************/
7 7  
8 8 #include <stdlib.h>
... ... @@ -62,9 +62,9 @@ void do_predefinitions1(void)
62 62 -- false.
63 63 */
64 64 new_type(pdstr_Bool,
65   - nil,
66   - list2(cons(list1(pdstr_false),nil),
67   - cons(list1(pdstr_true),nil)),
  65 + nil,
  66 + list2(cons(list1(pdstr_false),nil),
  67 + cons(list1(pdstr_true),nil)),
68 68 1);
69 69  
70 70 /*
... ... @@ -74,11 +74,11 @@ void do_predefinitions1(void)
74 74 */
75 75 eq_scheme_op_id = next_operation;
76 76 new_op_scheme(new_integer(0),
77   - op_public,
78   - pdstr_Bool,
79   - list1(pdstr_eq),
80   - list2(cons(new_utvar("T"),new_string("x")),cons(new_utvar("T"),new_string("y"))),
81   - no_term);
  77 + op_public,
  78 + pdstr_Bool,
  79 + list1(pdstr_eq),
  80 + list2(cons(new_utvar("T"),new_string("x")),cons(new_utvar("T"),new_string("y"))),
  81 + no_term);
82 82  
83 83 operations[eq_scheme_op_id].checked = checked_correct;
84 84 //operations[eq_scheme_op_id].crypted = 0;
... ... @@ -92,13 +92,13 @@ void do_predefinitions1(void)
92 92 compiled_ops[string_eq_op_id].addr = new_addr_name(labs_compiled_op,string_eq_op_id);
93 93 compiled_ops[string_eq_op_id].offline_code = list6(odd_align,
94 94 cons(label,compiled_ops[string_eq_op_id].addr),
95   - eq_string,
96   - cons(del_stack_ptr,new_integer(0)),
97   - cons(del_stack_ptr,new_integer(0)),
98   - cons(ret,new_integer(2)));
  95 + eq_string,
  96 + cons(del_stack_ptr,new_integer(0)),
  97 + cons(del_stack_ptr,new_integer(0)),
  98 + cons(ret,new_integer(2)));
99 99 compiled_ops[string_eq_op_id].inline_code = list3(eq_string,
100   - cons(del_stack_ptr,new_integer(0)),
101   - cons(del_stack_ptr,new_integer(0)));
  100 + cons(del_stack_ptr,new_integer(0)),
  101 + cons(del_stack_ptr,new_integer(0)));
102 102 compiled_ops[string_eq_op_id].global = operations[eq_scheme_op_id].global;
103 103  
104 104  
... ... @@ -112,13 +112,13 @@ void do_predefinitions1(void)
112 112 compiled_ops[byte_array_eq_op_id].addr = new_addr_name(labs_compiled_op,byte_array_eq_op_id);
113 113 compiled_ops[byte_array_eq_op_id].offline_code = list6(odd_align,
114 114 cons(label,compiled_ops[byte_array_eq_op_id].addr),
115   - eq_byte_array,
116   - cons(del_stack_ptr,new_integer(0)),
117   - cons(del_stack_ptr,new_integer(0)),
118   - cons(ret,new_integer(2)));
  115 + eq_byte_array,
  116 + cons(del_stack_ptr,new_integer(0)),
  117 + cons(del_stack_ptr,new_integer(0)),
  118 + cons(ret,new_integer(2)));
119 119 compiled_ops[byte_array_eq_op_id].inline_code = list3(eq_byte_array,
120   - cons(del_stack_ptr,new_integer(0)),
121   - cons(del_stack_ptr,new_integer(0)));
  120 + cons(del_stack_ptr,new_integer(0)),
  121 + cons(del_stack_ptr,new_integer(0)));
122 122 compiled_ops[byte_array_eq_op_id].global = operations[eq_scheme_op_id].global;
123 123  
124 124  
... ... @@ -131,13 +131,13 @@ void do_predefinitions1(void)
131 131 compiled_ops[small_eq_op_id].addr = new_addr_name(labs_compiled_op,small_eq_op_id);
132 132 compiled_ops[small_eq_op_id].offline_code = list6(odd_align,
133 133 cons(label,compiled_ops[small_eq_op_id].addr),
134   - cons(eq,new_integer(0)),
135   - cons(collapse,new_integer(0)),
136   - cons(collapse,new_integer(0)),
137   - cons(ret,new_integer(2)));
  134 + cons(eq,new_integer(0)),
  135 + cons(collapse,new_integer(0)),
  136 + cons(collapse,new_integer(0)),
  137 + cons(ret,new_integer(2)));
138 138 compiled_ops[small_eq_op_id].inline_code = list3(cons(eq,new_integer(0)),
139   - cons(collapse,new_integer(0)),
140   - cons(collapse,new_integer(0)));
  139 + cons(collapse,new_integer(0)),
  140 + cons(collapse,new_integer(0)));
141 141 compiled_ops[small_eq_op_id].global = operations[eq_scheme_op_id].global;
142 142  
143 143  
... ... @@ -150,13 +150,13 @@ void do_predefinitions1(void)
150 150 compiled_ops[float_eq_op_id].addr = new_addr_name(labs_compiled_op,float_eq_op_id);
151 151 compiled_ops[float_eq_op_id].offline_code = list6(odd_align,
152 152 cons(label,compiled_ops[float_eq_op_id].addr),
153   - cons(load_int32,new_integer(0)),
154   - cons(collapse,new_integer(0)),
155   - cons(collapse,new_integer(0)),
156   - cons(ret,new_integer(2)));
  153 + cons(load_int32,new_integer(0)),
  154 + cons(collapse,new_integer(0)),
  155 + cons(collapse,new_integer(0)),
  156 + cons(ret,new_integer(2)));
157 157 compiled_ops[float_eq_op_id].inline_code = list3(cons(load_int32,new_integer(0)),
158   - cons(collapse,new_integer(0)),
159   - cons(collapse,new_integer(0)));
  158 + cons(collapse,new_integer(0)),
  159 + cons(collapse,new_integer(0)));
160 160 compiled_ops[float_eq_op_id].global = operations[eq_scheme_op_id].global;
161 161  
162 162  
... ... @@ -167,7 +167,11 @@ void do_predefinitions1(void)
167 167 void do_predefinitions2(void)
168 168 {
169 169 /* include the following file produced by: 'anubis -predef' */
  170 +#ifdef _no_predef_dat_
  171 +#include "predef_npd.aux"
  172 +#else
170 173 #include "predef.aux"
  174 +#endif
171 175  
172 176 }
173 177  
... ...
anubis_dev/compiler/src/rectype.c
  Show/Hide comments   View file @e69a754
... ... @@ -77,8 +77,8 @@ static Expr collect_type_ids(Expr file_name, Expr type)
77 77 if (is_string(type))
78 78 {
79 79 for (i = 0; i < next_type; i++)
80   - if (types[i].name == type)
81   - return list1(new_integer(i));
  80 + if (types[i].name == type)
  81 + return list1(new_integer(i));
82 82 check_explicit_type(0,type,nil);
83 83 return nil;
84 84 }
... ... @@ -90,32 +90,32 @@ static Expr collect_type_ids(Expr file_name, Expr type)
90 90 {
91 91  
92 92 if(car(type) == app_ts)
93   - {
94   - /* type = (app_ts <name> <type> ... <type>) */
95   - result = collect_type_ids(file_name,second(type));
96   - type = cdr(cdr(type));
97   - while (consp(type))
98   - {
99   - result = append(collect_type_ids(file_name,car(type)),result);
100   - type = cdr(type);
101   - }
102   - }
  93 + {
  94 + /* type = (app_ts <name> <type> ... <type>) */
  95 + result = collect_type_ids(file_name,second(type));
  96 + type = cdr(cdr(type));
  97 + while (consp(type))
  98 + {
  99 + result = append(collect_type_ids(file_name,car(type)),result);
  100 + type = cdr(type);
  101 + }
  102 + }
103 103 else if (car(type) == functype)
104   - {
105   - /* type = (functype <types> . <type>) */
106   - result = collect_type_ids(file_name,cdr2(type));
107   - type = second(type);
108   - while (consp(type))
109   - {
110   - result = append(collect_type_ids(file_name,car(type)),result);
111   - type = cdr(type);
112   - }
113   - }
  104 + {
  105 + /* type = (functype <types> . <type>) */
  106 + result = collect_type_ids(file_name,cdr2(type));
  107 + type = second(type);
  108 + while (consp(type))
  109 + {
  110 + result = append(collect_type_ids(file_name,car(type)),result);
  111 + type = cdr(type);
  112 + }
  113 + }
114 114 else if (car(type) == power_type)
115   - {
116   - /* (power_type . <type>) */
117   - result = collect_type_ids(file_name,cdr(type));
118   - }
  115 + {
  116 + /* (power_type . <type>) */
  117 + result = collect_type_ids(file_name,cdr(type));
  118 + }
119 119 else if (car(type) == type_struct_ptr)
120 120 {
121 121 /* cannot contain a type variable */
... ... @@ -162,11 +162,11 @@ static Expr get_direct_type_refs(Expr file_name, Expr tdef)
162 162  
163 163 alt = cdr(alt); /* ((<type> . <var>) ... ) */
164 164 while(consp(alt))
165   - {
166   - /* collect type names from <type>, and add them to list */
167   - result = merge_lists(collect_type_ids(file_name,car(car(alt))),result);
168   - alt = cdr(alt);
169   - }
  165 + {
  166 + /* collect type names from <type>, and add them to list */
  167 + result = merge_lists(collect_type_ids(file_name,car(car(alt))),result);
  168 + alt = cdr(alt);
  169 + }
170 170 }
171 171 return result;
172 172 }
... ... @@ -181,10 +181,10 @@ static void mark_types_reachable_from(int id)
181 181 while(consp(list))
182 182 {
183 183 if (!(types[integer_value(car(list))].mark))
184   - {
185   - types[integer_value(car(list))].mark = 1;
186   - mark_types_reachable_from(integer_value(car(list)));
187   - }
  184 + {
  185 + types[integer_value(car(list))].mark = 1;
  186 + mark_types_reachable_from(integer_value(car(list)));
  187 + }
188 188 list = cdr(list);
189 189 }
190 190 }
... ... @@ -240,35 +240,35 @@ void find_infinite_types(void)
240 240 {
241 241 something_changed = 0;
242 242 for (i = 0; i < next_type; i++)
243   - {
244   - Expr refs = types[i].typerefs;
245   -
246   - if (types[i].infinite)
247   - continue;
248   -
249   - while (consp(refs))
250   - {
251   - if (is_infinite(car(refs)))
252   - {
253   - types[i].infinite = 1;
254   - something_changed = 1;
255   - }
256   - refs = cdr(refs);
257   - }
258   - }
  243 + {
  244 + Expr refs = types[i].typerefs;
  245 +
  246 + if (types[i].infinite)
  247 + continue;
  248 +
  249 + while (consp(refs))
  250 + {
  251 + if (is_infinite(car(refs)))
  252 + {
  253 + types[i].infinite = 1;
  254 + something_changed = 1;
  255 + }
  256 + refs = cdr(refs);
  257 + }
  258 + }
259 259 } while (something_changed);
260 260  
261 261 if (verbose)
262 262 for (i = 0; i < next_type; i++)
263 263 {
264   - if (types[i].line != 0)
265   - printf(" %s (%s)\n",
266   - string_content(types[i].name),
267   - types[i].infinite
268   - ?
269   - msgtext_recursive[language]
270   - :
271   - msgtext_non_recursive[language]);
  264 + if (types[i].line != 0)
  265 + printf(" %s (%s)\n",
  266 + string_content(types[i].name),
  267 + types[i].infinite
  268 + ?
  269 + msgtext_recursive[language]
  270 + :
  271 + msgtext_non_recursive[language]);
272 272 }
273 273 }
274 274  
... ...
anubis_dev/compiler/src/rwcode.c
  Show/Hide comments   View file @e69a754
... ... @@ -47,7 +47,7 @@ Expr read_code(Expr type, Expr env, Expr ctxt)
47 47  
48 48 return mcons3(mcons3(context,ctxt,env),
49 49 cons(comment,new_string("read code")),
50   - result);
  50 + result);
51 51 }
52 52  
53 53  
... ...
anubis_dev/compiler/src/show.c
  Show/Hide comments   View file @e69a754
... ... @@ -65,17 +65,17 @@ void show_clause(FILE *fp, Expr clause, Expr env)
65 65 xpos += fprintf(fp,"%s",string_content(car(head)));
66 66 head = cdr(head); /* ((<var> . <type>) ... ) */
67 67 if (consp(head))
68   - {
69   - xpos += fprintf(fp,"(");
70   - while (consp(head))
71   - {
72   - assert(is_string(car(car(head))));
73   - xpos += fprintf(fp,string_content(car(car(head))));
74   - head = cdr(head);
75   - if (consp(head)) xpos += fprintf(fp,",");
76   - }
77   - xpos += fprintf(fp,")");
78   - }
  68 + {
  69 + xpos += fprintf(fp,"(");
  70 + while (consp(head))
  71 + {
  72 + assert(is_string(car(car(head))));
  73 + xpos += fprintf(fp,string_content(car(car(head))));
  74 + head = cdr(head);
  75 + if (consp(head)) xpos += fprintf(fp,",");
  76 + }
  77 + xpos += fprintf(fp,")");
  78 + }
79 79 /* 'then' keyword (not to be printed for 'else' case) */
80 80 xpos += fprintf (fp," then ");
81 81 }
... ... @@ -126,64 +126,64 @@ int _show_type(char *filename, int line, FILE *fp, Expr type, Expr env)
126 126 /* $n */
127 127 Expr value = assoc(type,env);
128 128 if (value == key_not_found)
129   - {
130   - xpos += fprintf(fp,"$%d",itvar2index(type));
131   - }
  129 + {
  130 + xpos += fprintf(fp,"$%d",itvar2index(type));
  131 + }
132 132 else
133   - {
134   - type = value;
135   - goto begin;
136   - }
  133 + {
  134 + type = value;
  135 + goto begin;
  136 + }
137 137 }
138 138 else if (consp(type))
139 139 {
140 140 switch (car(type))
141   - {
142   - case app_ts:
143   - {
144   - /* (app_ts <type name> <type> ... <type>) */
145   - if (cdr2(type) == nil)
146   - {
147   - /* don't print 'Name()' but 'Name'*/
148   - xpos += fprintf(fp,string_content(second(type)));
149   - }
  141 + {
  142 + case app_ts:
  143 + {
  144 + /* (app_ts <type name> <type> ... <type>) */
  145 + if (cdr2(type) == nil)
  146 + {
  147 + /* don't print 'Name()' but 'Name'*/
  148 + xpos += fprintf(fp,string_content(second(type)));
  149 + }
150 150 else
151   - {
152   - type = cdr(type);
153   - if (strncmp(string_content(car(type)),"£Tuple",6))
154   - xpos += fprintf(fp,string_content(car(type)));
155   - type = cdr(type);
156   - xpos += fprintf(fp,"(");
157   - while(consp(type))
158   - {
159   - show_type(fp,car(type),env);
160   - type = cdr(type);
161   - if (consp(type)) xpos += fprintf(fp,",");
162   - }
163   - xpos += fprintf(fp,")");
164   - }
165   - }
166   - break;
167   -
168   - case functype:
169   - /* (functype <types> . <type>) */
170   - {
171   - xpos += fprintf(fp,"(");
172   - show_types(fp,second(type),env);
173   - xpos += fprintf(fp," %s ",string_content(pdstr_arrow));
174   - show_type(fp,cdr(cdr(type)),env);
175   - xpos += fprintf(fp,")");
176   - }
177   - break;
178   -
179   - case power_type:
180   - /* (power_type . <type>) */
181   - {
182   - xpos += fprintf(fp,"{");
183   - show_type(fp,cdr(type),env);
184   - xpos += fprintf(fp,"}");
185   - }
186   - break;
  151 + {
  152 + type = cdr(type);
  153 + if (strncmp(string_content(car(type)),"£Tuple",6))
  154 + xpos += fprintf(fp,string_content(car(type)));
  155 + type = cdr(type);
  156 + xpos += fprintf(fp,"(");
  157 + while(consp(type))
  158 + {
  159 + show_type(fp,car(type),env);
  160 + type = cdr(type);
  161 + if (consp(type)) xpos += fprintf(fp,",");
  162 + }
  163 + xpos += fprintf(fp,")");
  164 + }
  165 + }
  166 + break;
  167 +
  168 + case functype:
  169 + /* (functype <types> . <type>) */
  170 + {
  171 + xpos += fprintf(fp,"(");
  172 + show_types(fp,second(type),env);
  173 + xpos += fprintf(fp," %s ",string_content(pdstr_arrow));
  174 + show_type(fp,cdr(cdr(type)),env);
  175 + xpos += fprintf(fp,")");
  176 + }
  177 + break;
  178 +
  179 + case power_type:
  180 + /* (power_type . <type>) */
  181 + {
  182 + xpos += fprintf(fp,"{");
  183 + show_type(fp,cdr(type),env);
  184 + xpos += fprintf(fp,"}");
  185 + }
  186 + break;
187 187  
188 188 case type_struct_ptr:
189 189 /* (type_struct_ptr . <struct id>) */
... ... @@ -194,11 +194,11 @@ int _show_type(char *filename, int line, FILE *fp, Expr type, Expr env)
194 194 }
195 195 break;
196 196  
197   - default:
  197 + default:
198 198 fprintf(errfile,"%s:%d: ",filename,line);
199   - internal_error("Unknow type form",type);
  199 + internal_error("Unknow type form",type);
200 200 break;
201   - }
  201 + }
202 202 }
203 203 else
204 204 {
... ... @@ -237,17 +237,17 @@ void show_typed_resurgent_symbols(FILE *fp,
237 237 if (consp(alt))
238 238 {
239 239 while (consp(alt))
240   - {
241   - assert(consp(car(alt)));
242   - show_type(fp,car(car(alt)),env);
243   - if (cdr(car(alt)) != noname)
  240 + {
  241 + assert(consp(car(alt)));
  242 + show_type(fp,car(car(alt)),env);
  243 + if (cdr(car(alt)) != noname)
244 244 xpos += fprintf(fp," %s",string_content(cdr(car(alt))));
245 245 else
246 246 xpos += fprintf(fp," _%d",n);
247   - alt = cdr(alt);
  247 + alt = cdr(alt);
248 248 n++;
249   - if (consp(alt)) xpos += fprintf(fp,",");
250   - }
  249 + if (consp(alt)) xpos += fprintf(fp,",");
  250 + }
251 251 }
252 252 newline(fp);
253 253 }
... ... @@ -265,17 +265,17 @@ void show_alt(FILE *fp, int i, Expr alt, Expr env)
265 265 {
266 266 xpos += fprintf(fp,"(");
267 267 while (consp(alt))
268   - {
269   - assert(consp(car(alt)));
270   - show_type(fp,car(car(alt)),env);
271   - if (cdr(car(alt)) != noname)
  268 + {
  269 + assert(consp(car(alt)));
  270 + show_type(fp,car(car(alt)),env);
  271 + if (cdr(car(alt)) != noname)
272 272 xpos += fprintf(fp," %s",string_content(cdr(car(alt))));
273 273 else
274 274 xpos += fprintf(fp," _%d",n);
275   - alt = cdr(alt);
  275 + alt = cdr(alt);
276 276 n++;
277   - if (consp(alt)) xpos += fprintf(fp,",");
278   - }
  277 + if (consp(alt)) xpos += fprintf(fp,",");
  278 + }
279 279 xpos += fprintf(fp,")");
280 280 }
281 281 xpos += fprintf(fp," then ");
... ... @@ -305,13 +305,13 @@ void show_alternative(FILE *fp, Expr i_alt)
305 305 fprintf(fp,"(");
306 306 i_alt = cdr(i_alt);
307 307 while (consp(i_alt))
308   - {
309   - show_type(fp,car(car(i_alt)),nil);
310   - if (cdr(car(i_alt)) != noname)
311   - fprintf(fp," %s",string_content(cdr(car(i_alt))));
312   - i_alt = cdr(i_alt);
313   - if (i_alt != nil) fprintf(fp,",");
314   - }
  308 + {
  309 + show_type(fp,car(car(i_alt)),nil);
  310 + if (cdr(car(i_alt)) != noname)
  311 + fprintf(fp," %s",string_content(cdr(car(i_alt))));
  312 + i_alt = cdr(i_alt);
  313 + if (i_alt != nil) fprintf(fp,",");
  314 + }
315 315 fprintf(fp,")");
316 316 }
317 317 fprintf(fp,"\n");
... ... @@ -339,8 +339,8 @@ void show_interpretation_type(FILE *fp, Expr head, Expr env)
339 339  
340 340 /* displaying an interpretation */
341 341 void show_interpretation(FILE *fp,
342   - Expr head,
343   - Expr env)
  342 + Expr head,
  343 + Expr env)
344 344 {
345 345 assert(consp(head));
346 346  
... ... @@ -348,112 +348,112 @@ void show_interpretation(FILE *fp,
348 348 {
349 349 case local:
350 350 {
351   - /* (local x i . type) ==> [local i](type)x */
352   - if (show_brackets)
353   - xpos += fprintf(fp,"[local %d]",integer_value(third(head)));
354   - xpos += fprintf(fp,"(");
355   - show_type(fp,cdr3(head),env);
356   - xpos += fprintf(fp,")%s",string_content(second(head)));
  351 + /* (local x i . type) ==> [local i](type)x */
  352 + if (show_brackets)
  353 + xpos += fprintf(fp,"[local %d]",integer_value(third(head)));
  354 + xpos += fprintf(fp,"(");
  355 + show_type(fp,cdr3(head),env);
  356 + xpos += fprintf(fp,")%s",string_content(second(head)));
357 357 }
358 358 break;
359 359  
360 360 case operation: /* (operation <lc> <opid> <name> <parms> <type> . <types>) */
361 361 if (cdr6(head) == nil)
362   - {
363   - xpos += fprintf(fp,"(");
364   - show_type(fp,sixth(head),env);
365   - xpos += fprintf(fp,")%s",string_content(forth(head)));
366   - }
  362 + {
  363 + xpos += fprintf(fp,"(");
  364 + show_type(fp,sixth(head),env);
  365 + xpos += fprintf(fp,")%s",string_content(forth(head)));
  366 + }
367 367 else
368   - {
369   - xpos += fprintf(fp,"(");
370   - show_types(fp,cdr6(head),env);
371   - xpos += fprintf(fp," -> ");
372   - show_type(fp,sixth(head),env);
373   - xpos += fprintf(fp,")%s",string_content(forth(head)));
374   - }
  368 + {
  369 + xpos += fprintf(fp,"(");
  370 + show_types(fp,cdr6(head),env);
  371 + xpos += fprintf(fp," -> ");
  372 + show_type(fp,sixth(head),env);
  373 + xpos += fprintf(fp,")%s",string_content(forth(head)));
  374 + }
375 375 break;
376 376  
377 377 case app: /* (app <lc> <op int head> . <int heads>) */
378 378 {
379   - int old_margin = margin;
380   - margin += 2;
381   -
382   - /* special case [.] */
383   - if (consp(third(head)) && car(third(head)) == operation &&
384   - forth(third(head)) == pdstr_cons)
385   - {
386   - /* third(head) = (operation <lc> <opid> <name> <parms> <type> . <types>) */
387   - xpos += fprintf(fp,"(");
388   - show_type(fp,sixth(third(head)),env);
389   - xpos += fprintf(fp,")[");
390   - show_interpretation(fp,forth(head),env);
391   - xpos += fprintf(fp," . ");
392   - show_interpretation(fp,fifth(head),env);
393   - xpos += fprintf(fp,"]");
394   - }
395   - else
396   - {
397   - show_interpretation(fp,third(head),env);
398   - head = cdr(cdr(cdr(head))); /* (<arg> ... <arg>) */
399   - if (consp(head))
400   - {
401   - xpos += fprintf(fp,"("); newline(fp);
402   - while(consp(head))
403   - {
404   - show_interpretation(fp,car(head),env);
405   - head = cdr(head);
406   - if (consp(head))
407   - xpos += fprintf(fp,",");
408   - else
409   - xpos += fprintf(fp,")");
410   - }
411   - }
412   - }
413   - margin = old_margin;
  379 + int old_margin = margin;
  380 + margin += 2;
  381 +
  382 + /* special case [.] */
  383 + if (consp(third(head)) && car(third(head)) == operation &&
  384 + forth(third(head)) == pdstr_cons)
  385 + {
  386 + /* third(head) = (operation <lc> <opid> <name> <parms> <type> . <types>) */
  387 + xpos += fprintf(fp,"(");
  388 + show_type(fp,sixth(third(head)),env);
  389 + xpos += fprintf(fp,")[");
  390 + show_interpretation(fp,forth(head),env);
  391 + xpos += fprintf(fp," . ");
  392 + show_interpretation(fp,fifth(head),env);
  393 + xpos += fprintf(fp,"]");
  394 + }
  395 + else
  396 + {
  397 + show_interpretation(fp,third(head),env);
  398 + head = cdr(cdr(cdr(head))); /* (<arg> ... <arg>) */
  399 + if (consp(head))
  400 + {
  401 + xpos += fprintf(fp,"("); newline(fp);
  402 + while(consp(head))
  403 + {
  404 + show_interpretation(fp,car(head),env);
  405 + head = cdr(head);
  406 + if (consp(head))
  407 + xpos += fprintf(fp,",");
  408 + else
  409 + xpos += fprintf(fp,")");
  410 + }
  411 + }
  412 + }
  413 + margin = old_margin;
414 414 }
415 415 break;
416 416  
417 417 case with:
418 418 {
419   - /* (with <lc> <symbol> <int head> . <int head>) */
420   - Expr old_margin = margin;
421   - head = cdr2(head);
422   - margin += 2;
423   - if (car(head) == with)
424   - xpos += fprintf(fp,"with %s = ",string_content(car(head)));
425   - else
426   - xpos += fprintf(fp,"with %s <- ",string_content(car(head)));
427   - show_interpretation(fp,second(head),env);
428   - xpos += fprintf(fp,",");
  419 + /* (with <lc> <symbol> <int head> . <int head>) */
  420 + Expr old_margin = margin;
  421 + head = cdr2(head);
  422 + margin += 2;
  423 + if (car(head) == with)
  424 + xpos += fprintf(fp,"with %s = ",string_content(car(head)));
  425 + else
  426 + xpos += fprintf(fp,"with %s <- ",string_content(car(head)));
  427 + show_interpretation(fp,second(head),env);
  428 + xpos += fprintf(fp,",");
429 429 newline(fp);
430   - show_interpretation(fp,cdr2(head),env);
431   - newline(fp);
432   - margin = old_margin;
  430 + show_interpretation(fp,cdr2(head),env);
  431 + newline(fp);
  432 + margin = old_margin;
433 433 }
434 434 break;
435 435  
436 436 case cond:
437 437 {
438   - /* (cond <lc> <test> <clause> ... <clause>) */
439   - head = cdr(cdr(head)); /* (<test> ... ) */
440   - xpos += fprintf(fp,"if ");
441   - show_interpretation(fp,car(head),env);
442   - head = cdr(head); /* (<clause> ...) */
443   - xpos += fprintf(fp," is");
444   - margin += 2; newline(fp);
445   - xpos += fprintf(fp,"{");
446   - margin += 2; newline(fp);
447   - while(consp(head))
448   - {
449   - show_clause(fp,car(head),env);
450   - head = cdr(head);
451   - if (consp(head)) { xpos += fprintf(fp,","); newline(fp); }
452   - }
453   - margin -=2;
454   - newline(fp);
455   - xpos += fprintf(fp,"}");
456   - margin -= 2;
  438 + /* (cond <lc> <test> <clause> ... <clause>) */
  439 + head = cdr(cdr(head)); /* (<test> ... ) */
  440 + xpos += fprintf(fp,"if ");
  441 + show_interpretation(fp,car(head),env);
  442 + head = cdr(head); /* (<clause> ...) */
  443 + xpos += fprintf(fp," is");
  444 + margin += 2; newline(fp);
  445 + xpos += fprintf(fp,"{");
  446 + margin += 2; newline(fp);
  447 + while(consp(head))
  448 + {
  449 + show_clause(fp,car(head),env);
  450 + head = cdr(head);
  451 + if (consp(head)) { xpos += fprintf(fp,","); newline(fp); }
  452 + }
  453 + margin -=2;
  454 + newline(fp);
  455 + xpos += fprintf(fp,"}");
  456 + margin -= 2;
457 457 }
458 458 break;
459 459  
... ... @@ -462,85 +462,85 @@ void show_interpretation(FILE *fp,
462 462 xpos += fprintf(fp,"(");
463 463 show_type(fp,third(head),env);
464 464 xpos += fprintf(fp,")(if ");
465   - show_interpretation(fp,cdr3(head),env);
466   - xpos += fprintf(fp," is { })");
  465 + show_interpretation(fp,cdr3(head),env);
  466 + xpos += fprintf(fp," is { })");
467 467 }
468 468 break;
469 469  
470 470 case select_cond_interp:
471 471 {
472   - /* (select_cond_interp <lc> <test head> <index> <clause head> <head then> . <head else>) */
473   - head = cdr2(head); /* (<test head> ...) */
474   - xpos += fprintf(fp,"if ");
475   - show_interpretation(fp,car(head),env);
476   - head = cdr2(head); /* ((<sym> (<resurg sym> . <type>) ...) <head> . <head>) */
  472 + /* (select_cond_interp <lc> <test head> <index> <clause head> <head then> . <head else>) */
  473 + head = cdr2(head); /* (<test head> ...) */
  474 + xpos += fprintf(fp,"if ");
  475 + show_interpretation(fp,car(head),env);
  476 + head = cdr2(head); /* ((<sym> (<resurg sym> . <type>) ...) <head> . <head>) */
477 477 xpos += fprintf(fp," is ");
478 478 show_clause(fp,mcons3(car(head),0,second(head)),env);
479   - newline(fp);
480   - xpos += fprintf(fp,"else ");
481   - show_interpretation(fp,cdr2(head),env);
482   - margin -= 2;
  479 + newline(fp);
  480 + xpos += fprintf(fp,"else ");
  481 + show_interpretation(fp,cdr2(head),env);
  482 + margin -= 2;
483 483 }
484 484 break;
485 485  
486 486 case constructor: /* (constructor type_id . alt_rank) */
487 487 {
488   - head = cdr(head);
489   - xpos += fprintf(fp,"[constructor %d %d]",integer_value(car(head)),integer_value(cdr(head)));
  488 + head = cdr(head);
  489 + xpos += fprintf(fp,"[constructor %d %d]",integer_value(car(head)),integer_value(cdr(head)));
490 490 }
491 491 break;
492 492  
493 493 case string: /* (string <lc> . <string>) */
494 494 {
495   - xpos += fprintf(fp,"\"%s\"",string_content(cdr(cdr(head))));
  495 + xpos += fprintf(fp,"\"%s\"",string_content(cdr(cdr(head))));
496 496 }
497 497 break;
498 498  
499 499 case integer: /* (integer <lc> . <Cint>) */
500 500 {
501   - xpos += fprintf(fp,"%d",cdr2(head));
  501 + xpos += fprintf(fp,"%d",cdr2(head));
502 502 }
503 503 break;
504 504  
505   - case int32: /* (int32 <lc> . <Cint>) */
  505 + case anb_int32: /* (int32 <lc> . <Cint>) */
506 506 {
507   - xpos += fprintf(fp,"(Int32)%d",cdr2(head));
  507 + xpos += fprintf(fp,"(Int32)%d",cdr2(head));
508 508 }
509 509 break;
510 510  
511 511 case small_datum: /* (small_datum <type> . <Cint>) */
512 512 {
513   - xpos += fprintf(fp,"(");
514   - show_type(fp,second(head),env);
515   - xpos += fprintf(fp,")%u",cdr2(head));
  513 + xpos += fprintf(fp,"(");
  514 + show_type(fp,second(head),env);
  515 + xpos += fprintf(fp,")%u",cdr2(head));
516 516 }
517 517 break;
518 518  
519 519 case fpnum: /* (fpnum <lc> <mantissa> . <exponent>), where mantissa and exponent
520 520 are actual Lisp like integers */
521 521 {
522   - xpos += fprintf(fp,"((Float)%d 10^%d)",integer_value(third(head)),
523   - integer_value(cdr3(head)));
  522 + xpos += fprintf(fp,"((Float)%d 10^%d)",integer_value(third(head)),
  523 + integer_value(cdr3(head)));
524 524 }
525 525 break;
526 526  
527 527 case wait_for: /* (wait_for <lc> <head> <milliseconds> . <head>) */
528 528 {
529   - xpos += fprintf(fp,"wait for ");
530   - show_interpretation(fp,third(head),env);
  529 + xpos += fprintf(fp,"wait for ");
  530 + show_interpretation(fp,third(head),env);
531 531 xpos += fprintf(fp,", check every ");
532 532 show_interpretation(fp,forth(head),env);
533 533 xpos += fprintf(fp," milliseconds then ");
534   - show_interpretation(fp,cdr4(head),env);
  534 + show_interpretation(fp,cdr4(head),env);
535 535 }
536 536 break;
537 537  
538 538 case delegate: /* (delegate <lc> <head> . <head>) */
539 539 {
540   - xpos += fprintf(fp,"delegate ");
541   - show_interpretation(fp,third(head),env);
542   - xpos += fprintf(fp,", ");
543   - show_interpretation(fp,cdr3(head),env);
  540 + xpos += fprintf(fp,"delegate ");
  541 + show_interpretation(fp,third(head),env);
  542 + xpos += fprintf(fp,", ");
  543 + show_interpretation(fp,cdr3(head),env);
544 544 }
545 545 break;
546 546  
... ... @@ -698,10 +698,10 @@ void show_tuple_interpretation(FILE *fp, Expr heads, Expr env)
698 698 show_interpretation(fp,car(heads),env);
699 699 heads = cdr(heads);
700 700 if (consp(heads))
701   - {
702   - margin += 2;
703   - newline(fp);
704   - }
  701 + {
  702 + margin += 2;
  703 + newline(fp);
  704 + }
705 705 }
706 706 }
707 707  
... ... @@ -739,11 +739,11 @@ void show_tuple_interpretation_types(FILE *fp, Expr heads, Expr env)
739 739 show_interpretation_type(fp,car(heads),env);
740 740 heads = cdr(heads);
741 741 if (consp(heads))
742   - {
743   - newline(fp);
744   - for (i = 0; i < margin; i++)
745   - xpos += fprintf(fp," ");
746   - }
  742 + {
  743 + newline(fp);
  744 + for (i = 0; i < margin; i++)
  745 + xpos += fprintf(fp," ");
  746 + }
747 747 }
748 748 }
749 749  
... ... @@ -788,10 +788,10 @@ void show_simple_tuple_ambiguity(FILE *fp, Expr tuple_ints)
788 788 {
789 789 my_int = cons(car3(tuple_ints),cdr(car(tuple_ints)));
790 790 if (!member(my_int,first))
791   - first = cons(my_int,first);
  791 + first = cons(my_int,first);
792 792 my_int = cons(cdr(car2(tuple_ints)),cdr(car(tuple_ints)));
793 793 if (!member(my_int,others))
794   - others = cons(my_int,others);
  794 + others = cons(my_int,others);
795 795 tuple_ints = cdr(tuple_ints);
796 796 }
797 797  
... ... @@ -864,80 +864,80 @@ void show_simple_ambiguity_1(FILE *fp, Expr interps)
864 864 case local:
865 865 case operation:
866 866 {
867   - /* the interpreted term is a local symbol. Show all its
868   - interpretations. */
869   - show_symbol_ambiguity(fp,interps);
  867 + /* the interpreted term is a local symbol. Show all its
  868 + interpretations. */
  869 + show_symbol_ambiguity(fp,interps);
870 870 }
871 871 break;
872 872  
873 873 case app:
874 874 {
875   - /* each interpretation head has the form:
876   - (app <lc> <op int head> . <int heads>) */
877   - Expr op_ints, aux;
878   -
879   - /* collect op ints without repetition */
880   - op_ints = nil;
881   - aux = interps;
882   - while(consp(aux))
883   - {
884   - first = car(aux);
885   - aux = cdr(aux);
886   -
887   - /* first = ((app <lc> <op int head> ...) . <env>) */
888   - my_int = cons(third(car(first)),cdr(first));
889   - if (!member(my_int,op_ints))
890   - op_ints = cons(my_int,op_ints);
891   - }
892   -
893   - /* if operation has several interpretations, continue with
894   - them. */
895   - if (length(op_ints) >= 2)
896   - {
897   - show_simple_ambiguity(fp,op_ints);
898   - }
899   - else
900   - {
901   - /* operation (or function) is not ambiguous, see
902   - arguments. */
903   -
904   - /* drop (app <lc> <op int head>) from each interpertation
905   - head */
906   - aux = interps;
907   - interps = nil;
908   - while (consp(aux))
909   - {
910   - interps =
911   - cons(cons(cdr3(car(car(aux))),cdr(car(aux))),interps);
912   - aux = cdr(aux);
913   - }
914   -
915   - /* now, interps is a list of things like this:
916   - ((<head> ... <head>) . <env>) */
917   - show_simple_tuple_ambiguity(fp,interps);
918   - }
  875 + /* each interpretation head has the form:
  876 + (app <lc> <op int head> . <int heads>) */
  877 + Expr op_ints, aux;
  878 +
  879 + /* collect op ints without repetition */
  880 + op_ints = nil;
  881 + aux = interps;
  882 + while(consp(aux))
  883 + {
  884 + first = car(aux);
  885 + aux = cdr(aux);
  886 +
  887 + /* first = ((app <lc> <op int head> ...) . <env>) */
  888 + my_int = cons(third(car(first)),cdr(first));
  889 + if (!member(my_int,op_ints))
  890 + op_ints = cons(my_int,op_ints);
  891 + }
  892 +
  893 + /* if operation has several interpretations, continue with
  894 + them. */
  895 + if (length(op_ints) >= 2)
  896 + {
  897 + show_simple_ambiguity(fp,op_ints);
  898 + }
  899 + else
  900 + {
  901 + /* operation (or function) is not ambiguous, see
  902 + arguments. */
  903 +
  904 + /* drop (app <lc> <op int head>) from each interpertation
  905 + head */
  906 + aux = interps;
  907 + interps = nil;
  908 + while (consp(aux))
  909 + {
  910 + interps =
  911 + cons(cons(cdr3(car(car(aux))),cdr(car(aux))),interps);
  912 + aux = cdr(aux);
  913 + }
  914 +
  915 + /* now, interps is a list of things like this:
  916 + ((<head> ... <head>) . <env>) */
  917 + show_simple_tuple_ambiguity(fp,interps);
  918 + }
919 919 }
920 920 break;
921 921  
922 922 case cond:
923 923 {
924   - /* cond is similar to app, except that we use test instead of operation, and
925   - clause bodies instead of arguments. Nevertheless, it is simpler, because test
926   - is not an operation, but a regular term. So, we just collect test-bodies
927   - interpretations, and use show_simple_tuple_ambiguity. */
928   -
929   - aux = interps;
930   - interps = nil;
931   - while (consp(aux))
932   - {
933   - /* car(aux) = ((cond <lc> <head> (<?> <?> . <head>) ...) . <env>) */
934   - interps = cons(cons(cons(third(car(car(aux))),
935   - mapcdrcdr(cdr3(car(car(aux))))),
936   - cdr(car(aux))),
937   - interps);
938   - aux = cdr(aux);
939   - }
940   - show_simple_tuple_ambiguity(fp,interps);
  924 + /* cond is similar to app, except that we use test instead of operation, and
  925 + clause bodies instead of arguments. Nevertheless, it is simpler, because test
  926 + is not an operation, but a regular term. So, we just collect test-bodies
  927 + interpretations, and use show_simple_tuple_ambiguity. */
  928 +
  929 + aux = interps;
  930 + interps = nil;
  931 + while (consp(aux))
  932 + {
  933 + /* car(aux) = ((cond <lc> <head> (<?> <?> . <head>) ...) . <env>) */
  934 + interps = cons(cons(cons(third(car(car(aux))),
  935 + mapcdrcdr(cdr3(car(car(aux))))),
  936 + cdr(car(aux))),
  937 + interps);
  938 + aux = cdr(aux);
  939 + }
  940 + show_simple_tuple_ambiguity(fp,interps);
941 941 }
942 942 break;
943 943  
... ...
anubis_dev/compiler/src/symcode.c
  Show/Hide comments   View file @e69a754
... ... @@ -192,7 +192,7 @@ void print_symbolic_code(FILE *fp, Expr code, U32 *offset_addr,
192 192 }
193 193 ctxt = cdr(ctxt);
194 194 d++;
195   - }
  195 + }
196 196 fprintf(fp,"\n | ;----------------------------------");
197 197 }
198 198 else
... ... @@ -225,18 +225,18 @@ void dump_symbolic_code(Expr init_addr_val)
225 225 new_integer(
226 226 ((get_file_id(string_content(operations[i].file_name)))<<23) |
227 227 ((integer_value(operations[i].line))<<8)),
228   - i,nil,nil);
229   - Expr addr = compiled_ops[op_i_id].addr;
230   - if (integer_value(operations[i].line) == 0)
231   - fprintf(symcode_txt,"Code for operation '%s' (predefined) is at address %d.\n",
232   - string_content(car(operations[i].names)),
233   - integer_value(addr));
234   - else
235   - fprintf(symcode_txt,"Code for operation '%s' (%s, line %d) is at address %d.\n",
236   - string_content(car(operations[i].names)),
237   - string_content(operations[i].file_name),
238   - integer_value(operations[i].line),
239   - integer_value(addr));
  228 + i,nil,nil);
  229 + Expr addr = compiled_ops[op_i_id].addr;
  230 + if (integer_value(operations[i].line) == 0)
  231 + fprintf(symcode_txt,"Code for operation '%s' (predefined) is at address %d.\n",
  232 + string_content(car(operations[i].names)),
  233 + integer_value(addr));
  234 + else
  235 + fprintf(symcode_txt,"Code for operation '%s' (%s, line %d) is at address %d.\n",
  236 + string_content(car(operations[i].names)),
  237 + string_content(operations[i].file_name),
  238 + integer_value(operations[i].line),
  239 + integer_value(addr));
240 240 }
241 241  
242 242 fprintf(symcode_txt,
... ... @@ -267,21 +267,21 @@ void dump_symbolic_code(Expr init_addr_val)
267 267 for (i = 0; i < next_compiled_op; i++)
268 268 {
269 269 if (integer_value(operations[compiled_ops[i].op_id].line) == 0)
270   - fprintf(symcode_txt,";--- Instance of '%s' (predefined), with parameters ",
271   - string_content(car(operations[compiled_ops[i].op_id].names)));
  270 + fprintf(symcode_txt,";--- Instance of '%s' (predefined), with parameters ",
  271 + string_content(car(operations[compiled_ops[i].op_id].names)));
272 272 else
273   - fprintf(symcode_txt,";--- Instance of '%s' (%s, line %d), with parameters ",
274   - string_content(car(operations[compiled_ops[i].op_id].names)),
275   - string_content(operations[compiled_ops[i].op_id].file_name),
276   - integer_value(operations[compiled_ops[i].op_id].line));
  273 + fprintf(symcode_txt,";--- Instance of '%s' (%s, line %d), with parameters ",
  274 + string_content(car(operations[compiled_ops[i].op_id].names)),
  275 + string_content(operations[compiled_ops[i].op_id].file_name),
  276 + integer_value(operations[compiled_ops[i].op_id].line));
277 277 print_expr(symcode_txt,operations[compiled_ops[i].op_id].parms);
278 278 fprintf(symcode_txt," = ");
279 279 show_types(symcode_txt,compiled_ops[i].types,compiled_ops[i].env);
280 280 fprintf(symcode_txt," ---\n");
281 281  
282 282 fprintf(symcode_txt,";--- identification: ");
283   - for(j = 0; j < 20; j++)
284   - fprintf(symcode_txt,"%.2X",(compiled_ops[i].sha1_digest)[j]);
  283 + for(j = 0; j < 20; j++)
  284 + fprintf(symcode_txt,"%.2X",(compiled_ops[i].sha1_digest)[j]);
285 285 fprintf(symcode_txt," ---\n;--- made from: ");
286 286 print_expr(symcode_txt,compiled_ops[i].characterisation);
287 287 fprintf(symcode_txt,"\n");
... ... @@ -306,8 +306,8 @@ void dump_symbolic_code(Expr init_addr_val)
306 306 for (i = 0; i < next_compiled_string; i++)
307 307 {
308 308 fprintf(symcode_txt,"\n; string %d: \"%s\"",
309   - i,
310   - string_content(compiled_strings[i].string));
  309 + i,
  310 + string_content(compiled_strings[i].string));
311 311 }
312 312  
313 313 fprintf(symcode_txt,"\n\n;***** Operation schemes *****\n");
... ...
anubis_dev/compiler/src/typecmp.c
  Show/Hide comments   View file @e69a754
... ... @@ -13,12 +13,12 @@ static int same_types(Expr,Expr,Expr,Expr);
13 13  
14 14 /* comparing two types instances */
15 15 int same_type(Expr type1,
16   - Expr u_env1,
17   - Expr type2,
18   - Expr u_env2)
  16 + Expr u_env1,
  17 + Expr type2,
  18 + Expr u_env2)
19 19 {
20 20  
21   - // debug(new_string("same_type"));
  21 + //debug(new_string("same_type"));
22 22  
23 23 //debug(type1);
24 24 //debug(u_env1);
... ... @@ -63,15 +63,15 @@ int same_type(Expr type1,
63 63 if (consp(type1) && consp(type2))
64 64 {
65 65 if (car(type1) != car(type2))
66   - return 0;
  66 + return 0;
67 67  
68 68 if (car(type1) == app_ts)
69   - {
70   - type1 = cdr(type1);
71   - type2 = cdr(type2);
72   - if (car(type1) != car(type2)) return 0;
73   - return same_types(cdr(type1),u_env1,cdr(type2),u_env2);
74   - }
  69 + {
  70 + type1 = cdr(type1);
  71 + type2 = cdr(type2);
  72 + if (car(type1) != car(type2)) return 0;
  73 + return same_types(cdr(type1),u_env1,cdr(type2),u_env2);
  74 + }
75 75  
76 76 if (car(type1) == type_struct_ptr)
77 77 {
... ... @@ -80,19 +80,19 @@ int same_type(Expr type1,
80 80  
81 81 if (is_functional_type(type1))
82 82 {
83   - if (length(second(type1)) != length(second(type2))) return 0;
84   - return same_types(cons(cdr2(type1),second(type1)),u_env1,
85   - cons(cdr2(type2),second(type2)),u_env2);
86   - }
  83 + if (length(second(type1)) != length(second(type2))) return 0;
  84 + return same_types(cons(cdr2(type1),second(type1)),u_env1,
  85 + cons(cdr2(type2),second(type2)),u_env2);
  86 + }
87 87  
88 88 if (car(type1) == power_type)
89   - return same_type(cdr(type1),u_env1,cdr(type2),u_env2);
  89 + return same_type(cdr(type1),u_env1,cdr(type2),u_env2);
90 90  
91 91 if (is_address_type(type1))
92   - {
93   - /* TODO: modify (?Addr ...) syntax to handle several operands */
94   - return same_type(cdr(type1),u_env1,cdr(type2),u_env2);
95   - }
  92 + {
  93 + /* TODO: modify (?Addr ...) syntax to handle several operands */
  94 + return same_type(cdr(type1),u_env1,cdr(type2),u_env2);
  95 + }
96 96 }
97 97  
98 98 /* in all other cases the two types are distinct */
... ... @@ -102,9 +102,9 @@ int same_type(Expr type1,
102 102  
103 103 /* comparing lists of type instances */
104 104 static int same_types(Expr types1,
105   - Expr u_env1,
106   - Expr types2,
107   - Expr u_env2)
  105 + Expr u_env1,
  106 + Expr types2,
  107 + Expr u_env2)
108 108 {
109 109 /* the two lists of types should be the same, each one being
110 110 interpretated with its own environment */
... ... @@ -126,7 +126,7 @@ static int same_types(Expr types1,
126 126 //debug(types2);
127 127 assert(consp(types2));
128 128 if (!same_type(car(types1),u_env1,car(types2),u_env2))
129   - return 0;
  129 + return 0;
130 130 types1 = cdr(types1);
131 131 types2 = cdr(types2);
132 132 }
... ... @@ -136,14 +136,14 @@ static int same_types(Expr types1,
136 136  
137 137 /* comparing two instances of an operation scheme */
138 138 int same_op_instance(int opid1, /* operation scheme id */
139   - Expr types1, /* parameters of scheme */
140   - Expr u_env1, /* to interpret parameters */
141   - int opid2,
142   - Expr types2,
143   - Expr u_env2)
  139 + Expr types1, /* parameters of scheme */
  140 + Expr u_env1, /* to interpret parameters */
  141 + int opid2,
  142 + Expr types2,
  143 + Expr u_env2)
144 144 {
145 145 return (opid1 == opid2) &&
146   - same_types(types1,u_env1,types2,u_env2);
  146 + same_types(types1,u_env1,types2,u_env2);
147 147 }
148 148  
149 149  
... ...
anubis_dev/compiler/src/typedef.c
  Show/Hide comments   View file @e69a754
... ... @@ -22,7 +22,7 @@ char infinite_flags_reliable = 0;
22 22  
23 23  
24 24 void new_type_name (Expr lc,
25   - int C_dump,
  25 + int C_dump,
26 26 Expr name,
27 27 Expr def)
28 28 {
... ... @@ -34,21 +34,21 @@ void new_type_name (Expr lc,
34 34  
35 35 /* checking a type scheme */
36 36 void new_type_scheme (Expr lc, /* <lc> */
37   - int C_dump,
38   - Expr name, /* <type name> */
39   - Expr parms, /* <user type variables> */
40   - Expr alts, /* <alternatives or packets 1> */
41   - int more,
  37 + int C_dump,
  38 + Expr name, /* <type name> */
  39 + Expr parms, /* <user type variables> */
  40 + Expr alts, /* <alternatives or packets 1> */
  41 + int more,
42 42 int public);
43 43  
44 44 /* checking an alternative or a packet (returns a packet) */
45 45 Expr check_alt (Expr lc, /* <lc> */
46 46 Expr file_name,
47   - Expr alt, /* <alternative or packet> */
48   - Expr target_type, /* <type> */
49   - Expr parms, /* <user type variables> */
50   - int type_id, /* type id */
51   - int rank); /* rank of alternative */
  47 + Expr alt, /* <alternative or packet> */
  48 + Expr target_type, /* <type> */
  49 + Expr parms, /* <user type variables> */
  50 + int type_id, /* type id */
  51 + int rank); /* rank of alternative */
52 52  
53 53  
54 54  
... ... @@ -59,10 +59,10 @@ Expr check_alt (Expr lc, /* &lt;lc&gt; */
59 59 /* checking a type scheme *********************************************************/
60 60 void new_type_scheme(Expr lc, /* <lc> */
61 61 int C_dump,
62   - Expr name, /* <type name> */
63   - Expr parms, /* <user type variables> */
64   - Expr alts, /* <alternatives 1> */
65   - int more, /* 1 if ,... */
  62 + Expr name, /* <type name> */
  63 + Expr parms, /* <user type variables> */
  64 + Expr alts, /* <alternatives 1> */
  65 + int more, /* 1 if ,... */
66 66 int public)
67 67 {
68 68 int i, tid;
... ... @@ -78,8 +78,8 @@ void new_type_scheme(Expr lc, /* &lt;lc&gt; */
78 78  
79 79 if (verbose && par_seen)
80 80 printf(msgtext_checking_type[language],
81   - string_content(name),
82   - line_in(lc));
  81 + string_content(name),
  82 + line_in(lc));
83 83  
84 84 /* type may be already known */
85 85 {
... ... @@ -128,10 +128,10 @@ void new_type_scheme(Expr lc, /* &lt;lc&gt; */
128 128 /* check if we can create a new type */
129 129 assert(next_type <= max_type);
130 130 if (next_type == max_type)
131   - {
132   - max_type += 1000;
133   - types = (struct Type_struct *)reallocz(types,max_type*sizeof(struct Type_struct));
134   - }
  131 + {
  132 + max_type += 1000;
  133 + types = (struct Type_struct *)reallocz(types,max_type*sizeof(struct Type_struct));
  134 + }
135 135  
136 136 if (gindex)
137 137 {
... ... @@ -174,11 +174,11 @@ void new_type_scheme(Expr lc, /* &lt;lc&gt; */
174 174 /* check an alternative */
175 175 packet = check_alt(lc,
176 176 file_name,
177   - car(alts),
178   - ttype,
179   - parms,
180   - tid,
181   - i);
  177 + car(alts),
  178 + ttype,
  179 + parms,
  180 + tid,
  181 + i);
182 182  
183 183 /* update rank for next packet */
184 184 i += length(packet);
... ... @@ -188,12 +188,12 @@ void new_type_scheme(Expr lc, /* &lt;lc&gt; */
188 188  
189 189 /* check max number of alternatives */
190 190 if (i >= 256)
191   - {
192   - err_line_col(lc);
193   - fprintf(stderr,
194   - msgtext_too_many_alternatives[language]);
195   - return;
196   - }
  191 + {
  192 + err_line_col(lc);
  193 + fprintf(stderr,
  194 + msgtext_too_many_alternatives[language]);
  195 + return;
  196 + }
197 197  
198 198 /* do for next alt or packet */
199 199 alts = cdr(alts);
... ... @@ -227,6 +227,17 @@ void new_type_scheme(Expr lc, /* &lt;lc&gt; */
227 227 fprintf(predef_aux,",%d,%d);\n",more,public);
228 228 }
229 229  
  230 + if (predef_npd_aux != NULL)
  231 + {
  232 + fprintf(predef_npd_aux,"\nnew_type_scheme(new_integer(0),%d,\n",C_dump);
  233 + print_expr_to_C(predef_npd_aux,name);
  234 + fprintf(predef_npd_aux,",\n");
  235 + print_expr_to_C(predef_npd_aux,parms);
  236 + fprintf(predef_npd_aux,",\n");
  237 + print_expr_to_C(predef_npd_aux,all_alts);
  238 + fprintf(predef_npd_aux,",%d,%d);\n",more,public);
  239 + }
  240 +
230 241 if (errors != errors_before)
231 242 /* an error occured in type checking */
232 243 next_type--; /* ignore this type */
... ... @@ -259,11 +270,11 @@ Expr rmap_par(Expr types, Expr vars)
259 270 /* checking an alternative *******************************************************/
260 271 Expr check_alt(Expr lc, /* <lc> */
261 272 Expr file_name,
262   - Expr alt, /* ((name ... name) (type . sym) ...) */
263   - Expr target_type, /* <type name> */
264   - Expr parms, /* <user type variables> */
265   - int type_id, /* type id */
266   - int rank) /* rank of alternative */
  273 + Expr alt, /* ((name ... name) (type . sym) ...) */
  274 + Expr target_type, /* <type name> */
  275 + Expr parms, /* <user type variables> */
  276 + int type_id, /* type id */
  277 + int rank) /* rank of alternative */
267 278 {
268 279 int narg;
269 280 Expr aux = alt;
... ... @@ -295,44 +306,44 @@ Expr check_alt(Expr lc, /* &lt;lc&gt; */
295 306  
296 307 /* if target type not yet known, take next type as id */
297 308 if (current_type_id == key_not_found)
298   - current_type_id = new_integer(next_type);
  309 + current_type_id = new_integer(next_type);
299 310  
300 311 /* getting the packet id, which must be anterior to the current
301   - type name. */
  312 + type name. */
302 313 for (pid = 0; pid < integer_value(current_type_id); pid++)
303   - if (types[pid].name == second(alt))
304   - break;
  314 + if (types[pid].name == second(alt))
  315 + break;
305 316  
306 317 /* the packet name must be known */
307 318 if (pid == integer_value(current_type_id))
308   - {
309   - err_line_col(lc);
310   - fprintf(errfile,
311   - msgtext_unknown_packet_name[language],
312   - second(alt));
313   - return nil;
314   - }
  319 + {
  320 + err_line_col(lc);
  321 + fprintf(errfile,
  322 + msgtext_unknown_packet_name[language],
  323 + second(alt));
  324 + return nil;
  325 + }
315 326  
316 327 /* check number of operands */
317 328 nparms = length(types[pid].parms);
318 329 nactual = length(cdr2(alt));
319 330 if (nactual != nparms)
320   - {
321   - err_line_col(lc);
322   - fprintf(errfile,
323   - msgtext_bad_packet_arity[language],
324   - nparms,
325   - nactual);
326   - return nil;
327   - }
  331 + {
  332 + err_line_col(lc);
  333 + fprintf(errfile,
  334 + msgtext_bad_packet_arity[language],
  335 + nparms,
  336 + nactual);
  337 + return nil;
  338 + }
328 339  
329 340 /* check operands */
330 341 aux = cdr2(alt);
331 342 while (consp(aux))
332   - {
333   - check_explicit_type(lc,car(aux),parms);
334   - aux = cdr(aux);
335   - }
  343 + {
  344 + check_explicit_type(lc,car(aux),parms);
  345 + aux = cdr(aux);
  346 + }
336 347  
337 348 /* get parms and alternatives of packet */
338 349 packet_parms = third(types[pid].def);
... ... @@ -341,11 +352,11 @@ Expr check_alt(Expr lc, /* &lt;lc&gt; */
341 352 subst = nil;
342 353 aux = cdr2(alt);
343 354 while (consp(packet_parms))
344   - {
345   - subst = cons(cons(car(packet_parms),car(aux)),subst);
346   - packet_parms = cdr(packet_parms);
347   - aux = cdr(aux);
348   - }
  355 + {
  356 + subst = cons(cons(car(packet_parms),car(aux)),subst);
  357 + packet_parms = cdr(packet_parms);
  358 + aux = cdr(aux);
  359 + }
349 360  
350 361 /* substitute actual parameters to formal parameters */
351 362 packet_alts = cdr4(types[pid].def);
... ... @@ -385,7 +396,7 @@ Expr check_alt(Expr lc, /* &lt;lc&gt; */
385 396 {
386 397 err_line_col(lc);
387 398 fprintf(errfile,
388   - msgtext_repeated_alt_operand_name[language]);
  399 + msgtext_repeated_alt_operand_name[language]);
389 400 print_expr(errfile,reverse(vars));
390 401 fprintf(errfile,"\n");
391 402 }
... ... @@ -395,7 +406,7 @@ Expr check_alt(Expr lc, /* &lt;lc&gt; */
395 406 {
396 407 max_operation += 500;
397 408 operations = (struct Operation_struct *)reallocz(operations,
398   - max_operation*sizeof(struct Operation_struct));
  409 + max_operation*sizeof(struct Operation_struct));
399 410 }
400 411 operations[next_operation].names = car(alt);
401 412 operations[next_operation].file_name = new_string(source_file_name);
... ... @@ -427,7 +438,7 @@ int is_primitive_type(Expr type)
427 438 return (
428 439 primitive_types_list
429 440 item(type_Listener) 0
430   - );
  441 + );
431 442 #undef item
432 443 }
433 444  
... ... @@ -437,14 +448,14 @@ int is_address_type(Expr type)
437 448 if (consp(type))
438 449 {
439 450 switch(car(type))
440   - {
  451 + {
441 452 #define item(t) case t:
442 453 address_types_list
443 454 #undef item
444   - return 1;
445   - default:
446   - return 0;
447   - }
  455 + return 1;
  456 + default:
  457 + return 0;
  458 + }
448 459 }
449 460 else
450 461 return 0;
... ... @@ -456,14 +467,14 @@ int is_far_address_type(Expr type)
456 467 if (consp(type))
457 468 {
458 469 switch (car(type))
459   - {
460   - case type_RAddr:
461   - case type_WAddr:
462   - case type_RWAddr:
463   - return 1;
464   - default:
465   - return 0;
466   - }
  470 + {
  471 + case type_RAddr:
  472 + case type_WAddr:
  473 + case type_RWAddr:
  474 + return 1;
  475 + default:
  476 + return 0;
  477 + }
467 478 }
468 479 else
469 480 return 0;
... ... @@ -474,12 +485,12 @@ int is_far_RW_address_type(Expr type)
474 485 if (consp(type))
475 486 {
476 487 switch (car(type))
477   - {
478   - case type_RWAddr:
479   - return 1;
480   - default:
481   - return 0;
482   - }
  488 + {
  489 + case type_RWAddr:
  490 + return 1;
  491 + default:
  492 + return 0;
  493 + }
483 494 }
484 495 else
485 496 return 0;
... ... @@ -495,9 +506,9 @@ int is_sum_type(Expr type, Expr env)
495 506 {
496 507 aux = assoc(type,env);
497 508 if (aux == key_not_found)
498   - break;
  509 + break;
499 510 else
500   - type = aux;
  511 + type = aux;
501 512 }
502 513  
503 514 if (is_string(type)) return 1;
... ... @@ -511,16 +522,16 @@ int is_readable_address_type(Expr type)
511 522 if (consp(type))
512 523 {
513 524 switch(car(type))
514   - {
515   - case type_RAddr:
516   - case type_RWAddr:
517   - case type_GAddr:
518   - case type_Var:
  525 + {
  526 + case type_RAddr:
  527 + case type_RWAddr:
  528 + case type_GAddr:
  529 + case type_Var:
519 530 case pseudo_type_MVar_Slot:
520   - return 1;
521   - default:
522   - return 0;
523   - }
  531 + return 1;
  532 + default:
  533 + return 0;
  534 + }
524 535 }
525 536 else
526 537 return 0;
... ... @@ -532,16 +543,16 @@ int is_writable_address_type(Expr type)
532 543 if (consp(type))
533 544 {
534 545 switch(car(type))
535   - {
536   - case type_WAddr:
537   - case type_RWAddr:
538   - case type_GAddr:
539   - case type_Var:
  546 + {
  547 + case type_WAddr:
  548 + case type_RWAddr:
  549 + case type_GAddr:
  550 + case type_Var:
540 551 case pseudo_type_MVar_Slot:
541   - return 1;
542   - default:
543   - return 0;
544   - }
  552 + return 1;
  553 + default:
  554 + return 0;
  555 + }
545 556 }
546 557 else
547 558 return 0;
... ... @@ -553,13 +564,13 @@ int is_exchangeable_address_type(Expr type)
553 564 if (consp(type))
554 565 {
555 566 switch(car(type))
556   - {
557   - case type_GAddr:
558   - case type_Var:
559   - return 1;
560   - default:
561   - return 0;
562   - }
  567 + {
  568 + case type_GAddr:
  569 + case type_Var:
  570 + return 1;
  571 + default:
  572 + return 0;
  573 + }
563 574 }
564 575 else
565 576 return 0;
... ... @@ -574,16 +585,16 @@ Expr name_of_type(Expr type)
574 585 if (consp(type))
575 586 {
576 587 switch (car(type))
577   - {
578   - case app_ts:
579   - {
580   - type = second(type);
581   - goto begin;
582   - }
583   - default:
584   - internal_error("Cannot find the name of type",type);
585   - return nil;
586   - }
  588 + {
  589 + case app_ts:
  590 + {
  591 + type = second(type);
  592 + goto begin;
  593 + }
  594 + default:
  595 + internal_error("Cannot find the name of type",type);
  596 + return nil;
  597 + }
587 598 }
588 599 else
589 600 return type;
... ... @@ -638,7 +649,7 @@ int is_empty_alt(Expr alt, Expr env)
638 649 while (consp(alt))
639 650 {
640 651 if (is_empty_type(car(car(alt)),env))
641   - return 1;
  652 + return 1;
642 653 alt = cdr(alt);
643 654 }
644 655 return 0;
... ... @@ -703,20 +714,20 @@ Expr get_alts(Expr file_name, Expr type, Expr env, Expr lc)
703 714 while (consp(aux))
704 715 {
705 716 if (is_unknown(car(aux)))
706   - {
707   - packet_type = assoc(car(aux),subst);
708   - assert(packet_type != key_not_found);
709   - packet_alts = get_alts(file_name,packet_type,env,lc);
710   - if (packet_type == nil)
711   - {
712   - return nil;
713   - }
714   - alts = append(reverse(packet_alts),alts);
715   - }
  717 + {
  718 + packet_type = assoc(car(aux),subst);
  719 + assert(packet_type != key_not_found);
  720 + packet_alts = get_alts(file_name,packet_type,env,lc);
  721 + if (packet_type == nil)
  722 + {
  723 + return nil;
  724 + }
  725 + alts = append(reverse(packet_alts),alts);
  726 + }
716 727 else
717   - {
718   - alts = cons(car(aux),alts);
719   - }
  728 + {
  729 + alts = cons(car(aux),alts);
  730 + }
720 731 aux = cdr(aux);
721 732 }
722 733 /* we need to reverse alts and to eliminate empty alternatives */
... ... @@ -725,7 +736,7 @@ Expr get_alts(Expr file_name, Expr type, Expr env, Expr lc)
725 736 while (consp(aux))
726 737 {
727 738 if (!is_empty_alt(car(aux),env))
728   - alts = cons(car(aux),alts);
  739 + alts = cons(car(aux),alts);
729 740  
730 741 aux = cdr(aux);
731 742 }
... ... @@ -746,10 +757,10 @@ void check_incomplete_types(void)
746 757 for (i = 0; i < next_type; i++)
747 758 if (!types[i].completed)
748 759 {
749   - fprintf(stderr,
750   - msgtext_incomplete_type[language],
751   - string_content(types[i].name));
752   - n++;
  760 + fprintf(stderr,
  761 + msgtext_incomplete_type[language],
  762 + string_content(types[i].name));
  763 + n++;
753 764 }
754 765 if (n)
755 766 {
... ...
anubis_dev/compiler/src/typetools.c
  Show/Hide comments   View file @e69a754
... ... @@ -25,7 +25,7 @@ static Expr target_from_type(Expr type, Expr env)
25 25 switch(car(type))
26 26 {
27 27 case functype:
28   - return cdr2(type);
  28 + return cdr2(type);
29 29 }
30 30  
31 31 return type; /* because T is the same as () -> T */
... ... @@ -113,9 +113,9 @@ Expr type_from_interpretation(Expr head, Expr env)
113 113  
114 114 case with:
115 115 {
116   - /* (with <lc> <symbol> <int head> . <int head>) */
117   - head = cdr4(head);
118   - goto begin;
  116 + /* (with <lc> <symbol> <int head> . <int head>) */
  117 + head = cdr4(head);
  118 + goto begin;
119 119 }
120 120 break;
121 121  
... ... @@ -144,7 +144,7 @@ Expr type_from_interpretation(Expr head, Expr env)
144 144 result = type_String;
145 145 break;
146 146  
147   - case int32: /* (int32 <lc> . <Cint>) */
  147 + case anb_int32: /* (int32 <lc> . <Cint>) */
148 148 result = type_Int32;
149 149 break;
150 150  
... ... @@ -158,62 +158,62 @@ Expr type_from_interpretation(Expr head, Expr env)
158 158  
159 159 case anb_read: /* (anb_read <lc> . <head>) */
160 160 {
161   - Expr conn_type = type_from_interpretation(cdr2(head),env);
  161 + Expr conn_type = type_from_interpretation(cdr2(head),env);
162 162 //debug(conn_type);
163 163 //debug(env);
164   - assert(is_readable_address_type(conn_type));
165   - switch (car(conn_type))
166   - {
167   - case type_RAddr:
168   - case type_RWAddr:
169   - result = list3(app_ts,pdstr_Maybe,(cdr(conn_type)));
170   - break;
171   - case type_GAddr:
172   - case type_Var:
  164 + assert(is_readable_address_type(conn_type));
  165 + switch (car(conn_type))
  166 + {
  167 + case type_RAddr:
  168 + case type_RWAddr:
  169 + result = list3(app_ts,pdstr_Maybe,(cdr(conn_type)));
  170 + break;
  171 + case type_GAddr:
  172 + case type_Var:
173 173 case pseudo_type_MVar_Slot:
174   - result = cdr(conn_type);
175   - break;
176   - default:
177   - internal_error("Unknown address type",conn_type);
178   - }
  174 + result = cdr(conn_type);
  175 + break;
  176 + default:
  177 + internal_error("Unknown address type",conn_type);
  178 + }
179 179 }
180 180 break;
181 181  
182 182 case anb_write: /* (anb_write <lc> <head conn> . <head value>) */
183 183 {
184   - Expr conn_type = type_from_interpretation(third(head),env);
185   - assert(is_writable_address_type(conn_type));
186   - switch (car(conn_type))
187   - {
188   - case type_WAddr:
189   - case type_RWAddr:
190   - result = list3(app_ts,pdstr_Maybe,pdstr_One);
191   - break;
192   - case type_GAddr:
193   - case type_Var:
  184 + Expr conn_type = type_from_interpretation(third(head),env);
  185 + assert(is_writable_address_type(conn_type));
  186 + switch (car(conn_type))
  187 + {
  188 + case type_WAddr:
  189 + case type_RWAddr:
  190 + result = list3(app_ts,pdstr_Maybe,pdstr_One);
  191 + break;
  192 + case type_GAddr:
  193 + case type_Var:
194 194 case pseudo_type_MVar_Slot:
195   - result = pdstr_One;
196   - break;
197   - default:
198   - internal_error("Unknown writable address type",conn_type);
199   - }
  195 + result = pdstr_One;
  196 + break;
  197 + default:
  198 + internal_error("Unknown writable address type",conn_type);
  199 + }
200 200 }
201 201 break;
202 202  
203 203 case anb_exchange: /* (anb_exchange <lc> <head conn> . <head value>) */
204 204 {
205   - Expr conn_type = type_from_interpretation(third(head),env);
206   - assert(is_exchangeable_address_type(conn_type));
207   - switch (car(conn_type))
208   - {
209   - case type_GAddr:
210   - case type_Var:
  205 + Expr conn_type = type_from_interpretation(third(head),env);
  206 + assert(is_exchangeable_address_type(conn_type));
  207 + switch (car(conn_type))
  208 + {
  209 + case type_GAddr:
  210 + case type_Var:
211 211 case pseudo_type_MVar_Slot:
212   - result = type_from_interpretation(cdr3(head),env);
213   - break;
214   - default:
215   - internal_error("Unknown exchangeable address type",conn_type);
216   - }
  212 + result = type_from_interpretation(cdr3(head),env);
  213 + break;
  214 + default:
  215 + internal_error("Unknown exchangeable address type",conn_type);
  216 + }
217 217 }
218 218 break;
219 219  
... ... @@ -244,7 +244,7 @@ Expr type_from_interpretation(Expr head, Expr env)
244 244 break;
245 245  
246 246 case global_variable: /* (global_variable <lc> . <i>)
247   - where i is the index of the variable in 'variables' */
  247 + where i is the index of the variable in 'variables' */
248 248 result = variables[integer_value(cdr2(head))].type;
249 249 break;
250 250  
... ... @@ -315,10 +315,10 @@ Expr type_from_interpretation(Expr head, Expr env)
315 315  
316 316 /* checking the type in an explicitly typed term */
317 317 int /* returns 1 if type OK, 0 otherwise with error message
318   - sent. */
  318 + sent. */
319 319 check_explicit_type(Expr lc,
320   - Expr type, /* the type to be checked */
321   - Expr tvs) /* list of user type variables */
  320 + Expr type, /* the type to be checked */
  321 + Expr tvs) /* list of user type variables */
322 322 {
323 323 Expr tname, aux;
324 324 int type_id, i, nargs, nparms;
... ... @@ -336,15 +336,15 @@ check_explicit_type(Expr lc,
336 336 if (is_user_type_variable(type))
337 337 {
338 338 if (member(type,tvs))
339   - return 1;
  339 + return 1;
340 340 else
341   - {
342   - err_line_col(lc);
343   - fprintf(errfile,
344   - msgtext_unknown_type_variable[language],
345   - utvar_name(type));
346   - return 0;
347   - }
  341 + {
  342 + err_line_col(lc);
  343 + fprintf(errfile,
  344 + msgtext_unknown_type_variable[language],
  345 + utvar_name(type));
  346 + return 0;
  347 + }
348 348 }
349 349  
350 350 /* do for C Structure pointers */
... ... @@ -363,10 +363,10 @@ check_explicit_type(Expr lc,
363 363 /* (functype <types> . <type>) */
364 364 Expr aux = second(type);
365 365 while (consp(aux))
366   - {
367   - if (!check_explicit_type(lc,car(aux),tvs)) return 0;
368   - aux = cdr(aux);
369   - }
  366 + {
  367 + if (!check_explicit_type(lc,car(aux),tvs)) return 0;
  368 + aux = cdr(aux);
  369 + }
370 370 return check_explicit_type(lc,cdr2(type),tvs);
371 371 }
372 372  
... ... @@ -381,19 +381,19 @@ check_explicit_type(Expr lc,
381 381 if (is_address_type(type))
382 382 {
383 383 switch (car(type))
384   - {
385   - /* (type_RAddr . T) */
386   - case type_RAddr:
387   - case type_WAddr:
388   - case type_RWAddr:
389   - case type_GAddr:
390   - case type_Var:
391   - case type_MVar:
392   - return check_explicit_type(lc,cdr(type),tvs);
393   -
394   - default:
395   - assert(0);
396   - }
  384 + {
  385 + /* (type_RAddr . T) */
  386 + case type_RAddr:
  387 + case type_WAddr:
  388 + case type_RWAddr:
  389 + case type_GAddr:
  390 + case type_Var:
  391 + case type_MVar:
  392 + return check_explicit_type(lc,cdr(type),tvs);
  393 +
  394 + default:
  395 + assert(0);
  396 + }
397 397 }
398 398  
399 399 /* get name of type */
... ... @@ -423,10 +423,10 @@ check_explicit_type(Expr lc,
423 423 /* check if we can create a new type */
424 424 assert(next_type <= max_type);
425 425 if (next_type == max_type)
426   - {
427   - max_type += 1000;
428   - types = (struct Type_struct *)reallocz(types,max_type*sizeof(struct Type_struct));
429   - }
  426 + {
  427 + max_type += 1000;
  428 + types = (struct Type_struct *)reallocz(types,max_type*sizeof(struct Type_struct));
  429 + }
430 430 /* create a (non completed) type with zero alternatives. */
431 431 types[type_id].name = tname;
432 432 types[type_id].file_name = nil;
... ... @@ -449,8 +449,8 @@ check_explicit_type(Expr lc,
449 449 #else
450 450 err_line_col(lc);
451 451 fprintf(errfile,
452   - msgtext_type_not_found[language],
453   - string_content(tname));
  452 + msgtext_type_not_found[language],
  453 + string_content(tname));
454 454 return 0;
455 455 #endif
456 456 }
... ... @@ -466,24 +466,24 @@ check_explicit_type(Expr lc,
466 466  
467 467 /* check arity */
468 468 if (nargs != nparms)
469   - {
470   - err_line_col(lc);
471   - fprintf(errfile,
472   - msgtext_type_scheme_bad_arity[language],
473   - string_content(tname),
474   - nparms,
475   - nargs);
476   - return 0;
477   - }
  469 + {
  470 + err_line_col(lc);
  471 + fprintf(errfile,
  472 + msgtext_type_scheme_bad_arity[language],
  473 + string_content(tname),
  474 + nparms,
  475 + nargs);
  476 + return 0;
  477 + }
478 478  
479 479 /* check each argument type */
480 480 {
481   - aux = cdr(cdr(type)); /* actual arguments */
482   - for (i = 0; i < nargs; i++)
483   - {
484   - if (!check_explicit_type(lc,car(aux),tvs)) return 0;
485   - aux = cdr(aux);
486   - }
  481 + aux = cdr(cdr(type)); /* actual arguments */
  482 + for (i = 0; i < nargs; i++)
  483 + {
  484 + if (!check_explicit_type(lc,car(aux),tvs)) return 0;
  485 + aux = cdr(aux);
  486 + }
487 487 }
488 488 return 1;
489 489 }
... ... @@ -493,15 +493,15 @@ check_explicit_type(Expr lc,
493 493 parameter in the definition scheme */
494 494  
495 495 if (types[type_id].parms != nil)
496   - {
497   - err_line_col(lc);
498   - fprintf(errfile,
499   - msgtext_type_scheme_bad_arity[language],
500   - string_content(tname),
501   - nparms,
502   - 0);
503   - return 0;
504   - }
  496 + {
  497 + err_line_col(lc);
  498 + fprintf(errfile,
  499 + msgtext_type_scheme_bad_arity[language],
  500 + string_content(tname),
  501 + nparms,
  502 + 0);
  503 + return 0;
  504 + }
505 505 return 1;
506 506 }
507 507 }
... ... @@ -523,31 +523,31 @@ int has_recursive_equality(Expr implem)
523 523 {
524 524 Expr geom;
525 525 /* large_type
526   - implem = (mixed_type <nalt> <iw> <alt geom> ...)
  526 + implem = (mixed_type <nalt> <iw> <alt geom> ...)
527 527  
528   - small_alt
529   - large_alt
530   - <alt geom> = (mixed_alt (<imp> <offset> . <width>) ...)
  528 + small_alt
  529 + large_alt
  530 + <alt geom> = (mixed_alt (<imp> <offset> . <width>) ...)
531 531  
532   - <imp> (a Lisp-like integer) always refers to an Implem_struct, even for
533   - a primitive type, functional type or address type. Form this Implem_struct
534   - the implementation itself may be recovered as the 'implem' field.
  532 + <imp> (a Lisp-like integer) always refers to an Implem_struct, even for
  533 + a primitive type, functional type or address type. Form this Implem_struct
  534 + the implementation itself may be recovered as the 'implem' field.
535 535 */
536 536 implem = cdr3(implem); /* (<alt geom> ...) */
537 537 while (consp(implem)) /* do for each alternative */
538   - {
539   - geom = car(implem);
540   - implem = cdr(implem);
541   -
542   - if (car(geom) == small_alt) continue; /* small alts have recursive eq */
543   -
544   - geom = cdr(geom); /* ((<imp> ? . ?) ...) */
545   - while (consp(geom)) /* do for each component */
546   - {
547   - if (!has_recursive_equality(implems[integer_value(car(car(geom)))].implem))
548   - return 0;
549   - }
550   - }
  538 + {
  539 + geom = car(implem);
  540 + implem = cdr(implem);
  541 +
  542 + if (car(geom) == small_alt) continue; /* small alts have recursive eq */
  543 +
  544 + geom = cdr(geom); /* ((<imp> ? . ?) ...) */
  545 + while (consp(geom)) /* do for each component */
  546 + {
  547 + if (!has_recursive_equality(implems[integer_value(car(car(geom)))].implem))
  548 + return 0;
  549 + }
  550 + }
551 551 return 1;
552 552 }
553 553 internal_error("Cannot check implementation for recursive equality",implem); return 0;
... ... @@ -566,9 +566,9 @@ int is_global_address_type(Expr type)
566 566 case type_RAddr:
567 567 case type_WAddr:
568 568 case type_RWAddr:
569   - return 1;
  569 + return 1;
570 570 default:
571   - return 0;
  571 + return 0;
572 572 }
573 573 else
574 574 return 0;
... ...
anubis_dev/compiler/src/typewidth.c
  Show/Hide comments   View file @e69a754
... ... @@ -117,7 +117,7 @@ int real_type_width(Expr type,
117 117 /* computing the width of an alternative ****************************************/
118 118 int alt_width(Expr alt, /* alternative */
119 119 Expr env, /* env for unknowns */
120   - Expr type)
  120 + Expr type)
121 121 {
122 122 int result = 0;
123 123  
... ...
anubis_dev/compiler/src/unify.c
  Show/Hide comments   View file @e69a754
... ... @@ -47,7 +47,7 @@ static int depends_on(Expr x, // x is an unknown
47 47 else
48 48 {
49 49 if (depends_on(x,car(y),env))
50   - return 1;
  50 + return 1;
51 51 y = cdr(y);
52 52 goto begin;
53 53 }
... ... @@ -67,21 +67,21 @@ Expr join_envs(Expr e1, Expr e2)
67 67 e1 = cdr(e1);
68 68  
69 69 /* if 'key' is not a key of e2, just add the entry to e2. Otherwise, if the values
70   - of 'key' in e1 and e2 do not unify (with envs nil and e2), return
71   - 'not_unifiable'. If they unify, replace e2 by the result of this unification. */
  70 + of 'key' in e1 and e2 do not unify (with envs nil and e2), return
  71 + 'not_unifiable'. If they unify, replace e2 by the result of this unification. */
72 72 val2 = assoc(key,e2);
73 73  
74 74 if (val2 == key_not_found)
75   - e2 = cons(entry,e2);
  75 + e2 = cons(entry,e2);
76 76  
77 77 else
78   - {
79   - e2 = unify(val,nil,val2,e2);
80   - if (e2 == not_unifiable)
81   - {
82   - return e2;
83   - }
84   - }
  78 + {
  79 + e2 = unify(val,nil,val2,e2);
  80 + if (e2 == not_unifiable)
  81 + {
  82 + return e2;
  83 + }
  84 + }
85 85 }
86 86 return e2;
87 87 }
... ... @@ -116,8 +116,8 @@ _unify(Expr x, /* first expression to unify */
116 116  
117 117 /* the unification itself */
118 118 static int unify_aux(Expr x,
119   - Expr y,
120   - Expr *env)
  119 + Expr y,
  120 + Expr *env)
121 121 {
122 122 Expr aux;
123 123 begin:
... ... @@ -129,56 +129,56 @@ static int unify_aux(Expr x,
129 129 {
130 130 Expr v = assoc(x,*env);
131 131 if (v == key_not_found)
132   - {
133   - /* x not instanciated */
134   - /* pairs ($x . $y) in env must always satisfy $x > $y */
135   - if (is_unknown(y) && x <= y)
136   - {
137   - /* exchange x and y, and try again */
138   - aux = x;
139   - x = y;
140   - y = aux;
141   - goto begin;
142   - }
143   - else
144   - {
145   - if (depends_on(x,y,*env))
146   - return 0;
147   - else
148   - {
149   - *env = cons(cons(x,y),*env);
150   - return 1;
151   - }
152   - }
153   - }
  132 + {
  133 + /* x not instanciated */
  134 + /* pairs ($x . $y) in env must always satisfy $x > $y */
  135 + if (is_unknown(y) && x <= y)
  136 + {
  137 + /* exchange x and y, and try again */
  138 + aux = x;
  139 + x = y;
  140 + y = aux;
  141 + goto begin;
  142 + }
  143 + else
  144 + {
  145 + if (depends_on(x,y,*env))
  146 + return 0;
  147 + else
  148 + {
  149 + *env = cons(cons(x,y),*env);
  150 + return 1;
  151 + }
  152 + }
  153 + }
154 154 else
155   - {
156   - x = v;
157   - goto begin;
158   - }
  155 + {
  156 + x = v;
  157 + goto begin;
  158 + }
159 159 }
160 160  
161 161 if (is_unknown(y))
162 162 {
163 163 Expr v = assoc(y,*env);
164 164 if (v == key_not_found)
165   - {
166   - /* y not instanciated */
167   - {
168   - if (depends_on(y,x,*env))
169   - return 0;
170   - else
171   - {
172   - *env = cons(cons(y,x),*env);
173   - return 1;
174   - }
175   - }
176   - }
  165 + {
  166 + /* y not instanciated */
  167 + {
  168 + if (depends_on(y,x,*env))
  169 + return 0;
  170 + else
  171 + {
  172 + *env = cons(cons(y,x),*env);
  173 + return 1;
  174 + }
  175 + }
  176 + }
177 177 else
178   - {
179   - y = v;
180   - goto begin;
181   - }
  178 + {
  179 + y = v;
  180 + goto begin;
  181 + }
182 182 }
183 183  
184 184 if (!(consp(x) && consp(y)))
... ...
anubis_dev/compiler/src/unknowns.c
  Show/Hide comments   View file @e69a754
... ... @@ -20,16 +20,16 @@ int has_unknowns_aux(Expr term, Expr env)
20 20 /* get its value */
21 21 term = assoc(term,env);
22 22 if (term == key_not_found)
23   - /* unknown has no value */
24   - return 1;
  23 + /* unknown has no value */
  24 + return 1;
25 25 else
26   - /* try again with the value */
27   - goto begin;
  26 + /* try again with the value */
  27 + goto begin;
28 28 }
29 29  
30 30 else if (consp(term))
31 31 {
32   - if (car(term) == int32) return 0;
  32 + if (car(term) == anb_int32) return 0;
33 33 if (car(term) == integer) return 0;
34 34 else if (car(term) == small_datum) return has_unknowns_aux(second(term),env);
35 35 else if (has_unknowns_aux(car(term),env)) return 1;
... ... @@ -64,17 +64,17 @@ void must_be_non_ambiguous(Expr interps)
64 64 if (n == 0)
65 65 {
66 66 /* No interpretation at all. Do not generate an error message,
67   - because there must be a subterm which has no interpretation,
68   - and which already generated an error message. */
69   - return;
  67 + because there must be a subterm which has no interpretation,
  68 + and which already generated an error message. */
  69 + return;
70 70 }
71 71  
72 72 if (n >= 2)
73 73 {
74 74 err_line_col(car(cdr(car(car(interps)))));
75 75 fprintf(errfile,
76   - msgtext_ambiguous_term[language],
77   - length(interps));
  76 + msgtext_ambiguous_term[language],
  77 + length(interps));
78 78 show_interpretations(errfile,interps);
79 79 return;
80 80 }
... ... @@ -82,11 +82,11 @@ void must_be_non_ambiguous(Expr interps)
82 82 /* now there is one and only one interpretation, but it may still be
83 83 ambiguous, because it may contain an unknown */
84 84 if (has_unknowns(car(car(interps)),
85   - cdr(car(interps))))
  85 + cdr(car(interps))))
86 86 {
87 87 err_line_col(car(cdr(car(car(interps)))));
88 88 fprintf(errfile,
89   - msgtext_term_with_unknowns[language]);
  89 + msgtext_term_with_unknowns[language]);
90 90 show_interpretation(errfile,car(car(interps)),cdr(car(interps)));
91 91 return;
92 92 }
... ... @@ -96,7 +96,7 @@ void must_be_non_ambiguous(Expr interps)
96 96 /* refreshing an expression: replace all user type variables by fresh
97 97 internal type variables */
98 98 Expr refresh(Expr expr, /* expression to refresh */
99   - Expr *already_refreshed) /* (($T . $n) ...) */
  99 + Expr *already_refreshed) /* (($T . $n) ...) */
100 100 {
101 101 /* assert(!is_unknown(expr)); */
102 102  
... ... @@ -105,26 +105,26 @@ Expr refresh(Expr expr, /* expression to refresh */
105 105 {
106 106 Expr replacement = assoc(expr,*already_refreshed);
107 107 if (replacement == key_not_found)
108   - {
109   - /* type variable not seen already */
110   - Expr result = fresh_unknown();
111   - *already_refreshed = cons(cons(expr,
112   - result),
113   - *already_refreshed);
114   - return result;
115   - }
  108 + {
  109 + /* type variable not seen already */
  110 + Expr result = fresh_unknown();
  111 + *already_refreshed = cons(cons(expr,
  112 + result),
  113 + *already_refreshed);
  114 + return result;
  115 + }
116 116 else
117   - {
118   - /* type variable already seen */
119   - return replacement;
120   - }
  117 + {
  118 + /* type variable already seen */
  119 + return replacement;
  120 + }
121 121 }
122 122  
123 123 if (consp(expr))
124 124 {
125 125 /* pairs */
126 126 return cons(refresh(car(expr),already_refreshed),
127   - refresh(cdr(expr),already_refreshed));
  127 + refresh(cdr(expr),already_refreshed));
128 128 }
129 129 else
130 130 {
... ... @@ -142,7 +142,7 @@ Expr merge_envs(Expr e1, Expr e2)
142 142 {
143 143 if (is_key_of(e2,car(car(e1))))
144 144 {
145   - if (!equal(cdr(car(e1)),assoc(car(car(e1)),e2)))
  145 + if (!equal(cdr(car(e1)),assoc(car(car(e1)),e2)))
146 146 {
147 147 return not_unifiable; /* cannot merge */
148 148 debug(e1);
... ... @@ -151,7 +151,7 @@ Expr merge_envs(Expr e1, Expr e2)
151 151 }
152 152 }
153 153 else
154   - e2 = cons(car(e1),e2);
  154 + e2 = cons(car(e1),e2);
155 155 e1 = cdr(e1);
156 156 }
157 157 return e2;
... ...
anubis_dev/compiler/src/vminstr.c
  Show/Hide comments   View file @e69a754
... ... @@ -175,10 +175,10 @@ int instruction_size(Expr instr, int offset)
175 175 case context:
176 176 case code_for:
177 177 case type_list:
178   - return 0;
  178 + return 0;
179 179  
180 180 case ret:
181   - return 1;
  181 + return 1;
182 182  
183 183 case glue_index:
184 184 case glue:
... ... @@ -211,7 +211,7 @@ int instruction_size(Expr instr, int offset)
211 211 case indirect_del_struct_ptr:
212 212 case mvar_slots_del_struct_ptr:
213 213 case apply:
214   - return 2;
  214 + return 2;
215 215  
216 216 case unglue:
217 217 case unstore_copy_mixed:
... ... @@ -219,15 +219,15 @@ int instruction_size(Expr instr, int offset)
219 219 case put_copy_direct:
220 220 case put_copy_indirect:
221 221 case put_copy_function:
222   - return 3;
  222 + return 3;
223 223  
224 224 case put_copy_mixed:
225 225 case put_micro_copy_direct:
226 226 case put_micro_copy_indirect:
227 227 case put_micro_copy_function:
228   - return 4;
  228 + return 4;
229 229  
230   - // case load:
  230 + // case load:
231 231 case put_micro_copy_mixed:
232 232 case load_int32:
233 233 case peek:
... ... @@ -269,7 +269,7 @@ int instruction_size(Expr instr, int offset)
269 269 case mvar_slots_del:
270 270 case mvar_slots_del_mvar:
271 271 case mvar_slots_del_var:
272   - return 5;
  272 + return 5;
273 273  
274 274 case indirect_del_mixed:
275 275 case del_mixed:
... ... @@ -279,11 +279,11 @@ int instruction_size(Expr instr, int offset)
279 279 case type_mixed:
280 280 case indirect_type_mixed:
281 281 case del_stack_struct_ptr:
282   - return 6;
  282 + return 6;
283 283  
284 284 case select_index_direct:
285 285 case jmp_neq_indexes_mixed:
286   - return 7;
  286 + return 7;
287 287  
288 288 case del_stack:
289 289 case load_float:
... ... @@ -291,20 +291,20 @@ int instruction_size(Expr instr, int offset)
291 291 case del_stack_mvar:
292 292 case micro_peek:
293 293 case put_closure_labels:
294   - return 9;
  294 + return 9;
295 295  
296 296 case del_stack_mixed:
297   - return 10;
  297 + return 10;
298 298  
299 299 case load_module:
300 300 return 1+4+length(cdr(instr));
301 301  
302 302 case _switch:
303 303 case type_large_switch:
304   - return 2 + 4*length(cdr(instr));
  304 + return 2 + 4*length(cdr(instr));
305 305  
306 306 case type_mixed_switch:
307   - return 3 + 4*length(cdr2(instr));
  307 + return 3 + 4*length(cdr2(instr));
308 308  
309 309 case type_small_alt: /* (type_small_alt n_1 ... n_k) ==> 1+4+k */
310 310 case type_8:
... ... @@ -316,7 +316,7 @@ int instruction_size(Expr instr, int offset)
316 316 return 1+4+length(cdr(instr));
317 317  
318 318 case string:
319   - return 1+4+4+strlen(string_content(compiled_strings[integer_value(cdr(instr))].string))+1;
  319 + return 1+4+4+strlen(string_content(compiled_strings[integer_value(cdr(instr))].string))+1;
320 320  
321 321 case program:
322 322 {
... ... @@ -445,13 +445,13 @@ int instruction_size(Expr instr, int offset)
445 445 case get_file_mode:
446 446 case set_file_mode:
447 447 case alt_number_indirect:
448   - return 1;
  448 + return 1;
449 449  
450 450 case protect:
451 451 return 2;
452 452  
453 453 case location:
454   - return 4;
  454 + return 4;
455 455  
456 456 case initialization_address:
457 457 case variables_deletion_address:
... ... @@ -484,391 +484,391 @@ void translate_instruction(U8 **ptr,
484 484 case context:
485 485 case code_for:
486 486 case type_list:
487   - break;
  487 + break;
488 488  
489 489 case apply: /* (apply . k) */
490   - *((*ptr)++) = i_apply;
491   - *((*ptr)++) = (U8)(integer_value(cdr(instr)));
492   - break;
  490 + *((*ptr)++) = i_apply;
  491 + *((*ptr)++) = (U8)(integer_value(cdr(instr)));
  492 + break;
493 493  
494 494 case ret:
495   - *((*ptr)++) = i_ret;
496   - break;
  495 + *((*ptr)++) = i_ret;
  496 + break;
497 497  
498 498 case copy_stack_ptr: /* (copy_stack_ptr . <depth>) */
499 499 *((*ptr)++) = i_copy_stack_ptr;
500   - *((*ptr)++) = integer_value(cdr(instr));
501   - break;
  500 + *((*ptr)++) = integer_value(cdr(instr));
  501 + break;
502 502  
503 503 case copy_stack_function: /* (copy_stack_function . <depth>) */
504 504 *((*ptr)++) = i_copy_stack_function;
505   - *((*ptr)++) = integer_value(cdr(instr));
506   - break;
  505 + *((*ptr)++) = integer_value(cdr(instr));
  506 + break;
507 507  
508 508 case mixed_alt_begin: /* (mixed_alt_begin . <byte width>) */
509 509 *((*ptr)++) = i_mixed_alt_begin;
510   - *((*ptr)++) = integer_value(cdr(instr));
511   - break;
  510 + *((*ptr)++) = integer_value(cdr(instr));
  511 + break;
512 512  
513 513 case large_alt_begin: /* (large_alt_begin . <byte width>) */
514 514 *((*ptr)++) = i_large_alt_begin;
515   - *((*ptr)++) = integer_value(cdr(instr));
516   - break;
  515 + *((*ptr)++) = integer_value(cdr(instr));
  516 + break;
517 517  
518 518 case mixed_alt_end: /* (mixed_alt_end . <index>) */
519 519 *((*ptr)++) = i_mixed_alt_end;
520   - *((*ptr)++) = integer_value(cdr(instr));
521   - break;
  520 + *((*ptr)++) = integer_value(cdr(instr));
  521 + break;
522 522  
523 523 case large_alt_end: /* (large_alt_end . <index>) */
524 524 *((*ptr)++) = i_large_alt_end;
525   - *((*ptr)++) = integer_value(cdr(instr));
526   - break;
  525 + *((*ptr)++) = integer_value(cdr(instr));
  526 + break;
527 527  
528 528 case revert_to_computing: /* (revert_to_computing . <type width>) */
529   - *((*ptr)++) = i_revert_to_computing;
530   - *((*ptr)++) = integer_value(cdr(instr));
531   - break;
  529 + *((*ptr)++) = i_revert_to_computing;
  530 + *((*ptr)++) = integer_value(cdr(instr));
  531 + break;
532 532  
533 533 case success: /* (success . <type width>) */
534   - *((*ptr)++) = i_success;
535   - *((*ptr)++) = integer_value(cdr(instr));
536   - break;
  534 + *((*ptr)++) = i_success;
  535 + *((*ptr)++) = integer_value(cdr(instr));
  536 + break;
537 537  
538 538 case glue_index: /* (glue_index . i) */
539   - *((*ptr)++) = i_glue_index;
540   - *((*ptr)++) = integer_value(cdr(instr));
541   - break;
  539 + *((*ptr)++) = i_glue_index;
  540 + *((*ptr)++) = integer_value(cdr(instr));
  541 + break;
542 542  
543 543 case glue: /* (glue_inline . bw) */
544   - *((*ptr)++) = i_glue;
545   - *((*ptr)++) = integer_value(cdr(instr));
546   - break;
  544 + *((*ptr)++) = i_glue;
  545 + *((*ptr)++) = integer_value(cdr(instr));
  546 + break;
547 547  
548 548 case store_index: /* (store_index . i) */
549   - *((*ptr)++) = i_store_index;
550   - *((*ptr)++) = integer_value(cdr(instr));
551   - break;
  549 + *((*ptr)++) = i_store_index;
  550 + *((*ptr)++) = integer_value(cdr(instr));
  551 + break;
552 552  
553 553 case store_0:
554   - *((*ptr)++) = i_store_0;
555   - *((*ptr)++) = integer_value(cdr(instr));
556   - break;
  554 + *((*ptr)++) = i_store_0;
  555 + *((*ptr)++) = integer_value(cdr(instr));
  556 + break;
557 557  
558 558 case store_1:
559   - *((*ptr)++) = i_store_1;
560   - *((*ptr)++) = integer_value(cdr(instr));
561   - break;
  559 + *((*ptr)++) = i_store_1;
  560 + *((*ptr)++) = integer_value(cdr(instr));
  561 + break;
562 562  
563 563 case store_2:
564   - *((*ptr)++) = i_store_2;
565   - *((*ptr)++) = integer_value(cdr(instr));
566   - break;
  564 + *((*ptr)++) = i_store_2;
  565 + *((*ptr)++) = integer_value(cdr(instr));
  566 + break;
567 567  
568 568 case store_4:
569   - *((*ptr)++) = i_store_4;
570   - *((*ptr)++) = integer_value(cdr(instr));
571   - break;
  569 + *((*ptr)++) = i_store_4;
  570 + *((*ptr)++) = integer_value(cdr(instr));
  571 + break;
572 572  
573 573 case glue_mixed_index: /* (glue_mixed_index . i) */
574   - *((*ptr)++) = i_glue_mixed_index;
575   - *((*ptr)++) = integer_value(cdr(instr));
576   - break;
  574 + *((*ptr)++) = i_glue_mixed_index;
  575 + *((*ptr)++) = integer_value(cdr(instr));
  576 + break;
577 577  
578 578 case index_direct: /* (index_direct . <bit width>) */
579   - *((*ptr)++) = i_index_direct;
580   - *((*ptr)++) = integer_value(cdr(instr));
581   - break;
  579 + *((*ptr)++) = i_index_direct;
  580 + *((*ptr)++) = integer_value(cdr(instr));
  581 + break;
582 582  
583 583 case alt_number_direct: /* (alt_number_direct . <bit width>) */
584   - *((*ptr)++) = i_alt_number_direct;
585   - *((*ptr)++) = integer_value(cdr(instr));
586   - break;
  584 + *((*ptr)++) = i_alt_number_direct;
  585 + *((*ptr)++) = integer_value(cdr(instr));
  586 + break;
587 587  
588 588 case increment_del: /* (increment_del . <byte width>) */
589   - *((*ptr)++) = i_increment_del;
590   - *((*ptr)++) = integer_value(cdr(instr));
591   - break;
  589 + *((*ptr)++) = i_increment_del;
  590 + *((*ptr)++) = integer_value(cdr(instr));
  591 + break;
592 592  
593 593 case increment_eq: /* (increment_eq . <byte width>) */
594   - *((*ptr)++) = i_increment_eq;
595   - *((*ptr)++) = integer_value(cdr(instr));
596   - break;
  594 + *((*ptr)++) = i_increment_eq;
  595 + *((*ptr)++) = integer_value(cdr(instr));
  596 + break;
597 597  
598 598 case unglue: /* (unglue <bit width> . <right shift>) */
599   - *((*ptr)++) = i_unglue;
600   - *((*ptr)++) = integer_value(second(instr));
601   - *((*ptr)++) = integer_value(cdr2(instr));
602   - break;
  599 + *((*ptr)++) = i_unglue;
  600 + *((*ptr)++) = integer_value(second(instr));
  601 + *((*ptr)++) = integer_value(cdr2(instr));
  602 + break;
603 603  
604 604 case unstore: /* (unstore <offset> . [1|2|4]) -->
605 605 unstore_? <offset> */
606   - {
607   - int i = integer_value(cdr2(instr));
608   - int i_code = i == 0 ? i_unstore_0 : i == 1 ? i_unstore_1 : i == 2 ? i_unstore_2 : i_unstore_4;
609   - *((*ptr)++) = i_code;
610   - *((*ptr)++) = integer_value(second(instr));
611   - }
612   - break;
  606 + {
  607 + int i = integer_value(cdr2(instr));
  608 + int i_code = i == 0 ? i_unstore_0 : i == 1 ? i_unstore_1 : i == 2 ? i_unstore_2 : i_unstore_4;
  609 + *((*ptr)++) = i_code;
  610 + *((*ptr)++) = integer_value(second(instr));
  611 + }
  612 + break;
613 613  
614 614  
615 615 case unstore_copy: /* (unstore_copy . <offset>) */
616   - *((*ptr)++) = i_unstore_copy;
617   - *((*ptr)++) = integer_value(cdr(instr));
618   - break;
  616 + *((*ptr)++) = i_unstore_copy;
  617 + *((*ptr)++) = integer_value(cdr(instr));
  618 + break;
619 619  
620 620 case unstore_copy_mixed: /* (unstore_copy_mixed <offset> . <mask>) */
621   - *((*ptr)++) = i_unstore_copy_mixed;
622   - *((*ptr)++) = integer_value(second(instr));
623   - *((*ptr)++) = integer_value(cdr2(instr));
624   - break;
  621 + *((*ptr)++) = i_unstore_copy_mixed;
  622 + *((*ptr)++) = integer_value(second(instr));
  623 + *((*ptr)++) = integer_value(cdr2(instr));
  624 + break;
625 625  
626 626 case copy_stack_mixed: /* (copy_stack_mixed <depth> . <mask>) */
627   - *((*ptr)++) = i_copy_stack_mixed;
628   - *((*ptr)++) = integer_value(second(instr));
629   - *((*ptr)++) = integer_value(cdr2(instr));
630   - break;
  627 + *((*ptr)++) = i_copy_stack_mixed;
  628 + *((*ptr)++) = integer_value(second(instr));
  629 + *((*ptr)++) = integer_value(cdr2(instr));
  630 + break;
631 631  
632 632 case put_copy_direct: /* (put_copy_direct <depth> . <pos>) */
633   - *((*ptr)++) = i_put_copy_direct;
634   - *((*ptr)++) = integer_value(second(instr));
635   - *((*ptr)++) = integer_value(cdr2(instr));
636   - break;
  633 + *((*ptr)++) = i_put_copy_direct;
  634 + *((*ptr)++) = integer_value(second(instr));
  635 + *((*ptr)++) = integer_value(cdr2(instr));
  636 + break;
637 637  
638 638 case put_copy_indirect: /* (put_copy_indirect <depth> . <pos>) */
639   - *((*ptr)++) = i_put_copy_indirect;
640   - *((*ptr)++) = integer_value(second(instr));
641   - *((*ptr)++) = integer_value(cdr2(instr));
642   - break;
  639 + *((*ptr)++) = i_put_copy_indirect;
  640 + *((*ptr)++) = integer_value(second(instr));
  641 + *((*ptr)++) = integer_value(cdr2(instr));
  642 + break;
643 643  
644 644 case put_copy_function: /* (put_copy_function <depth> . <pos>) */
645   - *((*ptr)++) = i_put_copy_function;
646   - *((*ptr)++) = integer_value(second(instr));
647   - *((*ptr)++) = integer_value(cdr2(instr));
648   - break;
  645 + *((*ptr)++) = i_put_copy_function;
  646 + *((*ptr)++) = integer_value(second(instr));
  647 + *((*ptr)++) = integer_value(cdr2(instr));
  648 + break;
649 649  
650 650 case put_copy_mixed: /* (put_copy_mixed <mask> <depth> . <pos>) */
651   - *((*ptr)++) = i_put_copy_mixed;
652   - *((*ptr)++) = integer_value(second(instr));
653   - *((*ptr)++) = integer_value(third(instr));
654   - *((*ptr)++) = integer_value(cdr3(instr));
655   - break;
  651 + *((*ptr)++) = i_put_copy_mixed;
  652 + *((*ptr)++) = integer_value(second(instr));
  653 + *((*ptr)++) = integer_value(third(instr));
  654 + *((*ptr)++) = integer_value(cdr3(instr));
  655 + break;
656 656  
657 657 case put_micro_copy_direct: /* (put_micro_copy_direct <depth> <micro depth> . <pos>) */
658   - *((*ptr)++) = i_put_micro_copy_direct;
659   - *((*ptr)++) = integer_value(second(instr));
660   - *((*ptr)++) = integer_value(third(instr));
661   - *((*ptr)++) = integer_value(cdr3(instr));
662   - break;
  658 + *((*ptr)++) = i_put_micro_copy_direct;
  659 + *((*ptr)++) = integer_value(second(instr));
  660 + *((*ptr)++) = integer_value(third(instr));
  661 + *((*ptr)++) = integer_value(cdr3(instr));
  662 + break;
663 663  
664 664 case put_micro_copy_indirect: /* (put_micro_copy_indirect <depth> <micro depth> . <pos>) */
665   - *((*ptr)++) = i_put_micro_copy_indirect;
666   - *((*ptr)++) = integer_value(second(instr));
667   - *((*ptr)++) = integer_value(third(instr));
668   - *((*ptr)++) = integer_value(cdr3(instr));
669   - break;
  665 + *((*ptr)++) = i_put_micro_copy_indirect;
  666 + *((*ptr)++) = integer_value(second(instr));
  667 + *((*ptr)++) = integer_value(third(instr));
  668 + *((*ptr)++) = integer_value(cdr3(instr));
  669 + break;
670 670  
671 671 case put_micro_copy_function: /* (put_micro_copy_function <depth> <micro_depth> . <pos>) */
672   - *((*ptr)++) = i_put_micro_copy_function;
673   - *((*ptr)++) = integer_value(second(instr));
674   - *((*ptr)++) = integer_value(third(instr));
675   - *((*ptr)++) = integer_value(cdr3(instr));
676   - break;
  672 + *((*ptr)++) = i_put_micro_copy_function;
  673 + *((*ptr)++) = integer_value(second(instr));
  674 + *((*ptr)++) = integer_value(third(instr));
  675 + *((*ptr)++) = integer_value(cdr3(instr));
  676 + break;
677 677  
678 678 case put_micro_copy_mixed: /* (put_micro_copy_mixed <mask> <depth> <micro depth> . <pos>) */
679   - *((*ptr)++) = i_put_micro_copy_mixed;
680   - *((*ptr)++) = integer_value(second(instr));
681   - *((*ptr)++) = integer_value(third(instr));
682   - *((*ptr)++) = integer_value(forth(instr));
683   - *((*ptr)++) = integer_value(cdr4(instr));
684   - break;
  679 + *((*ptr)++) = i_put_micro_copy_mixed;
  680 + *((*ptr)++) = integer_value(second(instr));
  681 + *((*ptr)++) = integer_value(third(instr));
  682 + *((*ptr)++) = integer_value(forth(instr));
  683 + *((*ptr)++) = integer_value(cdr4(instr));
  684 + break;
685 685  
686 686 case unstore_copy_ptr: /* (unstore_copy_ptr . <offset>) */
687   - *((*ptr)++) = i_unstore_copy_ptr;
688   - *((*ptr)++) = integer_value(cdr(instr));
689   - break;
  687 + *((*ptr)++) = i_unstore_copy_ptr;
  688 + *((*ptr)++) = integer_value(cdr(instr));
  689 + break;
690 690  
691 691 case unstore_copy_function: /* (unstore_copy_function . <offset>) */
692   - *((*ptr)++) = i_unstore_copy_function;
693   - *((*ptr)++) = integer_value(cdr(instr));
694   - break;
  692 + *((*ptr)++) = i_unstore_copy_function;
  693 + *((*ptr)++) = integer_value(cdr(instr));
  694 + break;
695 695  
696 696 case alloc: /* (alloc . <num bytes>) -->
697 697 i_alloc <num words>-2 */
698   - {
699   - int i = integer_value(cdr(instr));
700   - if ((i & 3) == 0) i--;
701   - i = (i>>2) - 1; /* <num words>-2 */
702   - *((*ptr)++) = i_alloc;
703   - *((*ptr)++) = (U8)i;
704   - }
705   - break;
  698 + {
  699 + int i = integer_value(cdr(instr));
  700 + if ((i & 3) == 0) i--;
  701 + i = (i>>2) - 1; /* <num words>-2 */
  702 + *((*ptr)++) = i_alloc;
  703 + *((*ptr)++) = (U8)i;
  704 + }
  705 + break;
706 706  
707 707  
708 708 #ifdef never_defined
709 709 case load: /* (load . <address>) */
710   - *((*ptr)++) = i_load;
711   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
712   - break;
  710 + *((*ptr)++) = i_load;
  711 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  712 + break;
713 713 #endif
714 714  
715 715 case load_int32: /* (load_int32 . <Cint>) */
716   - *((*ptr)++) = i_load_int32;
717   - *(((U32 *)(*ptr))++) = cdr(instr); /* this is a <Cint> */
718   - break;
  716 + *((*ptr)++) = i_load_int32;
  717 + *(((U32 *)(*ptr))++) = cdr(instr); /* this is a <Cint> */
  718 + break;
719 719  
720 720 case check_stack: /* (check_stack . n) */
721 721 *((*ptr)++) = i_check_stack;
722   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
723   - break;
  722 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  723 + break;
724 724  
725 725 case push_addr: /* (push_addr . a) */
726 726 *((*ptr)++) = i_push_addr;
727   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
728   - break;
  727 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  728 + break;
729 729  
730 730 case select_index_direct: /* (select_index_direct bw index . addr) */
731   - *((*ptr)++) = i_select_index_direct;
732   - *((*ptr)++) = (U8)(integer_value(second(instr)));
733   - *((*ptr)++) = (U8)(integer_value(third(instr)));
734   - *(((U32 *)(*ptr))++) = (U32)(offsets[integer_value(cdr3(instr))]);
735   - break;
  731 + *((*ptr)++) = i_select_index_direct;
  732 + *((*ptr)++) = (U8)(integer_value(second(instr)));
  733 + *((*ptr)++) = (U8)(integer_value(third(instr)));
  734 + *(((U32 *)(*ptr))++) = (U32)(offsets[integer_value(cdr3(instr))]);
  735 + break;
736 736  
737 737 case select_index_indirect: /* (select_index_direct index . addr) */
738   - *((*ptr)++) = i_select_index_indirect;
739   - *((*ptr)++) = (U8)(integer_value(second(instr)));
740   - *(((U32 *)(*ptr))++) = (U32)(offsets[integer_value(cdr2(instr))]);
741   - break;
  738 + *((*ptr)++) = i_select_index_indirect;
  739 + *((*ptr)++) = (U8)(integer_value(second(instr)));
  740 + *(((U32 *)(*ptr))++) = (U32)(offsets[integer_value(cdr2(instr))]);
  741 + break;
742 742  
743   - /* the following may cause a problem because floats are perhaps
  743 + /* the following may cause a problem because floats are perhaps
744 744 not portable */
745 745 case load_float: /* (load_float <int32 mantissa> . <int32 exponent>) */
746   - *((*ptr)++) = i_load_float;
747   - *(((U32 *)(*ptr))++) = integer_value(second(instr)); /* mantissa (always positive) */
748   - *(((U32 *)(*ptr))++) = integer_value(cdr2(instr)); /* exponent (signed) */
749   - break;
  746 + *((*ptr)++) = i_load_float;
  747 + *(((U32 *)(*ptr))++) = integer_value(second(instr)); /* mantissa (always positive) */
  748 + *(((U32 *)(*ptr))++) = integer_value(cdr2(instr)); /* exponent (signed) */
  749 + break;
750 750  
751 751 case collapse:
752   - *((*ptr)++) = i_collapse;
753   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
754   - break;
  752 + *((*ptr)++) = i_collapse;
  753 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  754 + break;
755 755  
756 756 case create_vars: /* (create_vars . <number of variables>) */
757   - *((*ptr)++) = i_create_vars;
758   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
759   - break;
  757 + *((*ptr)++) = i_create_vars;
  758 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  759 + break;
760 760  
761 761 case copy_mixed:
762   - *((*ptr)++) = i_copy_mixed;
763   - *((*ptr)++) = integer_value(cdr(instr));
764   - break;
  762 + *((*ptr)++) = i_copy_mixed;
  763 + *((*ptr)++) = integer_value(cdr(instr));
  764 + break;
765 765  
766 766 case vcopy_mixed:
767   - *((*ptr)++) = i_vcopy_mixed;
768   - *((*ptr)++) = integer_value(cdr(instr));
769   - break;
  767 + *((*ptr)++) = i_vcopy_mixed;
  768 + *((*ptr)++) = integer_value(cdr(instr));
  769 + break;
770 770  
771 771 case type_small_alt: /* (type_small_alt n1 ... n_k) -> i_type_small_alt (U32)k n1 ... nk */
772   - *((*ptr)++) = i_type_small_alt;
773   - *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
  772 + *((*ptr)++) = i_type_small_alt;
  773 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
774 774 {
775 775 aux = cdr(instr);
776 776 while (consp(aux))
777 777 {
778   - *((*ptr)++) = (U8)integer_value(car(aux));
  778 + *((*ptr)++) = (U8)integer_value(car(aux));
779 779 aux = cdr(aux);
780 780 }
781 781 }
782 782 break;
783 783  
784 784 case type_8: /* idem */
785   - *((*ptr)++) = i_type_8;
786   - *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
  785 + *((*ptr)++) = i_type_8;
  786 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
787 787 //debug(instr);
788 788 {
789 789 aux = cdr(instr);
790 790 while (consp(aux))
791 791 {
792   - *((*ptr)++) = (U8)integer_value(car(aux));
  792 + *((*ptr)++) = (U8)integer_value(car(aux));
793 793 aux = cdr(aux);
794 794 }
795 795 }
796 796 break;
797 797  
798 798 case type_16: /* idem */
799   - *((*ptr)++) = i_type_16;
800   - *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
  799 + *((*ptr)++) = i_type_16;
  800 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
801 801 {
802 802 aux = cdr(instr);
803 803 while (consp(aux))
804 804 {
805   - *((*ptr)++) = (U8)integer_value(car(aux));
  805 + *((*ptr)++) = (U8)integer_value(car(aux));
806 806 aux = cdr(aux);
807 807 }
808 808 }
809 809 break;
810 810  
811 811 case type_32: /* idem */
812   - *((*ptr)++) = i_type_32;
813   - *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
  812 + *((*ptr)++) = i_type_32;
  813 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
814 814 {
815 815 aux = cdr(instr);
816 816 while (consp(aux))
817 817 {
818   - *((*ptr)++) = (U8)integer_value(car(aux));
  818 + *((*ptr)++) = (U8)integer_value(car(aux));
819 819 aux = cdr(aux);
820 820 }
821 821 }
822 822 break;
823 823  
824 824 case indirect_type_8: /* idem */
825   - *((*ptr)++) = i_indirect_type_8;
826   - *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
  825 + *((*ptr)++) = i_indirect_type_8;
  826 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
827 827 {
828 828 aux = cdr(instr);
829 829 while (consp(aux))
830 830 {
831   - *((*ptr)++) = (U8)integer_value(car(aux));
  831 + *((*ptr)++) = (U8)integer_value(car(aux));
832 832 aux = cdr(aux);
833 833 }
834 834 }
835 835 break;
836 836  
837 837 case indirect_type_16: /* idem */
838   - *((*ptr)++) = i_indirect_type_16;
839   - *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
  838 + *((*ptr)++) = i_indirect_type_16;
  839 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
840 840 {
841 841 aux = cdr(instr);
842 842 while (consp(aux))
843 843 {
844   - *((*ptr)++) = (U8)integer_value(car(aux));
  844 + *((*ptr)++) = (U8)integer_value(car(aux));
845 845 aux = cdr(aux);
846 846 }
847 847 }
848 848 break;
849 849  
850 850 case indirect_type_32: /* idem */
851   - *((*ptr)++) = i_indirect_type_32;
852   - *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
  851 + *((*ptr)++) = i_indirect_type_32;
  852 + *(((U32 *)(*ptr))++) = (U32)length(cdr(instr));
853 853 {
854 854 aux = cdr(instr);
855 855 while (consp(aux))
856 856 {
857   - *((*ptr)++) = (U8)integer_value(car(aux));
  857 + *((*ptr)++) = (U8)integer_value(car(aux));
858 858 aux = cdr(aux);
859 859 }
860 860 }
861 861 break;
862 862  
863 863 case string: /* (string . <index>) */
864   - *((*ptr)++) = i_string;
865   - *(((U32 *)(*ptr))++) = len =
  864 + *((*ptr)++) = i_string;
  865 + *(((U32 *)(*ptr))++) = len =
866 866 strlen(string_content(compiled_strings[integer_value(cdr(instr))].string));
867 867 *(((U32 *)(*ptr))++) = 0; /* null counter => permanent string */
868   - for (i = 0; i < len; i++)
869   - *((*ptr)++) = 172^((string_content(compiled_strings[integer_value(cdr(instr))].string))[i]);
870   - *((*ptr)++) = 172;
871   - break;
  868 + for (i = 0; i < len; i++)
  869 + *((*ptr)++) = 172^((string_content(compiled_strings[integer_value(cdr(instr))].string))[i]);
  870 + *((*ptr)++) = 172;
  871 + break;
872 872  
873 873 case program: /* (program instruction ... instruction) */
874 874 {
... ... @@ -883,331 +883,331 @@ void translate_instruction(U8 **ptr,
883 883 break;
884 884  
885 885 case address: /* (address . <address>) */
886   - *((*ptr)++) = i_address;
887   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
888   - break;
  886 + *((*ptr)++) = i_address;
  887 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  888 + break;
889 889  
890 890 case gv_address: /* (gv_address . <index>) */
891   - *((*ptr)++) = i_gv_address;
892   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
893   - break;
  891 + *((*ptr)++) = i_gv_address;
  892 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  893 + break;
894 894  
895 895 case call: /* (call <address> . <n>) */
896   - *((*ptr)++) = i_call;
897   - *(((U32 *)(*ptr))++) = offsets[integer_value(second(instr))];
898   - break;
  896 + *((*ptr)++) = i_call;
  897 + *(((U32 *)(*ptr))++) = offsets[integer_value(second(instr))];
  898 + break;
899 899  
900 900 case indirect_del: /* (indirect_del . <address>) */
901   - *((*ptr)++) = i_indirect_del;
902   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
903   - break;
  901 + *((*ptr)++) = i_indirect_del;
  902 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  903 + break;
904 904  
905 905 case indirect_del_mvar: /* (indirect_del_mvar . <address>) */
906   - *((*ptr)++) = i_indirect_del_mvar;
907   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
908   - break;
  906 + *((*ptr)++) = i_indirect_del_mvar;
  907 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  908 + break;
909 909  
910 910 case del_mixed: /* (del_mixed <mask> . <address>) */
911   - *((*ptr)++) = i_del_mixed;
912   - *((*ptr)++) = integer_value(second(instr));
913   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
914   - break;
  911 + *((*ptr)++) = i_del_mixed;
  912 + *((*ptr)++) = integer_value(second(instr));
  913 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  914 + break;
915 915  
916 916 case mvar_slots_del_mixed: /* (mvar_slots_del_mixed <mask> . <address>) */
917   - *((*ptr)++) = i_mvar_slots_del_mixed;
918   - *((*ptr)++) = integer_value(second(instr));
919   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
920   - break;
  917 + *((*ptr)++) = i_mvar_slots_del_mixed;
  918 + *((*ptr)++) = integer_value(second(instr));
  919 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  920 + break;
921 921  
922 922 case type_mixed: /* (type_mixed <mask> . <address>) */
923   - *((*ptr)++) = i_type_mixed;
924   - *((*ptr)++) = integer_value(second(instr));
925   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
926   - break;
  923 + *((*ptr)++) = i_type_mixed;
  924 + *((*ptr)++) = integer_value(second(instr));
  925 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  926 + break;
927 927  
928 928 case indirect_type_mixed: /* (indirect_type_mixed <mask> . <address>) */
929   - *((*ptr)++) = i_indirect_type_mixed;
930   - *((*ptr)++) = integer_value(second(instr));
931   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
932   - break;
  929 + *((*ptr)++) = i_indirect_type_mixed;
  930 + *((*ptr)++) = integer_value(second(instr));
  931 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  932 + break;
933 933  
934 934 case indirect_del_mixed: /* (indirect_del_mixed <mask> . <address>) */
935   - *((*ptr)++) = i_indirect_del_mixed;
936   - *((*ptr)++) = integer_value(second(instr));
937   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
938   - break;
  935 + *((*ptr)++) = i_indirect_del_mixed;
  936 + *((*ptr)++) = integer_value(second(instr));
  937 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  938 + break;
939 939  
940 940 case indirect_del_struct_ptr: /* (indirect_del_struct_ptr . <struct id>) */
941   - *((*ptr)++) = i_indirect_del_struct_ptr;
942   - *((*ptr)++) = integer_value(cdr(instr));
943   - break;
  941 + *((*ptr)++) = i_indirect_del_struct_ptr;
  942 + *((*ptr)++) = integer_value(cdr(instr));
  943 + break;
944 944  
945 945 case mvar_slots_del_struct_ptr: /* (mvar_slots_del_struct_ptr . <struct id>) */
946   - *((*ptr)++) = i_mvar_slots_del_struct_ptr;
947   - *((*ptr)++) = integer_value(cdr(instr));
948   - break;
  946 + *((*ptr)++) = i_mvar_slots_del_struct_ptr;
  947 + *((*ptr)++) = integer_value(cdr(instr));
  948 + break;
949 949  
950 950 case jmp: /* (jmp . <address>) */
951   - *((*ptr)++) = i_jmp;
952   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
953   - break;
  951 + *((*ptr)++) = i_jmp;
  952 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  953 + break;
954 954  
955 955 case false_jmp: /* (false_jmp . <address>) */
956   - *((*ptr)++) = i_false_jmp;
957   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
958   - break;
  956 + *((*ptr)++) = i_false_jmp;
  957 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  958 + break;
959 959  
960 960 case jmp_false: /* (jmp_false . <address>) */
961   - *((*ptr)++) = i_jmp_false;
962   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
963   - break;
  961 + *((*ptr)++) = i_jmp_false;
  962 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  963 + break;
964 964  
965 965 case true_jmp: /* (true_jmp . <address>) */
966   - *((*ptr)++) = i_true_jmp;
967   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
968   - break;
  966 + *((*ptr)++) = i_true_jmp;
  967 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  968 + break;
969 969  
970 970 case jmp_eq_stack: /* (jmp_eq_stack . <address>) */
971   - *((*ptr)++) = i_jmp_eq_stack;
972   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
973   - break;
  971 + *((*ptr)++) = i_jmp_eq_stack;
  972 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  973 + break;
974 974  
975 975 case jmp_neq_indexes_large: /* (jmp_neq_indexes_large . <address>) */
976   - *((*ptr)++) = i_jmp_neq_indexes_large;
977   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
978   - break;
  976 + *((*ptr)++) = i_jmp_neq_indexes_large;
  977 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  978 + break;
979 979  
980 980 case jmp_neq_string: /* (jmp_neq_string . <address>) */
981   - *((*ptr)++) = i_jmp_neq_string;
982   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
983   - break;
  981 + *((*ptr)++) = i_jmp_neq_string;
  982 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  983 + break;
984 984  
985 985 case jmp_neq_byte_array: /* (jmp_neq_byte_array . <address>) */
986   - *((*ptr)++) = i_jmp_neq_byte_array;
987   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
988   - break;
  986 + *((*ptr)++) = i_jmp_neq_byte_array;
  987 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  988 + break;
989 989  
990 990 case jmp_neq_indexes_mixed: /* (jmp_neq_indexes_mixed <width> <mask> . <address>) */
991   - *((*ptr)++) = i_jmp_neq_indexes_mixed;
992   - *((*ptr)++) = (U8)integer_value(second(instr));
993   - *((*ptr)++) = (U8)integer_value(third(instr));
994   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr3(instr))];
995   - break;
  991 + *((*ptr)++) = i_jmp_neq_indexes_mixed;
  992 + *((*ptr)++) = (U8)integer_value(second(instr));
  993 + *((*ptr)++) = (U8)integer_value(third(instr));
  994 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr3(instr))];
  995 + break;
996 996  
997 997 case jmp_neq: /* (jmp_neq <byte width> . <address>)
998 998 i_jmp_neq_? <address> */
999   - {
1000   - int i = integer_value(second(instr));
1001   - Expr i_instr = i == 0 ? i_jmp_neq_0 :
  999 + {
  1000 + int i = integer_value(second(instr));
  1001 + Expr i_instr = i == 0 ? i_jmp_neq_0 :
1002 1002 i == 1 ? i_jmp_neq_1 :
1003 1003 i == 2 ? i_jmp_neq_2 :
1004 1004 i == 4 ? i_jmp_neq_4 :
1005 1005 (assert(0),0);
1006   - *((*ptr)++) = i_instr;
1007   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
1008   - }
1009   - break;
  1006 + *((*ptr)++) = i_instr;
  1007 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  1008 + }
  1009 + break;
1010 1010  
1011 1011 case peek: /* (peek x . k) */
1012   - *((*ptr)++) = i_peek;
1013   - *(((U32 *)(*ptr))++) = integer_value(cdr2(instr));
1014   - break;
  1012 + *((*ptr)++) = i_peek;
  1013 + *(((U32 *)(*ptr))++) = integer_value(cdr2(instr));
  1014 + break;
1015 1015  
1016 1016 case micro_peek: /* (micro_peek x d . k) */
1017   - *((*ptr)++) = i_micro_peek;
1018   - *(((U32 *)(*ptr))++) = integer_value(third(instr));
1019   - *(((U32 *)(*ptr))++) = integer_value(cdr3(instr));
1020   - break;
  1017 + *((*ptr)++) = i_micro_peek;
  1018 + *(((U32 *)(*ptr))++) = integer_value(third(instr));
  1019 + *(((U32 *)(*ptr))++) = integer_value(cdr3(instr));
  1020 + break;
1021 1021  
1022 1022 case put_closure_labels: /* (put_closure_labels f . d) */
1023   - *((*ptr)++) = i_put_closure_labels;
1024   - *(((U32 *)(*ptr))++) = offsets[integer_value(second(instr))];
1025   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
1026   - break;
  1023 + *((*ptr)++) = i_put_closure_labels;
  1024 + *(((U32 *)(*ptr))++) = offsets[integer_value(second(instr))];
  1025 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  1026 + break;
1027 1027  
1028 1028 case unprotect: /* (unprotect . <addr>) */
1029   - *((*ptr)++) = i_unprotect;
1030   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1031   - break;
  1029 + *((*ptr)++) = i_unprotect;
  1030 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1031 + break;
1032 1032  
1033 1033 case get_var_handler: /* (get_var_handler . <addr>) */
1034   - *((*ptr)++) = i_get_var_handler;
1035   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1036   - break;
  1034 + *((*ptr)++) = i_get_var_handler;
  1035 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1036 + break;
1037 1037  
1038 1038 case get_mvar_handler: /* (get_mvar_handler . <addr>) */
1039   - *((*ptr)++) = i_get_mvar_handler;
1040   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1041   - break;
  1039 + *((*ptr)++) = i_get_mvar_handler;
  1040 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1041 + break;
1042 1042  
1043 1043 case mvar_slots_del: /* (mvar_slots_del . <addr>) */
1044   - *((*ptr)++) = i_mvar_slots_del;
1045   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1046   - break;
  1044 + *((*ptr)++) = i_mvar_slots_del;
  1045 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1046 + break;
1047 1047  
1048 1048 case eq: /* (eq . k) */
1049   - *((*ptr)++) = i_eq;
1050   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
1051   - break;
  1049 + *((*ptr)++) = i_eq;
  1050 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  1051 + break;
1052 1052  
1053 1053 case print_string: /* (print_string . <depth>) */
1054   - *((*ptr)++) = i_print_string;
1055   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
1056   - break;
  1054 + *((*ptr)++) = i_print_string;
  1055 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  1056 + break;
1057 1057  
1058 1058 case del_stack_ptr: /* (del_stack_ptr . <depth>) */
1059   - *((*ptr)++) = i_del_stack_ptr;
1060   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
1061   - break;
  1059 + *((*ptr)++) = i_del_stack_ptr;
  1060 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  1061 + break;
1062 1062  
1063 1063 case del_stack_function: /* (del_stack_function . <depth>) */
1064   - *((*ptr)++) = i_del_stack_function;
1065   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
1066   - break;
  1064 + *((*ptr)++) = i_del_stack_function;
  1065 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  1066 + break;
1067 1067  
1068 1068 case del_stack_struct_ptr: /* (del_stack_struct_ptr <struct id> . <depth>) */
1069   - *((*ptr)++) = i_del_stack_struct_ptr;
  1069 + *((*ptr)++) = i_del_stack_struct_ptr;
1070 1070 *((*ptr)++) = integer_value(second(instr));
1071   - *(((U32 *)(*ptr))++) = integer_value(cdr2(instr));
1072   - break;
  1071 + *(((U32 *)(*ptr))++) = integer_value(cdr2(instr));
  1072 + break;
1073 1073  
1074 1074 case del_stack_conn: /* (del_stack_conn . <depth>) */
1075   - *((*ptr)++) = i_del_stack_conn;
1076   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
1077   - break;
  1075 + *((*ptr)++) = i_del_stack_conn;
  1076 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  1077 + break;
1078 1078  
1079 1079 case print_int32: /* (print_int32 . <depth>) */
1080   - *((*ptr)++) = i_print_int32;
1081   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
1082   - break;
  1080 + *((*ptr)++) = i_print_int32;
  1081 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  1082 + break;
1083 1083  
1084 1084 case del: /* (del . <addr>) */
1085   - *((*ptr)++) = i_del;
1086   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1087   - break;
  1085 + *((*ptr)++) = i_del;
  1086 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1087 + break;
1088 1088  
1089 1089 case mvar_slots_del_var: /* (mvar_slots_del_var . <addr>) */
1090   - *((*ptr)++) = i_mvar_slots_del_var;
1091   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1092   - break;
  1090 + *((*ptr)++) = i_mvar_slots_del_var;
  1091 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1092 + break;
1093 1093  
1094 1094 case mvar_slots_del_mvar: /* (mvar_slots_del_mvar . <addr>) */
1095   - *((*ptr)++) = i_mvar_slots_del_mvar;
1096   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1097   - break;
  1095 + *((*ptr)++) = i_mvar_slots_del_mvar;
  1096 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1097 + break;
1098 1098  
1099 1099 case del_stack: /* (del_stack <depth> . <addr>) */
1100   - *((*ptr)++) = i_del_stack;
1101   - *(((U32 *)(*ptr))++) = integer_value(second(instr));
1102   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
1103   - break;
  1100 + *((*ptr)++) = i_del_stack;
  1101 + *(((U32 *)(*ptr))++) = integer_value(second(instr));
  1102 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  1103 + break;
1104 1104  
1105 1105 case del_stack_mvar: /* (del_stack_mvar <depth> . <addr>) */
1106   - *((*ptr)++) = i_del_stack_mvar;
1107   - *(((U32 *)(*ptr))++) = integer_value(second(instr));
1108   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
1109   - break;
  1106 + *((*ptr)++) = i_del_stack_mvar;
  1107 + *(((U32 *)(*ptr))++) = integer_value(second(instr));
  1108 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  1109 + break;
1110 1110  
1111 1111 case del_stack_var: /* (del_stack_var <depth> . <addr>) */
1112   - *((*ptr)++) = i_del_stack_var;
1113   - *(((U32 *)(*ptr))++) = integer_value(second(instr));
1114   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
1115   - break;
  1112 + *((*ptr)++) = i_del_stack_var;
  1113 + *(((U32 *)(*ptr))++) = integer_value(second(instr));
  1114 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  1115 + break;
1116 1116  
1117 1117 case del_stack_mixed: /* (del_stack <depth> <mask> . <addr>) */
1118   - *((*ptr)++) = i_del_stack_mixed;
1119   - *(((U32 *)(*ptr))++) = integer_value(second(instr));
  1118 + *((*ptr)++) = i_del_stack_mixed;
  1119 + *(((U32 *)(*ptr))++) = integer_value(second(instr));
1120 1120 *((*ptr)++) = integer_value(third(instr));
1121   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr3(instr))];
1122   - break;
  1121 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr3(instr))];
  1122 + break;
1123 1123  
1124 1124 case init_gv: /* (init_gv . <index>) */
1125   - *((*ptr)++) = i_init_gv;
1126   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
1127   - break;
  1125 + *((*ptr)++) = i_init_gv;
  1126 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  1127 + break;
1128 1128  
1129 1129 case serialize: /* (serialize . <addr>) */
1130   - *((*ptr)++) = i_serialize;
1131   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1132   - break;
  1130 + *((*ptr)++) = i_serialize;
  1131 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1132 + break;
1133 1133  
1134 1134 case unserialize: /* (unserialize . <addr>) */
1135   - *((*ptr)++) = i_unserialize;
1136   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1137   - break;
  1135 + *((*ptr)++) = i_unserialize;
  1136 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1137 + break;
1138 1138  
1139 1139 case type_large: /* (type_large . <addr>) */
1140   - *((*ptr)++) = i_type_large;
1141   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1142   - break;
  1140 + *((*ptr)++) = i_type_large;
  1141 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1142 + break;
1143 1143  
1144 1144 case indirect_type_large: /* (indirect_type_large . <addr>) */
1145   - *((*ptr)++) = i_indirect_type_large;
1146   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1147   - break;
  1145 + *((*ptr)++) = i_indirect_type_large;
  1146 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1147 + break;
1148 1148  
1149 1149 case dec3: /* (dec3 . <addr>) */
1150   - *((*ptr)++) = i_dec3;
1151   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
1152   - break;
  1150 + *((*ptr)++) = i_dec3;
  1151 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
  1152 + break;
1153 1153  
1154 1154 case start: /* (start <depth> . <addr>) */
1155   - *((*ptr)++) = i_start;
1156   - *((*ptr)++) = integer_value(second(instr));
1157   - *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
1158   - break;
  1155 + *((*ptr)++) = i_start;
  1156 + *((*ptr)++) = integer_value(second(instr));
  1157 + *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
  1158 + break;
1159 1159  
1160 1160 case _switch: /* (switch a1 ... ak) -->
1161 1161 i_switch k a1 ... ak */
1162   - {
1163   - *((*ptr)++) = i_switch;
1164   - instr = cdr(instr);
1165   - *((*ptr)++) = (U8)length(instr);
1166   - while(consp(instr))
1167   - {
1168   - *(((U32 *)(*ptr))++) = offsets[integer_value(car(instr))];
1169   - instr = cdr(instr);
1170   - }
1171   - }
1172   - break;
  1162 + {
  1163 + *((*ptr)++) = i_switch;
  1164 + instr = cdr(instr);
  1165 + *((*ptr)++) = (U8)length(instr);
  1166 + while(consp(instr))
  1167 + {
  1168 + *(((U32 *)(*ptr))++) = offsets[integer_value(car(instr))];
  1169 + instr = cdr(instr);
  1170 + }
  1171 + }
  1172 + break;
1173 1173  
1174 1174 case del_gv: /* (del_gv . index) */
1175   - *((*ptr)++) = i_del_gv;
1176   - *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
1177   - break;
  1175 + *((*ptr)++) = i_del_gv;
  1176 + *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
  1177 + break;
1178 1178  
1179 1179 case type_mixed_switch:
1180   - {
1181   - *((*ptr)++) = i_type_mixed_switch;
1182   - instr = cdr(instr);
1183   - *((*ptr)++) = (U8)integer_value(car(instr));
1184   - instr = cdr(instr);
1185   - *((*ptr)++) = (U8)length(instr);
1186   - while(consp(instr))
1187   - {
1188   - *(((U32 *)(*ptr))++) = offsets[integer_value(car(instr))];
1189   - instr = cdr(instr);
1190   - }
1191   - }
1192   - break;
  1180 + {
  1181 + *((*ptr)++) = i_type_mixed_switch;
  1182 + instr = cdr(instr);
  1183 + *((*ptr)++) = (U8)integer_value(car(instr));
  1184 + instr = cdr(instr);
  1185 + *((*ptr)++) = (U8)length(instr);
  1186 + while(consp(instr))
  1187 + {
  1188 + *(((U32 *)(*ptr))++) = offsets[integer_value(car(instr))];
  1189 + instr = cdr(instr);
  1190 + }
  1191 + }
  1192 + break;
1193 1193  
1194 1194 case type_large_switch:
1195   - {
1196   - *((*ptr)++) = i_type_large_switch;
1197   - instr = cdr(instr);
1198   - *((*ptr)++) = (U8)length(instr);
1199   - while(consp(instr))
1200   - {
1201   - *(((U32 *)(*ptr))++) = offsets[integer_value(car(instr))];
1202   - instr = cdr(instr);
1203   - }
1204   - }
1205   - break;
  1195 + {
  1196 + *((*ptr)++) = i_type_large_switch;
  1197 + instr = cdr(instr);
  1198 + *((*ptr)++) = (U8)length(instr);
  1199 + while(consp(instr))
  1200 + {
  1201 + *(((U32 *)(*ptr))++) = offsets[integer_value(car(instr))];
  1202 + instr = cdr(instr);
  1203 + }
  1204 + }
  1205 + break;
1206 1206  
1207 1207 case load_module: /* (load_module . description) */
1208 1208 {
1209   - *((*ptr)++) = i_load_module;
1210   - instr = cdr(instr);
  1209 + *((*ptr)++) = i_load_module;
  1210 + instr = cdr(instr);
1211 1211 *(((U32 *)(*ptr))++) = length(instr);
1212 1212 while(consp(instr))
1213 1213 {
... ... @@ -1218,7 +1218,7 @@ void translate_instruction(U8 **ptr,
1218 1218 break;
1219 1219  
1220 1220 default:
1221   - internal_error("Cannot translate instruction",instr);
  1221 + internal_error("Cannot translate instruction",instr);
1222 1222 }
1223 1223 else
1224 1224 switch(instr)
... ... @@ -1227,334 +1227,334 @@ void translate_instruction(U8 **ptr,
1227 1227 break;
1228 1228  
1229 1229 case initialization_address: /* initialization_address */
1230   - *((*ptr)++) = i_address;
1231   - *(((U32 *)(*ptr))++) = offsets[integer_value(initialization_address_value)];
1232   - break;
  1230 + *((*ptr)++) = i_address;
  1231 + *(((U32 *)(*ptr))++) = offsets[integer_value(initialization_address_value)];
  1232 + break;
1233 1233  
1234 1234 case variables_deletion_address: /* variables_deletion_address */
1235   - *((*ptr)++) = i_address;
1236   - *(((U32 *)(*ptr))++) = offsets[integer_value(variables_deletion_address_value)];
1237   - break;
  1235 + *((*ptr)++) = i_address;
  1236 + *(((U32 *)(*ptr))++) = offsets[integer_value(variables_deletion_address_value)];
  1237 + break;
1238 1238  
1239 1239 case ret_if_zero:
1240   - *((*ptr)++) = i_ret_if_zero;
1241   - break;
  1240 + *((*ptr)++) = i_ret_if_zero;
  1241 + break;
1242 1242  
1243 1243 case get_var_monitors:
1244   - *((*ptr)++) = i_get_var_monitors;
1245   - break;
  1244 + *((*ptr)++) = i_get_var_monitors;
  1245 + break;
1246 1246  
1247 1247 case get_mvar_monitors:
1248   - *((*ptr)++) = i_get_mvar_monitors;
1249   - break;
  1248 + *((*ptr)++) = i_get_mvar_monitors;
  1249 + break;
1250 1250  
1251 1251 case del_index_direct:
1252   - *((*ptr)++) = i_del_index_direct;
1253   - break;
  1252 + *((*ptr)++) = i_del_index_direct;
  1253 + break;
1254 1254  
1255 1255 case del_index_indirect:
1256   - *((*ptr)++) = i_del_index_indirect;
1257   - break;
  1256 + *((*ptr)++) = i_del_index_indirect;
  1257 + break;
1258 1258  
1259 1259 case indirect_del_ptr:
1260   - *((*ptr)++) = i_indirect_del_ptr;
1261   - break;
  1260 + *((*ptr)++) = i_indirect_del_ptr;
  1261 + break;
1262 1262  
1263 1263 case del_function:
1264   - *((*ptr)++) = i_del_function;
1265   - break;
  1264 + *((*ptr)++) = i_del_function;
  1265 + break;
1266 1266  
1267 1267 case mvar_slots_del_function:
1268   - *((*ptr)++) = i_mvar_slots_del_function;
1269   - break;
  1268 + *((*ptr)++) = i_mvar_slots_del_function;
  1269 + break;
1270 1270  
1271 1271 case indirect_del_function:
1272   - *((*ptr)++) = i_indirect_del_function;
1273   - break;
  1272 + *((*ptr)++) = i_indirect_del_function;
  1273 + break;
1274 1274  
1275 1275 case indirect_del_conn:
1276   - *((*ptr)++) = i_indirect_del_conn;
1277   - break;
  1276 + *((*ptr)++) = i_indirect_del_conn;
  1277 + break;
1278 1278  
1279 1279 case mvar_slots_del_conn:
1280   - *((*ptr)++) = i_mvar_slots_del_conn;
1281   - break;
  1280 + *((*ptr)++) = i_mvar_slots_del_conn;
  1281 + break;
1282 1282  
1283 1283 case push:
1284   - *((*ptr)++) = i_push;
1285   - break;
  1284 + *((*ptr)++) = i_push;
  1285 + break;
1286 1286  
1287 1287 case push_mvar_length:
1288   - *((*ptr)++) = i_push_mvar_length;
1289   - break;
  1288 + *((*ptr)++) = i_push_mvar_length;
  1289 + break;
1290 1290  
1291 1291 case remove_monitor:
1292   - *((*ptr)++) = i_remove_monitor;
1293   - break;
  1292 + *((*ptr)++) = i_remove_monitor;
  1293 + break;
1294 1294  
1295 1295 case unlock:
1296   - *((*ptr)++) = i_unlock;
1297   - break;
  1296 + *((*ptr)++) = i_unlock;
  1297 + break;
1298 1298  
1299 1299 case odd_align:
1300 1300 if (!(((int)(*ptr))&1)) /* 'ptr' is equal to instruction offset mod 4 */
1301 1301 *((*ptr)++) = i_odd_align;
1302   - break;
  1302 + break;
1303 1303  
1304 1304 case lock:
1305   - *((*ptr)++) = i_lock;
1306   - break;
  1305 + *((*ptr)++) = i_lock;
  1306 + break;
1307 1307  
1308 1308 case eq_string:
1309   - *((*ptr)++) = i_eq_string;
1310   - break;
  1309 + *((*ptr)++) = i_eq_string;
  1310 + break;
1311 1311  
1312 1312 case eq_byte_array:
1313   - *((*ptr)++) = i_eq_byte_array;
1314   - break;
  1313 + *((*ptr)++) = i_eq_byte_array;
  1314 + break;
1315 1315  
1316 1316 case invalid:
1317   - *((*ptr)++) = i_invalid;
1318   - break;
  1317 + *((*ptr)++) = i_invalid;
  1318 + break;
1319 1319  
1320 1320 case free_var_seg:
1321   - *((*ptr)++) = i_free_var_seg;
1322   - break;
  1321 + *((*ptr)++) = i_free_var_seg;
  1322 + break;
1323 1323  
1324 1324 case free_mvar_seg:
1325   - *((*ptr)++) = i_free_mvar_seg;
1326   - break;
  1325 + *((*ptr)++) = i_free_mvar_seg;
  1326 + break;
1327 1327  
1328 1328 case create_var:
1329   - *((*ptr)++) = i_create_var;
1330   - break;
  1329 + *((*ptr)++) = i_create_var;
  1330 + break;
1331 1331  
1332 1332 case create_mvar:
1333   - *((*ptr)++) = i_create_mvar;
1334   - break;
  1333 + *((*ptr)++) = i_create_mvar;
  1334 + break;
1335 1335  
1336 1336 case get_vv:
1337   - *((*ptr)++) = i_get_vv;
1338   - break;
  1337 + *((*ptr)++) = i_get_vv;
  1338 + break;
1339 1339  
1340 1340 case get_mvv:
1341   - *((*ptr)++) = i_get_mvv;
1342   - break;
  1341 + *((*ptr)++) = i_get_mvv;
  1342 + break;
1343 1343  
1344 1344 case xchg_vv:
1345   - *((*ptr)++) = i_xchg_vv;
1346   - break;
  1345 + *((*ptr)++) = i_xchg_vv;
  1346 + break;
1347 1347  
1348 1348 case xchg_mvv:
1349   - *((*ptr)++) = i_xchg_mvv;
1350   - break;
  1349 + *((*ptr)++) = i_xchg_mvv;
  1350 + break;
1351 1351  
1352 1352 case pop2:
1353   - *((*ptr)++) = i_pop2;
1354   - break;
  1353 + *((*ptr)++) = i_pop2;
  1354 + break;
1355 1355  
1356 1356 case pop3:
1357   - *((*ptr)++) = i_pop3;
1358   - break;
  1357 + *((*ptr)++) = i_pop3;
  1358 + break;
1359 1359  
1360 1360 case pop1:
1361   - *((*ptr)++) = i_pop1;
1362   - break;
  1361 + *((*ptr)++) = i_pop1;
  1362 + break;
1363 1363  
1364 1364 case swap:
1365   - *((*ptr)++) = i_swap;
1366   - break;
  1365 + *((*ptr)++) = i_swap;
  1366 + break;
1367 1367  
1368 1368 case push_eq_data:
1369   - *((*ptr)++) = i_push_eq_data;
1370   - break;
  1369 + *((*ptr)++) = i_push_eq_data;
  1370 + break;
1371 1371  
1372 1372 case push_before_eq:
1373   - *((*ptr)++) = i_push_before_eq;
1374   - break;
  1373 + *((*ptr)++) = i_push_before_eq;
  1374 + break;
1375 1375  
1376 1376 case copy:
1377   - *((*ptr)++) = i_copy;
1378   - break;
  1377 + *((*ptr)++) = i_copy;
  1378 + break;
1379 1379  
1380 1380 case copy_ptr:
1381   - *((*ptr)++) = i_copy_ptr;
1382   - break;
  1381 + *((*ptr)++) = i_copy_ptr;
  1382 + break;
1383 1383  
1384 1384 case copy_function:
1385   - *((*ptr)++) = i_copy_function;
1386   - break;
  1385 + *((*ptr)++) = i_copy_function;
  1386 + break;
1387 1387  
1388 1388 case vcopy_ptr:
1389   - *((*ptr)++) = i_vcopy_ptr;
1390   - break;
  1389 + *((*ptr)++) = i_vcopy_ptr;
  1390 + break;
1391 1391  
1392 1392 case vcopy_function:
1393   - *((*ptr)++) = i_vcopy_function;
1394   - break;
  1393 + *((*ptr)++) = i_vcopy_function;
  1394 + break;
1395 1395  
1396 1396 case vcopy_null:
1397   - *((*ptr)++) = i_vcopy_null;
1398   - break;
  1397 + *((*ptr)++) = i_vcopy_null;
  1398 + break;
1399 1399  
1400 1400 case index_indirect:
1401   - *((*ptr)++) = i_index_indirect;
1402   - break;
  1401 + *((*ptr)++) = i_index_indirect;
  1402 + break;
1403 1403  
1404 1404 case free_seg_0:
1405   - *((*ptr)++) = i_free_seg_0;
1406   - break;
  1405 + *((*ptr)++) = i_free_seg_0;
  1406 + break;
1407 1407  
1408 1408 case free_seg_1:
1409   - *((*ptr)++) = i_free_seg_1;
1410   - break;
  1409 + *((*ptr)++) = i_free_seg_1;
  1410 + break;
1411 1411  
1412 1412 case connect_file_R:
1413   - *((*ptr)++) = i_connect_file_R;
1414   - break;
  1413 + *((*ptr)++) = i_connect_file_R;
  1414 + break;
1415 1415  
1416 1416 case connect_file_W:
1417   - *((*ptr)++) = i_connect_file_W;
1418   - break;
  1417 + *((*ptr)++) = i_connect_file_W;
  1418 + break;
1419 1419  
1420 1420 case connect_file_RW:
1421   - *((*ptr)++) = i_connect_file_RW;
1422   - break;
  1421 + *((*ptr)++) = i_connect_file_RW;
  1422 + break;
1423 1423  
1424 1424 case connect_IP_RW:
1425   - *((*ptr)++) = i_connect_IP_RW;
1426   - break;
  1425 + *((*ptr)++) = i_connect_IP_RW;
  1426 + break;
1427 1427  
1428 1428 case read_Int8:
1429   - *((*ptr)++) = i_read_Int8;
1430   - break;
  1429 + *((*ptr)++) = i_read_Int8;
  1430 + break;
1431 1431  
1432 1432 case read_Int32:
1433   - *((*ptr)++) = i_read_Int32;
1434   - break;
  1433 + *((*ptr)++) = i_read_Int32;
  1434 + break;
1435 1435  
1436 1436 case read_function:
1437   - *((*ptr)++) = i_read_function;
1438   - break;
  1437 + *((*ptr)++) = i_read_function;
  1438 + break;
1439 1439  
1440 1440 case write_Int8:
1441   - *((*ptr)++) = i_write_Int8;
1442   - break;
  1441 + *((*ptr)++) = i_write_Int8;
  1442 + break;
1443 1443  
1444 1444 case write_Int32:
1445   - *((*ptr)++) = i_write_Int32;
1446   - break;
  1445 + *((*ptr)++) = i_write_Int32;
  1446 + break;
1447 1447  
1448 1448 case write_function:
1449   - *((*ptr)++) = i_write_function;
1450   - break;
  1449 + *((*ptr)++) = i_write_function;
  1450 + break;
1451 1451  
1452 1452 case implode:
1453   - *((*ptr)++) = i_implode;
1454   - break;
  1453 + *((*ptr)++) = i_implode;
  1454 + break;
1455 1455  
1456 1456 case explode:
1457   - *((*ptr)++) = i_explode;
1458   - break;
  1457 + *((*ptr)++) = i_explode;
  1458 + break;
1459 1459  
1460 1460 case int8_to_int32:
1461   - *((*ptr)++) = i_int8_to_int32;
1462   - break;
  1461 + *((*ptr)++) = i_int8_to_int32;
  1462 + break;
1463 1463  
1464 1464 case truncate_to_int8:
1465   - *((*ptr)++) = i_truncate_to_int8;
1466   - break;
  1465 + *((*ptr)++) = i_truncate_to_int8;
  1466 + break;
1467 1467  
1468 1468 case now:
1469   - *((*ptr)++) = i_now;
1470   - break;
  1469 + *((*ptr)++) = i_now;
  1470 + break;
1471 1471  
1472 1472 case convert_time_from_int:
1473   - *((*ptr)++) = i_convert_time_from_int;
1474   - break;
  1473 + *((*ptr)++) = i_convert_time_from_int;
  1474 + break;
1475 1475  
1476 1476 case convert_time_to_int:
1477   - *((*ptr)++) = i_convert_time_to_int;
1478   - break;
  1477 + *((*ptr)++) = i_convert_time_to_int;
  1478 + break;
1479 1479  
1480 1480 case give_up:
1481   - *((*ptr)++) = i_give_up;
1482   - break;
  1481 + *((*ptr)++) = i_give_up;
  1482 + break;
1483 1483  
1484 1484 case start_debug_avm:
1485   - *((*ptr)++) = i_start_debug_avm;
1486   - break;
  1485 + *((*ptr)++) = i_start_debug_avm;
  1486 + break;
1487 1487  
1488 1488 case protect:
1489   - *((*ptr)++) = i_protect;
1490   - *((*ptr)++) = 0;
1491   - break;
  1489 + *((*ptr)++) = i_protect;
  1490 + *((*ptr)++) = 0;
  1491 + break;
1492 1492  
1493 1493 case stop_debug_avm:
1494   - *((*ptr)++) = i_stop_debug_avm;
1495   - break;
  1494 + *((*ptr)++) = i_stop_debug_avm;
  1495 + break;
1496 1496  
1497 1497 case del_ptr:
1498   - *((*ptr)++) = i_del_ptr;
1499   - break;
  1498 + *((*ptr)++) = i_del_ptr;
  1499 + break;
1500 1500  
1501 1501 case mvar_slots_del_ptr:
1502   - *((*ptr)++) = i_mvar_slots_del_ptr;
1503   - break;
  1502 + *((*ptr)++) = i_mvar_slots_del_ptr;
  1503 + break;
1504 1504  
1505 1505 case del:
1506   - *((*ptr)++) = i_del;
1507   - break;
  1506 + *((*ptr)++) = i_del;
  1507 + break;
1508 1508  
1509 1509 case del_conn:
1510   - *((*ptr)++) = i_del_conn;
1511   - break;
  1510 + *((*ptr)++) = i_del_conn;
  1511 + break;
1512 1512  
1513 1513 case finish:
1514   - *((*ptr)++) = i_finish;
1515   - break;
  1514 + *((*ptr)++) = i_finish;
  1515 + break;
1516 1516  
1517 1517 case pending_event:
1518   - *((*ptr)++) = i_pending_event;
1519   - break;
  1518 + *((*ptr)++) = i_pending_event;
  1519 + break;
1520 1520  
1521 1521 case listener:
1522   - *((*ptr)++) = i_listener;
1523   - break;
  1522 + *((*ptr)++) = i_listener;
  1523 + break;
1524 1524  
1525 1525 case accept_connection:
1526   - *((*ptr)++) = i_accept_connection;
1527   - break;
  1526 + *((*ptr)++) = i_accept_connection;
  1527 + break;
1528 1528  
1529 1529 case listener_shutdown:
1530   - *((*ptr)++) = i_listener_shutdown;
1531   - break;
  1530 + *((*ptr)++) = i_listener_shutdown;
  1531 + break;
1532 1532  
1533 1533 case listener_is_down:
1534   - *((*ptr)++) = i_listener_is_down;
1535   - break;
  1534 + *((*ptr)++) = i_listener_is_down;
  1535 + break;
1536 1536  
1537 1537 case do_alert:
1538   - *((*ptr)++) = i_do_alert;
1539   - break;
  1538 + *((*ptr)++) = i_do_alert;
  1539 + break;
1540 1540  
1541 1541 case get_gvv:
1542   - *((*ptr)++) = i_get_gvv;
1543   - break;
  1542 + *((*ptr)++) = i_get_gvv;
  1543 + break;
1544 1544  
1545 1545 case xchg_gvv:
1546   - *((*ptr)++) = i_xchg_gvv;
1547   - break;
  1546 + *((*ptr)++) = i_xchg_gvv;
  1547 + break;
1548 1548  
1549 1549 case byte_array_to_ascii:
1550   - *((*ptr)++) = i_byte_array_to_ascii;
1551   - break;
  1550 + *((*ptr)++) = i_byte_array_to_ascii;
  1551 + break;
1552 1552  
1553 1553 case byte_array_to_string:
1554   - *((*ptr)++) = i_byte_array_to_string;
1555   - break;
  1554 + *((*ptr)++) = i_byte_array_to_string;
  1555 + break;
1556 1556  
1557   - /* primitive types pseudo-instructions */
  1557 + /* primitive types pseudo-instructions */
1558 1558 #define item(n) case n: *((*ptr)++) = i_##n; break;
1559 1559 primitive_types_list
1560 1560 #undef item
... ... @@ -1563,47 +1563,47 @@ void translate_instruction(U8 **ptr,
1563 1563 #undef item
1564 1564  
1565 1565 case type_0:
1566   - *((*ptr)++) = i_type_0;
  1566 + *((*ptr)++) = i_type_0;
1567 1567 break;
1568 1568  
1569 1569 case indirect_type_0:
1570   - *((*ptr)++) = i_indirect_type_0;
  1570 + *((*ptr)++) = i_indirect_type_0;
1571 1571 break;
1572 1572  
1573 1573 case dns:
1574   - *((*ptr)++) = i_dns;
  1574 + *((*ptr)++) = i_dns;
1575 1575 break;
1576 1576  
1577 1577 case write_file:
1578   - *((*ptr)++) = i_write_file;
  1578 + *((*ptr)++) = i_write_file;
1579 1579 break;
1580 1580  
1581 1581 case read_file:
1582   - *((*ptr)++) = i_read_file;
  1582 + *((*ptr)++) = i_read_file;
1583 1583 break;
1584 1584  
1585 1585 case file_size:
1586   - *((*ptr)++) = i_file_size;
  1586 + *((*ptr)++) = i_file_size;
1587 1587 break;
1588 1588  
1589 1589 case byte_array_length:
1590   - *((*ptr)++) = i_byte_array_length;
  1590 + *((*ptr)++) = i_byte_array_length;
1591 1591 break;
1592 1592  
1593 1593 case sha1_hash:
1594   - *((*ptr)++) = i_sha1_hash;
  1594 + *((*ptr)++) = i_sha1_hash;
1595 1595 break;
1596 1596  
1597 1597 case get_file_mode:
1598   - *((*ptr)++) = i_get_file_mode;
  1598 + *((*ptr)++) = i_get_file_mode;
1599 1599 break;
1600 1600  
1601 1601 case set_file_mode:
1602   - *((*ptr)++) = i_set_file_mode;
  1602 + *((*ptr)++) = i_set_file_mode;
1603 1603 break;
1604 1604  
1605 1605 case alt_number_indirect:
1606   - *((*ptr)++) = i_alt_number_indirect;
  1606 + *((*ptr)++) = i_alt_number_indirect;
1607 1607 break;
1608 1608  
1609 1609  
... ... @@ -1620,15 +1620,15 @@ void translate_instruction(U8 **ptr,
1620 1620  
1621 1621  
1622 1622 case location:
1623   - *((*ptr)++) = 0;
1624   - *((*ptr)++) = 0;
1625   - *((*ptr)++) = 0;
1626   - *((*ptr)++) = 0;
1627   - break;
  1623 + *((*ptr)++) = 0;
  1624 + *((*ptr)++) = 0;
  1625 + *((*ptr)++) = 0;
  1626 + *((*ptr)++) = 0;
  1627 + break;
1628 1628  
1629 1629  
1630 1630 default:
1631   - internal_error("Cannot translate instruction",instr);
  1631 + internal_error("Cannot translate instruction",instr);
1632 1632 }
1633 1633 }
1634 1634  
... ...