aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/libraries/embryo/src/bin
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/embryo/src/bin')
-rw-r--r--libraries/embryo/src/bin/Makefile.am40
-rw-r--r--libraries/embryo/src/bin/Makefile.in787
-rw-r--r--libraries/embryo/src/bin/embryo_cc_amx.h226
-rw-r--r--libraries/embryo/src/bin/embryo_cc_prefix.c61
-rw-r--r--libraries/embryo/src/bin/embryo_cc_prefix.h6
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc.h667
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc1.c4079
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc2.c2779
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc3.c2438
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc4.c1308
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc5.c154
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc5.scp317
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc6.c1077
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc7.c688
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc7.scp1473
-rw-r--r--libraries/embryo/src/bin/embryo_cc_scexpand.c53
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sclist.c293
-rw-r--r--libraries/embryo/src/bin/embryo_cc_scvars.c88
18 files changed, 16534 insertions, 0 deletions
diff --git a/libraries/embryo/src/bin/Makefile.am b/libraries/embryo/src/bin/Makefile.am
new file mode 100644
index 0000000..09f6ffd
--- /dev/null
+++ b/libraries/embryo/src/bin/Makefile.am
@@ -0,0 +1,40 @@
1
2MAINTAINERCLEANFILES = Makefile.in
3
4AM_CPPFLAGS = \
5-I. \
6-I$(top_srcdir)/src/lib \
7-I$(top_srcdir) \
8-I$(top_builddir) \
9-DPACKAGE_BIN_DIR=\"$(bindir)\" \
10-DPACKAGE_LIB_DIR=\"$(libdir)\" \
11-DPACKAGE_DATA_DIR=\"$(datadir)/$(PACKAGE)\" \
12@EINA_CFLAGS@ \
13@EVIL_CFLAGS@
14
15bin_PROGRAMS = @EMBRYO_CC_PRG@
16EXTRA_PROGRAMS = embryo_cc
17
18embryo_cc_SOURCES = \
19embryo_cc_amx.h \
20embryo_cc_sc.h \
21embryo_cc_sc1.c \
22embryo_cc_sc2.c \
23embryo_cc_sc3.c \
24embryo_cc_sc4.c \
25embryo_cc_sc5.c \
26embryo_cc_sc6.c \
27embryo_cc_sc7.c \
28embryo_cc_scexpand.c \
29embryo_cc_sclist.c \
30embryo_cc_scvars.c \
31embryo_cc_prefix.c \
32embryo_cc_prefix.h
33
34embryo_cc_CFLAGS = @EMBRYO_CFLAGS@
35embryo_cc_LDADD = $(top_builddir)/src/lib/libembryo.la @EVIL_LIBS@ @EINA_LIBS@ -lm
36embryo_cc_LDFLAGS = @lt_enable_auto_import@
37
38EXTRA_DIST = \
39embryo_cc_sc5.scp \
40embryo_cc_sc7.scp
diff --git a/libraries/embryo/src/bin/Makefile.in b/libraries/embryo/src/bin/Makefile.in
new file mode 100644
index 0000000..40d0ef9
--- /dev/null
+++ b/libraries/embryo/src/bin/Makefile.in
@@ -0,0 +1,787 @@
1# Makefile.in generated by automake 1.11.1 from Makefile.am.
2# @configure_input@
3
4# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
5# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
6# Inc.
7# This Makefile.in is free software; the Free Software Foundation
8# gives unlimited permission to copy and/or distribute it,
9# with or without modifications, as long as this notice is preserved.
10
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
13# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
14# PARTICULAR PURPOSE.
15
16@SET_MAKE@
17
18VPATH = @srcdir@
19pkgdatadir = $(datadir)/@PACKAGE@
20pkgincludedir = $(includedir)/@PACKAGE@
21pkglibdir = $(libdir)/@PACKAGE@
22pkglibexecdir = $(libexecdir)/@PACKAGE@
23am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
24install_sh_DATA = $(install_sh) -c -m 644
25install_sh_PROGRAM = $(install_sh) -c
26install_sh_SCRIPT = $(install_sh) -c
27INSTALL_HEADER = $(INSTALL_DATA)
28transform = $(program_transform_name)
29NORMAL_INSTALL = :
30PRE_INSTALL = :
31POST_INSTALL = :
32NORMAL_UNINSTALL = :
33PRE_UNINSTALL = :
34POST_UNINSTALL = :
35build_triplet = @build@
36host_triplet = @host@
37EXTRA_PROGRAMS = embryo_cc$(EXEEXT)
38subdir = src/bin
39DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in
40ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
41am__aclocal_m4_deps = $(top_srcdir)/m4/ac_attribute.m4 \
42 $(top_srcdir)/m4/efl_binary.m4 $(top_srcdir)/m4/efl_doxygen.m4 \
43 $(top_srcdir)/m4/efl_fnmatch.m4 \
44 $(top_srcdir)/m4/efl_path_max.m4 $(top_srcdir)/m4/libtool.m4 \
45 $(top_srcdir)/m4/ltoptions.m4 $(top_srcdir)/m4/ltsugar.m4 \
46 $(top_srcdir)/m4/ltversion.m4 $(top_srcdir)/m4/lt~obsolete.m4 \
47 $(top_srcdir)/configure.ac
48am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
49 $(ACLOCAL_M4)
50mkinstalldirs = $(install_sh) -d
51CONFIG_HEADER = $(top_builddir)/config.h
52CONFIG_CLEAN_FILES =
53CONFIG_CLEAN_VPATH_FILES =
54am__installdirs = "$(DESTDIR)$(bindir)"
55PROGRAMS = $(bin_PROGRAMS)
56am_embryo_cc_OBJECTS = embryo_cc-embryo_cc_sc1.$(OBJEXT) \
57 embryo_cc-embryo_cc_sc2.$(OBJEXT) \
58 embryo_cc-embryo_cc_sc3.$(OBJEXT) \
59 embryo_cc-embryo_cc_sc4.$(OBJEXT) \
60 embryo_cc-embryo_cc_sc5.$(OBJEXT) \
61 embryo_cc-embryo_cc_sc6.$(OBJEXT) \
62 embryo_cc-embryo_cc_sc7.$(OBJEXT) \
63 embryo_cc-embryo_cc_scexpand.$(OBJEXT) \
64 embryo_cc-embryo_cc_sclist.$(OBJEXT) \
65 embryo_cc-embryo_cc_scvars.$(OBJEXT) \
66 embryo_cc-embryo_cc_prefix.$(OBJEXT)
67embryo_cc_OBJECTS = $(am_embryo_cc_OBJECTS)
68embryo_cc_DEPENDENCIES = $(top_builddir)/src/lib/libembryo.la
69AM_V_lt = $(am__v_lt_$(V))
70am__v_lt_ = $(am__v_lt_$(AM_DEFAULT_VERBOSITY))
71am__v_lt_0 = --silent
72embryo_cc_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
73 $(LIBTOOLFLAGS) --mode=link $(CCLD) $(embryo_cc_CFLAGS) \
74 $(CFLAGS) $(embryo_cc_LDFLAGS) $(LDFLAGS) -o $@
75DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir)
76depcomp = $(SHELL) $(top_srcdir)/depcomp
77am__depfiles_maybe = depfiles
78am__mv = mv -f
79COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
80 $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
81LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
82 $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
83 $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
84 $(AM_CFLAGS) $(CFLAGS)
85AM_V_CC = $(am__v_CC_$(V))
86am__v_CC_ = $(am__v_CC_$(AM_DEFAULT_VERBOSITY))
87am__v_CC_0 = @echo " CC " $@;
88AM_V_at = $(am__v_at_$(V))
89am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY))
90am__v_at_0 = @
91CCLD = $(CC)
92LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
93 $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
94 $(AM_LDFLAGS) $(LDFLAGS) -o $@
95AM_V_CCLD = $(am__v_CCLD_$(V))
96am__v_CCLD_ = $(am__v_CCLD_$(AM_DEFAULT_VERBOSITY))
97am__v_CCLD_0 = @echo " CCLD " $@;
98AM_V_GEN = $(am__v_GEN_$(V))
99am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY))
100am__v_GEN_0 = @echo " GEN " $@;
101SOURCES = $(embryo_cc_SOURCES)
102DIST_SOURCES = $(embryo_cc_SOURCES)
103ETAGS = etags
104CTAGS = ctags
105DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
106ACLOCAL = @ACLOCAL@
107ALLOCA = @ALLOCA@
108AMTAR = @AMTAR@
109AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
110AR = @AR@
111AS = @AS@
112AUTOCONF = @AUTOCONF@
113AUTOHEADER = @AUTOHEADER@
114AUTOMAKE = @AUTOMAKE@
115AWK = @AWK@
116CC = @CC@
117CCDEPMODE = @CCDEPMODE@
118CFLAGS = @CFLAGS@
119CPP = @CPP@
120CPPFLAGS = @CPPFLAGS@
121CYGPATH_W = @CYGPATH_W@
122DEFS = @DEFS@
123DEPDIR = @DEPDIR@
124DLLTOOL = @DLLTOOL@
125DSYMUTIL = @DSYMUTIL@
126DUMPBIN = @DUMPBIN@
127ECHO_C = @ECHO_C@
128ECHO_N = @ECHO_N@
129ECHO_T = @ECHO_T@
130EFL_EMBRYO_BUILD = @EFL_EMBRYO_BUILD@
131EFL_FNMATCH_LIBS = @EFL_FNMATCH_LIBS@
132EGREP = @EGREP@
133EINA_CFLAGS = @EINA_CFLAGS@
134EINA_LIBS = @EINA_LIBS@
135EMBRYO_CC_PRG = @EMBRYO_CC_PRG@
136EMBRYO_CFLAGS = @EMBRYO_CFLAGS@
137EMBRYO_CPPFLAGS = @EMBRYO_CPPFLAGS@
138EVIL_CFLAGS = @EVIL_CFLAGS@
139EVIL_LIBS = @EVIL_LIBS@
140EXEEXT = @EXEEXT@
141FGREP = @FGREP@
142GREP = @GREP@
143INSTALL = @INSTALL@
144INSTALL_DATA = @INSTALL_DATA@
145INSTALL_PROGRAM = @INSTALL_PROGRAM@
146INSTALL_SCRIPT = @INSTALL_SCRIPT@
147INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
148LD = @LD@
149LDFLAGS = @LDFLAGS@
150LIBOBJS = @LIBOBJS@
151LIBS = @LIBS@
152LIBTOOL = @LIBTOOL@
153LIPO = @LIPO@
154LN_S = @LN_S@
155LTLIBOBJS = @LTLIBOBJS@
156MAKEINFO = @MAKEINFO@
157MKDIR_P = @MKDIR_P@
158NM = @NM@
159NMEDIT = @NMEDIT@
160OBJDUMP = @OBJDUMP@
161OBJEXT = @OBJEXT@
162OTOOL = @OTOOL@
163OTOOL64 = @OTOOL64@
164PACKAGE = @PACKAGE@
165PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
166PACKAGE_NAME = @PACKAGE_NAME@
167PACKAGE_STRING = @PACKAGE_STRING@
168PACKAGE_TARNAME = @PACKAGE_TARNAME@
169PACKAGE_URL = @PACKAGE_URL@
170PACKAGE_VERSION = @PACKAGE_VERSION@
171PATH_SEPARATOR = @PATH_SEPARATOR@
172PKG_CONFIG = @PKG_CONFIG@
173PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@
174PKG_CONFIG_PATH = @PKG_CONFIG_PATH@
175RANLIB = @RANLIB@
176SED = @SED@
177SET_MAKE = @SET_MAKE@
178SHELL = @SHELL@
179STRIP = @STRIP@
180VERSION = @VERSION@
181VMAJ = @VMAJ@
182abs_builddir = @abs_builddir@
183abs_srcdir = @abs_srcdir@
184abs_top_builddir = @abs_top_builddir@
185abs_top_srcdir = @abs_top_srcdir@
186ac_ct_CC = @ac_ct_CC@
187ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
188am__include = @am__include@
189am__leading_dot = @am__leading_dot@
190am__quote = @am__quote@
191am__tar = @am__tar@
192am__untar = @am__untar@
193bindir = @bindir@
194build = @build@
195build_alias = @build_alias@
196build_cpu = @build_cpu@
197build_os = @build_os@
198build_vendor = @build_vendor@
199builddir = @builddir@
200datadir = @datadir@
201datarootdir = @datarootdir@
202docdir = @docdir@
203dvidir = @dvidir@
204efl_doxygen = @efl_doxygen@
205efl_have_doxygen = @efl_have_doxygen@
206embryoincludedir = @embryoincludedir@
207exec_prefix = @exec_prefix@
208host = @host@
209host_alias = @host_alias@
210host_cpu = @host_cpu@
211host_os = @host_os@
212host_vendor = @host_vendor@
213htmldir = @htmldir@
214includedir = @includedir@
215infodir = @infodir@
216install_sh = @install_sh@
217libdir = @libdir@
218libexecdir = @libexecdir@
219localedir = @localedir@
220localstatedir = @localstatedir@
221lt_ECHO = @lt_ECHO@
222lt_enable_auto_import = @lt_enable_auto_import@
223mandir = @mandir@
224mkdir_p = @mkdir_p@
225oldincludedir = @oldincludedir@
226pdfdir = @pdfdir@
227pkgconfig_requires_private = @pkgconfig_requires_private@
228prefix = @prefix@
229program_transform_name = @program_transform_name@
230psdir = @psdir@
231release_info = @release_info@
232requirement_embryo = @requirement_embryo@
233sbindir = @sbindir@
234sharedstatedir = @sharedstatedir@
235srcdir = @srcdir@
236sysconfdir = @sysconfdir@
237target_alias = @target_alias@
238top_build_prefix = @top_build_prefix@
239top_builddir = @top_builddir@
240top_srcdir = @top_srcdir@
241version_info = @version_info@
242MAINTAINERCLEANFILES = Makefile.in
243AM_CPPFLAGS = \
244-I. \
245-I$(top_srcdir)/src/lib \
246-I$(top_srcdir) \
247-I$(top_builddir) \
248-DPACKAGE_BIN_DIR=\"$(bindir)\" \
249-DPACKAGE_LIB_DIR=\"$(libdir)\" \
250-DPACKAGE_DATA_DIR=\"$(datadir)/$(PACKAGE)\" \
251@EINA_CFLAGS@ \
252@EVIL_CFLAGS@
253
254bin_PROGRAMS = @EMBRYO_CC_PRG@
255embryo_cc_SOURCES = \
256embryo_cc_amx.h \
257embryo_cc_sc.h \
258embryo_cc_sc1.c \
259embryo_cc_sc2.c \
260embryo_cc_sc3.c \
261embryo_cc_sc4.c \
262embryo_cc_sc5.c \
263embryo_cc_sc6.c \
264embryo_cc_sc7.c \
265embryo_cc_scexpand.c \
266embryo_cc_sclist.c \
267embryo_cc_scvars.c \
268embryo_cc_prefix.c \
269embryo_cc_prefix.h
270
271embryo_cc_CFLAGS = @EMBRYO_CFLAGS@
272embryo_cc_LDADD = $(top_builddir)/src/lib/libembryo.la @EVIL_LIBS@ @EINA_LIBS@ -lm
273embryo_cc_LDFLAGS = @lt_enable_auto_import@
274EXTRA_DIST = \
275embryo_cc_sc5.scp \
276embryo_cc_sc7.scp
277
278all: all-am
279
280.SUFFIXES:
281.SUFFIXES: .c .lo .o .obj
282$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
283 @for dep in $?; do \
284 case '$(am__configure_deps)' in \
285 *$$dep*) \
286 ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
287 && { if test -f $@; then exit 0; else break; fi; }; \
288 exit 1;; \
289 esac; \
290 done; \
291 echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/bin/Makefile'; \
292 $(am__cd) $(top_srcdir) && \
293 $(AUTOMAKE) --gnu src/bin/Makefile
294.PRECIOUS: Makefile
295Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
296 @case '$?' in \
297 *config.status*) \
298 cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
299 *) \
300 echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
301 cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
302 esac;
303
304$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
305 cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
306
307$(top_srcdir)/configure: $(am__configure_deps)
308 cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
309$(ACLOCAL_M4): $(am__aclocal_m4_deps)
310 cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
311$(am__aclocal_m4_deps):
312install-binPROGRAMS: $(bin_PROGRAMS)
313 @$(NORMAL_INSTALL)
314 test -z "$(bindir)" || $(MKDIR_P) "$(DESTDIR)$(bindir)"
315 @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \
316 for p in $$list; do echo "$$p $$p"; done | \
317 sed 's/$(EXEEXT)$$//' | \
318 while read p p1; do if test -f $$p || test -f $$p1; \
319 then echo "$$p"; echo "$$p"; else :; fi; \
320 done | \
321 sed -e 'p;s,.*/,,;n;h' -e 's|.*|.|' \
322 -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \
323 sed 'N;N;N;s,\n, ,g' | \
324 $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \
325 { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \
326 if ($$2 == $$4) files[d] = files[d] " " $$1; \
327 else { print "f", $$3 "/" $$4, $$1; } } \
328 END { for (d in files) print "f", d, files[d] }' | \
329 while read type dir files; do \
330 if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \
331 test -z "$$files" || { \
332 echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \
333 $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \
334 } \
335 ; done
336
337uninstall-binPROGRAMS:
338 @$(NORMAL_UNINSTALL)
339 @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \
340 files=`for p in $$list; do echo "$$p"; done | \
341 sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \
342 -e 's/$$/$(EXEEXT)/' `; \
343 test -n "$$list" || exit 0; \
344 echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \
345 cd "$(DESTDIR)$(bindir)" && rm -f $$files
346
347clean-binPROGRAMS:
348 @list='$(bin_PROGRAMS)'; test -n "$$list" || exit 0; \
349 echo " rm -f" $$list; \
350 rm -f $$list || exit $$?; \
351 test -n "$(EXEEXT)" || exit 0; \
352 list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
353 echo " rm -f" $$list; \
354 rm -f $$list
355embryo_cc$(EXEEXT): $(embryo_cc_OBJECTS) $(embryo_cc_DEPENDENCIES)
356 @rm -f embryo_cc$(EXEEXT)
357 $(AM_V_CCLD)$(embryo_cc_LINK) $(embryo_cc_OBJECTS) $(embryo_cc_LDADD) $(LIBS)
358
359mostlyclean-compile:
360 -rm -f *.$(OBJEXT)
361
362distclean-compile:
363 -rm -f *.tab.c
364
365@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_prefix.Po@am__quote@
366@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_sc1.Po@am__quote@
367@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_sc2.Po@am__quote@
368@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_sc3.Po@am__quote@
369@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_sc4.Po@am__quote@
370@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_sc5.Po@am__quote@
371@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_sc6.Po@am__quote@
372@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_sc7.Po@am__quote@
373@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_scexpand.Po@am__quote@
374@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_sclist.Po@am__quote@
375@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/embryo_cc-embryo_cc_scvars.Po@am__quote@
376
377.c.o:
378@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
379@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
380@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
381@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
382@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
383@am__fastdepCC_FALSE@ $(COMPILE) -c $<
384
385.c.obj:
386@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
387@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
388@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
389@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
390@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
391@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'`
392
393.c.lo:
394@am__fastdepCC_TRUE@ $(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
395@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
396@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
397@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
398@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
399@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $<
400
401embryo_cc-embryo_cc_sc1.o: embryo_cc_sc1.c
402@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc1.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc1.Tpo -c -o embryo_cc-embryo_cc_sc1.o `test -f 'embryo_cc_sc1.c' || echo '$(srcdir)/'`embryo_cc_sc1.c
403@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc1.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc1.Po
404@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
405@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc1.c' object='embryo_cc-embryo_cc_sc1.o' libtool=no @AMDEPBACKSLASH@
406@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
407@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc1.o `test -f 'embryo_cc_sc1.c' || echo '$(srcdir)/'`embryo_cc_sc1.c
408
409embryo_cc-embryo_cc_sc1.obj: embryo_cc_sc1.c
410@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc1.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc1.Tpo -c -o embryo_cc-embryo_cc_sc1.obj `if test -f 'embryo_cc_sc1.c'; then $(CYGPATH_W) 'embryo_cc_sc1.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc1.c'; fi`
411@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc1.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc1.Po
412@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
413@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc1.c' object='embryo_cc-embryo_cc_sc1.obj' libtool=no @AMDEPBACKSLASH@
414@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
415@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc1.obj `if test -f 'embryo_cc_sc1.c'; then $(CYGPATH_W) 'embryo_cc_sc1.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc1.c'; fi`
416
417embryo_cc-embryo_cc_sc2.o: embryo_cc_sc2.c
418@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc2.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc2.Tpo -c -o embryo_cc-embryo_cc_sc2.o `test -f 'embryo_cc_sc2.c' || echo '$(srcdir)/'`embryo_cc_sc2.c
419@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc2.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc2.Po
420@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
421@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc2.c' object='embryo_cc-embryo_cc_sc2.o' libtool=no @AMDEPBACKSLASH@
422@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
423@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc2.o `test -f 'embryo_cc_sc2.c' || echo '$(srcdir)/'`embryo_cc_sc2.c
424
425embryo_cc-embryo_cc_sc2.obj: embryo_cc_sc2.c
426@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc2.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc2.Tpo -c -o embryo_cc-embryo_cc_sc2.obj `if test -f 'embryo_cc_sc2.c'; then $(CYGPATH_W) 'embryo_cc_sc2.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc2.c'; fi`
427@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc2.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc2.Po
428@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
429@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc2.c' object='embryo_cc-embryo_cc_sc2.obj' libtool=no @AMDEPBACKSLASH@
430@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
431@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc2.obj `if test -f 'embryo_cc_sc2.c'; then $(CYGPATH_W) 'embryo_cc_sc2.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc2.c'; fi`
432
433embryo_cc-embryo_cc_sc3.o: embryo_cc_sc3.c
434@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc3.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc3.Tpo -c -o embryo_cc-embryo_cc_sc3.o `test -f 'embryo_cc_sc3.c' || echo '$(srcdir)/'`embryo_cc_sc3.c
435@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc3.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc3.Po
436@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
437@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc3.c' object='embryo_cc-embryo_cc_sc3.o' libtool=no @AMDEPBACKSLASH@
438@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
439@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc3.o `test -f 'embryo_cc_sc3.c' || echo '$(srcdir)/'`embryo_cc_sc3.c
440
441embryo_cc-embryo_cc_sc3.obj: embryo_cc_sc3.c
442@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc3.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc3.Tpo -c -o embryo_cc-embryo_cc_sc3.obj `if test -f 'embryo_cc_sc3.c'; then $(CYGPATH_W) 'embryo_cc_sc3.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc3.c'; fi`
443@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc3.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc3.Po
444@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
445@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc3.c' object='embryo_cc-embryo_cc_sc3.obj' libtool=no @AMDEPBACKSLASH@
446@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
447@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc3.obj `if test -f 'embryo_cc_sc3.c'; then $(CYGPATH_W) 'embryo_cc_sc3.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc3.c'; fi`
448
449embryo_cc-embryo_cc_sc4.o: embryo_cc_sc4.c
450@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc4.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc4.Tpo -c -o embryo_cc-embryo_cc_sc4.o `test -f 'embryo_cc_sc4.c' || echo '$(srcdir)/'`embryo_cc_sc4.c
451@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc4.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc4.Po
452@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
453@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc4.c' object='embryo_cc-embryo_cc_sc4.o' libtool=no @AMDEPBACKSLASH@
454@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
455@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc4.o `test -f 'embryo_cc_sc4.c' || echo '$(srcdir)/'`embryo_cc_sc4.c
456
457embryo_cc-embryo_cc_sc4.obj: embryo_cc_sc4.c
458@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc4.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc4.Tpo -c -o embryo_cc-embryo_cc_sc4.obj `if test -f 'embryo_cc_sc4.c'; then $(CYGPATH_W) 'embryo_cc_sc4.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc4.c'; fi`
459@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc4.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc4.Po
460@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
461@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc4.c' object='embryo_cc-embryo_cc_sc4.obj' libtool=no @AMDEPBACKSLASH@
462@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
463@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc4.obj `if test -f 'embryo_cc_sc4.c'; then $(CYGPATH_W) 'embryo_cc_sc4.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc4.c'; fi`
464
465embryo_cc-embryo_cc_sc5.o: embryo_cc_sc5.c
466@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc5.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc5.Tpo -c -o embryo_cc-embryo_cc_sc5.o `test -f 'embryo_cc_sc5.c' || echo '$(srcdir)/'`embryo_cc_sc5.c
467@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc5.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc5.Po
468@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
469@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc5.c' object='embryo_cc-embryo_cc_sc5.o' libtool=no @AMDEPBACKSLASH@
470@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
471@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc5.o `test -f 'embryo_cc_sc5.c' || echo '$(srcdir)/'`embryo_cc_sc5.c
472
473embryo_cc-embryo_cc_sc5.obj: embryo_cc_sc5.c
474@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc5.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc5.Tpo -c -o embryo_cc-embryo_cc_sc5.obj `if test -f 'embryo_cc_sc5.c'; then $(CYGPATH_W) 'embryo_cc_sc5.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc5.c'; fi`
475@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc5.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc5.Po
476@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
477@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc5.c' object='embryo_cc-embryo_cc_sc5.obj' libtool=no @AMDEPBACKSLASH@
478@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
479@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc5.obj `if test -f 'embryo_cc_sc5.c'; then $(CYGPATH_W) 'embryo_cc_sc5.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc5.c'; fi`
480
481embryo_cc-embryo_cc_sc6.o: embryo_cc_sc6.c
482@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc6.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc6.Tpo -c -o embryo_cc-embryo_cc_sc6.o `test -f 'embryo_cc_sc6.c' || echo '$(srcdir)/'`embryo_cc_sc6.c
483@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc6.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc6.Po
484@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
485@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc6.c' object='embryo_cc-embryo_cc_sc6.o' libtool=no @AMDEPBACKSLASH@
486@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
487@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc6.o `test -f 'embryo_cc_sc6.c' || echo '$(srcdir)/'`embryo_cc_sc6.c
488
489embryo_cc-embryo_cc_sc6.obj: embryo_cc_sc6.c
490@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc6.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc6.Tpo -c -o embryo_cc-embryo_cc_sc6.obj `if test -f 'embryo_cc_sc6.c'; then $(CYGPATH_W) 'embryo_cc_sc6.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc6.c'; fi`
491@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc6.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc6.Po
492@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
493@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc6.c' object='embryo_cc-embryo_cc_sc6.obj' libtool=no @AMDEPBACKSLASH@
494@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
495@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc6.obj `if test -f 'embryo_cc_sc6.c'; then $(CYGPATH_W) 'embryo_cc_sc6.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc6.c'; fi`
496
497embryo_cc-embryo_cc_sc7.o: embryo_cc_sc7.c
498@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc7.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc7.Tpo -c -o embryo_cc-embryo_cc_sc7.o `test -f 'embryo_cc_sc7.c' || echo '$(srcdir)/'`embryo_cc_sc7.c
499@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc7.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc7.Po
500@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
501@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc7.c' object='embryo_cc-embryo_cc_sc7.o' libtool=no @AMDEPBACKSLASH@
502@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
503@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc7.o `test -f 'embryo_cc_sc7.c' || echo '$(srcdir)/'`embryo_cc_sc7.c
504
505embryo_cc-embryo_cc_sc7.obj: embryo_cc_sc7.c
506@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sc7.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sc7.Tpo -c -o embryo_cc-embryo_cc_sc7.obj `if test -f 'embryo_cc_sc7.c'; then $(CYGPATH_W) 'embryo_cc_sc7.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc7.c'; fi`
507@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sc7.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sc7.Po
508@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
509@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sc7.c' object='embryo_cc-embryo_cc_sc7.obj' libtool=no @AMDEPBACKSLASH@
510@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
511@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sc7.obj `if test -f 'embryo_cc_sc7.c'; then $(CYGPATH_W) 'embryo_cc_sc7.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sc7.c'; fi`
512
513embryo_cc-embryo_cc_scexpand.o: embryo_cc_scexpand.c
514@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_scexpand.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_scexpand.Tpo -c -o embryo_cc-embryo_cc_scexpand.o `test -f 'embryo_cc_scexpand.c' || echo '$(srcdir)/'`embryo_cc_scexpand.c
515@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_scexpand.Tpo $(DEPDIR)/embryo_cc-embryo_cc_scexpand.Po
516@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
517@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_scexpand.c' object='embryo_cc-embryo_cc_scexpand.o' libtool=no @AMDEPBACKSLASH@
518@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
519@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_scexpand.o `test -f 'embryo_cc_scexpand.c' || echo '$(srcdir)/'`embryo_cc_scexpand.c
520
521embryo_cc-embryo_cc_scexpand.obj: embryo_cc_scexpand.c
522@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_scexpand.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_scexpand.Tpo -c -o embryo_cc-embryo_cc_scexpand.obj `if test -f 'embryo_cc_scexpand.c'; then $(CYGPATH_W) 'embryo_cc_scexpand.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_scexpand.c'; fi`
523@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_scexpand.Tpo $(DEPDIR)/embryo_cc-embryo_cc_scexpand.Po
524@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
525@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_scexpand.c' object='embryo_cc-embryo_cc_scexpand.obj' libtool=no @AMDEPBACKSLASH@
526@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
527@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_scexpand.obj `if test -f 'embryo_cc_scexpand.c'; then $(CYGPATH_W) 'embryo_cc_scexpand.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_scexpand.c'; fi`
528
529embryo_cc-embryo_cc_sclist.o: embryo_cc_sclist.c
530@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sclist.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sclist.Tpo -c -o embryo_cc-embryo_cc_sclist.o `test -f 'embryo_cc_sclist.c' || echo '$(srcdir)/'`embryo_cc_sclist.c
531@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sclist.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sclist.Po
532@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
533@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sclist.c' object='embryo_cc-embryo_cc_sclist.o' libtool=no @AMDEPBACKSLASH@
534@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
535@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sclist.o `test -f 'embryo_cc_sclist.c' || echo '$(srcdir)/'`embryo_cc_sclist.c
536
537embryo_cc-embryo_cc_sclist.obj: embryo_cc_sclist.c
538@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_sclist.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_sclist.Tpo -c -o embryo_cc-embryo_cc_sclist.obj `if test -f 'embryo_cc_sclist.c'; then $(CYGPATH_W) 'embryo_cc_sclist.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sclist.c'; fi`
539@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_sclist.Tpo $(DEPDIR)/embryo_cc-embryo_cc_sclist.Po
540@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
541@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_sclist.c' object='embryo_cc-embryo_cc_sclist.obj' libtool=no @AMDEPBACKSLASH@
542@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
543@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_sclist.obj `if test -f 'embryo_cc_sclist.c'; then $(CYGPATH_W) 'embryo_cc_sclist.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_sclist.c'; fi`
544
545embryo_cc-embryo_cc_scvars.o: embryo_cc_scvars.c
546@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_scvars.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_scvars.Tpo -c -o embryo_cc-embryo_cc_scvars.o `test -f 'embryo_cc_scvars.c' || echo '$(srcdir)/'`embryo_cc_scvars.c
547@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_scvars.Tpo $(DEPDIR)/embryo_cc-embryo_cc_scvars.Po
548@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
549@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_scvars.c' object='embryo_cc-embryo_cc_scvars.o' libtool=no @AMDEPBACKSLASH@
550@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
551@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_scvars.o `test -f 'embryo_cc_scvars.c' || echo '$(srcdir)/'`embryo_cc_scvars.c
552
553embryo_cc-embryo_cc_scvars.obj: embryo_cc_scvars.c
554@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_scvars.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_scvars.Tpo -c -o embryo_cc-embryo_cc_scvars.obj `if test -f 'embryo_cc_scvars.c'; then $(CYGPATH_W) 'embryo_cc_scvars.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_scvars.c'; fi`
555@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_scvars.Tpo $(DEPDIR)/embryo_cc-embryo_cc_scvars.Po
556@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
557@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_scvars.c' object='embryo_cc-embryo_cc_scvars.obj' libtool=no @AMDEPBACKSLASH@
558@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
559@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_scvars.obj `if test -f 'embryo_cc_scvars.c'; then $(CYGPATH_W) 'embryo_cc_scvars.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_scvars.c'; fi`
560
561embryo_cc-embryo_cc_prefix.o: embryo_cc_prefix.c
562@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_prefix.o -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_prefix.Tpo -c -o embryo_cc-embryo_cc_prefix.o `test -f 'embryo_cc_prefix.c' || echo '$(srcdir)/'`embryo_cc_prefix.c
563@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_prefix.Tpo $(DEPDIR)/embryo_cc-embryo_cc_prefix.Po
564@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
565@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_prefix.c' object='embryo_cc-embryo_cc_prefix.o' libtool=no @AMDEPBACKSLASH@
566@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
567@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_prefix.o `test -f 'embryo_cc_prefix.c' || echo '$(srcdir)/'`embryo_cc_prefix.c
568
569embryo_cc-embryo_cc_prefix.obj: embryo_cc_prefix.c
570@am__fastdepCC_TRUE@ $(AM_V_CC)$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -MT embryo_cc-embryo_cc_prefix.obj -MD -MP -MF $(DEPDIR)/embryo_cc-embryo_cc_prefix.Tpo -c -o embryo_cc-embryo_cc_prefix.obj `if test -f 'embryo_cc_prefix.c'; then $(CYGPATH_W) 'embryo_cc_prefix.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_prefix.c'; fi`
571@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/embryo_cc-embryo_cc_prefix.Tpo $(DEPDIR)/embryo_cc-embryo_cc_prefix.Po
572@am__fastdepCC_FALSE@ $(AM_V_CC) @AM_BACKSLASH@
573@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='embryo_cc_prefix.c' object='embryo_cc-embryo_cc_prefix.obj' libtool=no @AMDEPBACKSLASH@
574@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
575@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(embryo_cc_CFLAGS) $(CFLAGS) -c -o embryo_cc-embryo_cc_prefix.obj `if test -f 'embryo_cc_prefix.c'; then $(CYGPATH_W) 'embryo_cc_prefix.c'; else $(CYGPATH_W) '$(srcdir)/embryo_cc_prefix.c'; fi`
576
577mostlyclean-libtool:
578 -rm -f *.lo
579
580clean-libtool:
581 -rm -rf .libs _libs
582
583ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
584 list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
585 unique=`for i in $$list; do \
586 if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
587 done | \
588 $(AWK) '{ files[$$0] = 1; nonempty = 1; } \
589 END { if (nonempty) { for (i in files) print i; }; }'`; \
590 mkid -fID $$unique
591tags: TAGS
592
593TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
594 $(TAGS_FILES) $(LISP)
595 set x; \
596 here=`pwd`; \
597 list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
598 unique=`for i in $$list; do \
599 if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
600 done | \
601 $(AWK) '{ files[$$0] = 1; nonempty = 1; } \
602 END { if (nonempty) { for (i in files) print i; }; }'`; \
603 shift; \
604 if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
605 test -n "$$unique" || unique=$$empty_fix; \
606 if test $$# -gt 0; then \
607 $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
608 "$$@" $$unique; \
609 else \
610 $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
611 $$unique; \
612 fi; \
613 fi
614ctags: CTAGS
615CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \
616 $(TAGS_FILES) $(LISP)
617 list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \
618 unique=`for i in $$list; do \
619 if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
620 done | \
621 $(AWK) '{ files[$$0] = 1; nonempty = 1; } \
622 END { if (nonempty) { for (i in files) print i; }; }'`; \
623 test -z "$(CTAGS_ARGS)$$unique" \
624 || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
625 $$unique
626
627GTAGS:
628 here=`$(am__cd) $(top_builddir) && pwd` \
629 && $(am__cd) $(top_srcdir) \
630 && gtags -i $(GTAGS_ARGS) "$$here"
631
632distclean-tags:
633 -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
634
635distdir: $(DISTFILES)
636 @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
637 topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
638 list='$(DISTFILES)'; \
639 dist_files=`for file in $$list; do echo $$file; done | \
640 sed -e "s|^$$srcdirstrip/||;t" \
641 -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
642 case $$dist_files in \
643 */*) $(MKDIR_P) `echo "$$dist_files" | \
644 sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
645 sort -u` ;; \
646 esac; \
647 for file in $$dist_files; do \
648 if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
649 if test -d $$d/$$file; then \
650 dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
651 if test -d "$(distdir)/$$file"; then \
652 find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
653 fi; \
654 if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
655 cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
656 find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
657 fi; \
658 cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
659 else \
660 test -f "$(distdir)/$$file" \
661 || cp -p $$d/$$file "$(distdir)/$$file" \
662 || exit 1; \
663 fi; \
664 done
665check-am: all-am
666check: check-am
667all-am: Makefile $(PROGRAMS)
668installdirs:
669 for dir in "$(DESTDIR)$(bindir)"; do \
670 test -z "$$dir" || $(MKDIR_P) "$$dir"; \
671 done
672install: install-am
673install-exec: install-exec-am
674install-data: install-data-am
675uninstall: uninstall-am
676
677install-am: all-am
678 @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
679
680installcheck: installcheck-am
681install-strip:
682 $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
683 install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
684 `test -z '$(STRIP)' || \
685 echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install
686mostlyclean-generic:
687
688clean-generic:
689
690distclean-generic:
691 -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
692 -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
693
694maintainer-clean-generic:
695 @echo "This command is intended for maintainers to use"
696 @echo "it deletes files that may require special tools to rebuild."
697 -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES)
698clean: clean-am
699
700clean-am: clean-binPROGRAMS clean-generic clean-libtool mostlyclean-am
701
702distclean: distclean-am
703 -rm -rf ./$(DEPDIR)
704 -rm -f Makefile
705distclean-am: clean-am distclean-compile distclean-generic \
706 distclean-tags
707
708dvi: dvi-am
709
710dvi-am:
711
712html: html-am
713
714html-am:
715
716info: info-am
717
718info-am:
719
720install-data-am:
721
722install-dvi: install-dvi-am
723
724install-dvi-am:
725
726install-exec-am: install-binPROGRAMS
727
728install-html: install-html-am
729
730install-html-am:
731
732install-info: install-info-am
733
734install-info-am:
735
736install-man:
737
738install-pdf: install-pdf-am
739
740install-pdf-am:
741
742install-ps: install-ps-am
743
744install-ps-am:
745
746installcheck-am:
747
748maintainer-clean: maintainer-clean-am
749 -rm -rf ./$(DEPDIR)
750 -rm -f Makefile
751maintainer-clean-am: distclean-am maintainer-clean-generic
752
753mostlyclean: mostlyclean-am
754
755mostlyclean-am: mostlyclean-compile mostlyclean-generic \
756 mostlyclean-libtool
757
758pdf: pdf-am
759
760pdf-am:
761
762ps: ps-am
763
764ps-am:
765
766uninstall-am: uninstall-binPROGRAMS
767
768.MAKE: install-am install-strip
769
770.PHONY: CTAGS GTAGS all all-am check check-am clean clean-binPROGRAMS \
771 clean-generic clean-libtool ctags distclean distclean-compile \
772 distclean-generic distclean-libtool distclean-tags distdir dvi \
773 dvi-am html html-am info info-am install install-am \
774 install-binPROGRAMS install-data install-data-am install-dvi \
775 install-dvi-am install-exec install-exec-am install-html \
776 install-html-am install-info install-info-am install-man \
777 install-pdf install-pdf-am install-ps install-ps-am \
778 install-strip installcheck installcheck-am installdirs \
779 maintainer-clean maintainer-clean-generic mostlyclean \
780 mostlyclean-compile mostlyclean-generic mostlyclean-libtool \
781 pdf pdf-am ps ps-am tags uninstall uninstall-am \
782 uninstall-binPROGRAMS
783
784
785# Tell versions [3.59,3.63) of GNU make to not export all variables.
786# Otherwise a system limit (for SysV at least) may be exceeded.
787.NOEXPORT:
diff --git a/libraries/embryo/src/bin/embryo_cc_amx.h b/libraries/embryo/src/bin/embryo_cc_amx.h
new file mode 100644
index 0000000..c31b1cd
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_amx.h
@@ -0,0 +1,226 @@
1/* Abstract Machine for the Small compiler
2 *
3 * Copyright (c) ITB CompuPhase, 1997-2003
4 *
5 * This software is provided "as-is", without any express or implied warranty.
6 * In no event will the authors be held liable for any damages arising from
7 * the use of this software.
8 *
9 * Permission is granted to anyone to use this software for any purpose,
10 * including commercial applications, and to alter it and redistribute it
11 * freely, subject to the following restrictions:
12 *
13 * 1. The origin of this software must not be misrepresented; you must not
14 * claim that you wrote the original software. If you use this software in
15 * a product, an acknowledgment in the product documentation would be
16 * appreciated but is not required.
17 * 2. Altered source versions must be plainly marked as such, and must not be
18 * misrepresented as being the original software.
19 * 3. This notice may not be removed or altered from any source distribution.
20 *
21 * Version: $Id: embryo_cc_amx.h 51650 2010-08-26 01:34:13Z lucas $
22 */
23
24#ifndef EMBRYO_CC_AMX_H
25#define EMBRYO_CC_AMX_H
26
27#include <sys/types.h>
28
29/* calling convention for all interface functions and callback functions */
30
31/* File format version Required AMX version
32 * 0 (original version) 0
33 * 1 (opcodes JUMP.pri, SWITCH and CASETBL) 1
34 * 2 (compressed files) 2
35 * 3 (public variables) 2
36 * 4 (opcodes SWAP.pri/alt and PUSHADDR) 4
37 * 5 (tagnames table) 4
38 * 6 (reformatted header) 6
39 * 7 (name table, opcodes SYMTAG & SYSREQ.D) 7
40 */
41#define CUR_FILE_VERSION 7 /* current file version; also the current AMX version */
42#define MIN_FILE_VERSION 6 /* lowest supported file format version for the current AMX version */
43#define MIN_AMX_VERSION 7 /* minimum AMX version needed to support the current file format */
44
45#if !defined CELL_TYPE
46#define CELL_TYPE
47 typedef unsigned int ucell;
48 typedef int cell;
49#endif
50
51 struct tagAMX;
52 typedef cell(*AMX_NATIVE) (struct tagAMX * amx,
53 cell * params);
54 typedef int (* AMX_CALLBACK) (struct tagAMX * amx, cell index,
55 cell * result, cell * params);
56 typedef int (* AMX_DEBUG) (struct tagAMX * amx);
57
58 typedef struct
59 {
60 char *name;
61 AMX_NATIVE func ;
62 } AMX_NATIVE_INFO ;
63
64#define AMX_USERNUM 4
65#define sEXPMAX 19 /* maximum name length for file version <= 6 */
66#define sNAMEMAX 31 /* maximum name length of symbol name */
67
68#if defined (_MSC_VER) || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
69# pragma pack(1)
70# define EMBRYO_STRUCT_PACKED
71#elif defined (__GNUC__) || (defined (__SUNPRO_C) && __SUNPRO_C >= 0x5100)
72# define EMBRYO_STRUCT_PACKED __attribute__((packed))
73#else
74# define EMBRYO_STRUCT_PACKED
75#endif
76
77 typedef struct tagAMX_FUNCSTUB
78 {
79 unsigned int address;
80 char name[sEXPMAX + 1];
81 } EMBRYO_STRUCT_PACKED AMX_FUNCSTUB;
82
83/* The AMX structure is the internal structure for many functions. Not all
84 * fields are valid at all times; many fields are cached in local variables.
85 */
86 typedef struct tagAMX
87 {
88 unsigned char *base; /* points to the AMX header ("amxhdr") plus the code, optionally also the data */
89 unsigned char *data; /* points to separate data+stack+heap, may be NULL */
90 AMX_CALLBACK callback;
91 AMX_DEBUG debug ; /* debug callback */
92 /* for external functions a few registers must be accessible from the outside */
93 cell cip ; /* instruction pointer: relative to base + amxhdr->cod */
94 cell frm ; /* stack frame base: relative to base + amxhdr->dat */
95 cell hea ; /* top of the heap: relative to base + amxhdr->dat */
96 cell hlw ; /* bottom of the heap: relative to base + amxhdr->dat */
97 cell stk ; /* stack pointer: relative to base + amxhdr->dat */
98 cell stp ; /* top of the stack: relative to base + amxhdr->dat */
99 int flags ; /* current status, see amx_Flags() */
100 /* for assertions and debug hook */
101 cell curline ;
102 cell curfile ;
103 int dbgcode ;
104 cell dbgaddr ;
105 cell dbgparam ;
106 char *dbgname;
107 /* user data */
108 long usertags[AMX_USERNUM];
109 void *userdata[AMX_USERNUM];
110 /* native functions can raise an error */
111 int error ;
112 /* the sleep opcode needs to store the full AMX status */
113 cell pri ;
114 cell alt ;
115 cell reset_stk ;
116 cell reset_hea ;
117 cell *syscall_d; /* relocated value/address for the SYSCALL.D opcode */
118 } EMBRYO_STRUCT_PACKED AMX;
119
120/* The AMX_HEADER structure is both the memory format as the file format. The
121 * structure is used internaly.
122 */
123 typedef struct tagAMX_HEADER
124 {
125 int size ; /* size of the "file" */
126 unsigned short magic ; /* signature */
127 char file_version ; /* file format version */
128 char amx_version ; /* required version of the AMX */
129 unsigned short flags ;
130 unsigned short defsize ; /* size of a definition record */
131 int cod ; /* initial value of COD - code block */
132 int dat ; /* initial value of DAT - data block */
133 int hea ; /* initial value of HEA - start of the heap */
134 int stp ; /* initial value of STP - stack top */
135 int cip ; /* initial value of CIP - the instruction pointer */
136 int publics ; /* offset to the "public functions" table */
137 int natives ; /* offset to the "native functions" table */
138 int libraries ; /* offset to the table of libraries */
139 int pubvars ; /* the "public variables" table */
140 int tags ; /* the "public tagnames" table */
141 int nametable ; /* name table, file version 7 only */
142 } EMBRYO_STRUCT_PACKED AMX_HEADER;
143
144#if defined _MSC_VER || (defined (__SUNPRO_C) && __SUNPRO_C < 0x5100)
145# pragma pack()
146#endif
147
148#define AMX_MAGIC 0xf1e0
149
150 enum
151 {
152 AMX_ERR_NONE,
153 /* reserve the first 15 error codes for exit codes of the abstract machine */
154 AMX_ERR_EXIT, /* forced exit */
155 AMX_ERR_ASSERT, /* assertion failed */
156 AMX_ERR_STACKERR, /* stack/heap collision */
157 AMX_ERR_BOUNDS, /* index out of bounds */
158 AMX_ERR_MEMACCESS, /* invalid memory access */
159 AMX_ERR_INVINSTR, /* invalid instruction */
160 AMX_ERR_STACKLOW, /* stack underflow */
161 AMX_ERR_HEAPLOW, /* heap underflow */
162 AMX_ERR_CALLBACK, /* no callback, or invalid callback */
163 AMX_ERR_NATIVE, /* native function failed */
164 AMX_ERR_DIVIDE, /* divide by zero */
165 AMX_ERR_SLEEP, /* go into sleepmode - code can be restarted */
166
167 AMX_ERR_MEMORY = 16, /* out of memory */
168 AMX_ERR_FORMAT, /* invalid file format */
169 AMX_ERR_VERSION, /* file is for a newer version of the AMX */
170 AMX_ERR_NOTFOUND, /* function not found */
171 AMX_ERR_INDEX, /* invalid index parameter (bad entry point) */
172 AMX_ERR_DEBUG, /* debugger cannot run */
173 AMX_ERR_INIT, /* AMX not initialized (or doubly initialized) */
174 AMX_ERR_USERDATA, /* unable to set user data field (table full) */
175 AMX_ERR_INIT_JIT, /* cannot initialize the JIT */
176 AMX_ERR_PARAMS, /* parameter error */
177 AMX_ERR_DOMAIN, /* domain error, expression result does not fit in range */
178 };
179
180 enum
181 {
182 DBG_INIT, /* query/initialize */
183 DBG_FILE, /* file number in curfile, filename in name */
184 DBG_LINE, /* line number in curline, file number in curfile */
185 DBG_SYMBOL, /* address in dbgaddr, class/type in dbgparam */
186 DBG_CLRSYM, /* stack address below which locals should be removed. stack address in stk */
187 DBG_CALL, /* function call, address jumped to in dbgaddr */
188 DBG_RETURN, /* function returns */
189 DBG_TERMINATE, /* program ends, code address in dbgaddr, reason in dbgparam */
190 DBG_SRANGE, /* symbol size and dimensions (arrays); level in dbgaddr (!); length in dbgparam */
191 DBG_SYMTAG, /* tag of the most recent symbol (if non-zero), tag in dbgparam */
192 };
193
194#define AMX_FLAG_CHAR16 0x01 /* characters are 16-bit */
195#define AMX_FLAG_DEBUG 0x02 /* symbolic info. available */
196#define AMX_FLAG_COMPACT 0x04 /* compact encoding */
197#define AMX_FLAG_BIGENDIAN 0x08 /* big endian encoding */
198#define AMX_FLAG_NOCHECKS 0x10 /* no array bounds checking */
199#define AMX_FLAG_BROWSE 0x4000 /* browsing/relocating or executing */
200#define AMX_FLAG_RELOC 0x8000 /* jump/call addresses relocated */
201
202#define AMX_EXEC_MAIN -1 /* start at program entry point */
203#define AMX_EXEC_CONT -2 /* continue from last address */
204
205#define AMX_USERTAG(a,b,c,d) ((a) | ((b)<<8) | ((long)(c)<<16) | ((long)(d)<<24))
206
207#define AMX_EXPANDMARGIN 64
208
209/* for native functions that use floating point parameters, the following
210 * two macros are convenient for casting a "cell" into a "float" type _without_
211 * changing the bit pattern
212 */
213#define amx_ftoc(f) ( * ((cell*)&f) ) /* float to cell */
214#define amx_ctof(c) ( * ((float*)&c) ) /* cell to float */
215
216#define amx_StrParam(amx,param,result) { \
217 cell *amx_cstr_; int amx_length_; \
218 amx_GetAddr((amx), (param), &amx_cstr_); \
219 amx_StrLen(amx_cstr_, &amx_length_); \
220 if (amx_length_ > 0 && \
221 ((result) = (char *)alloca(amx_length_ + 1))) \
222 amx_GetString((result), amx_cstr_); \
223 else (result) = NULL; \
224}
225
226#endif /* __AMX_H */
diff --git a/libraries/embryo/src/bin/embryo_cc_prefix.c b/libraries/embryo/src/bin/embryo_cc_prefix.c
new file mode 100644
index 0000000..9b57704
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_prefix.c
@@ -0,0 +1,61 @@
1#ifdef HAVE_CONFIG_H
2# include <config.h>
3#endif
4
5#include <Eina.h>
6
7#include "embryo_cc_prefix.h"
8
9/* local subsystem functions */
10
11/* local subsystem globals */
12
13static Eina_Prefix *pfx = NULL;
14
15/* externally accessible functions */
16int
17e_prefix_determine(char *argv0)
18{
19 if (pfx) return 1;
20 eina_init();
21 pfx = eina_prefix_new(argv0, e_prefix_determine,
22 "EMBRYO", "embryo", "include/default.inc",
23 PACKAGE_BIN_DIR,
24 PACKAGE_LIB_DIR,
25 PACKAGE_DATA_DIR,
26 PACKAGE_DATA_DIR);
27 if (!pfx) return 0;
28 return 1;
29}
30
31void
32e_prefix_shutdown(void)
33{
34 eina_prefix_free(pfx);
35 pfx = NULL;
36 eina_shutdown();
37}
38
39const char *
40e_prefix_get(void)
41{
42 return eina_prefix_get(pfx);
43}
44
45const char *
46e_prefix_bin_get(void)
47{
48 return eina_prefix_bin_get(pfx);
49}
50
51const char *
52e_prefix_data_get(void)
53{
54 return eina_prefix_data_get(pfx);
55}
56
57const char *
58e_prefix_lib_get(void)
59{
60 return eina_prefix_lib_get(pfx);
61}
diff --git a/libraries/embryo/src/bin/embryo_cc_prefix.h b/libraries/embryo/src/bin/embryo_cc_prefix.h
new file mode 100644
index 0000000..d6dc7b2
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_prefix.h
@@ -0,0 +1,6 @@
1int e_prefix_determine(char *argv0);
2void e_prefix_shutdown(void);
3const char *e_prefix_get(void);
4const char *e_prefix_bin_get(void);
5const char *e_prefix_data_get(void);
6const char *e_prefix_lib_get(void);
diff --git a/libraries/embryo/src/bin/embryo_cc_sc.h b/libraries/embryo/src/bin/embryo_cc_sc.h
new file mode 100644
index 0000000..e62cbc3
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc.h
@@ -0,0 +1,667 @@
1/* Small compiler
2 *
3 * Drafted after the Small-C compiler Version 2.01, originally created
4 * by Ron Cain, july 1980, and enhanced by James E. Hendrix.
5 *
6 * This version comes close to a complete rewrite.
7 *
8 * Copyright R. Cain, 1980
9 * Copyright J.E. Hendrix, 1982, 1983
10 * Copyright T. Riemersma, 1997-2003
11 *
12 * Version: $Id: embryo_cc_sc.h 59489 2011-05-18 08:37:38Z raster $
13 *
14 * This software is provided "as-is", without any express or implied warranty.
15 * In no event will the authors be held liable for any damages arising from
16 * the use of this software.
17 *
18 * Permission is granted to anyone to use this software for any purpose,
19 * including commercial applications, and to alter it and redistribute it
20 * freely, subject to the following restrictions:
21 *
22 * 1. The origin of this software must not be misrepresented; you must not
23 * claim that you wrote the original software. If you use this software in
24 * a product, an acknowledgment in the product documentation would be
25 * appreciated but is not required.
26 * 2. Altered source versions must be plainly marked as such, and must not be
27 * misrepresented as being the original software.
28 * 3. This notice may not be removed or altered from any source distribution.
29 */
30
31#ifndef EMBRYO_CC_SC_H
32#define EMBRYO_CC_SC_H
33
34#include <limits.h>
35#include <stdarg.h>
36#include <stdio.h>
37#include <setjmp.h>
38
39#ifndef _MSC_VER
40# include <stdint.h>
41#else
42# include <stddef.h>
43# include <Evil.h>
44#endif
45
46#include "embryo_cc_amx.h"
47
48/* Note: the "cell" and "ucell" types are defined in AMX.H */
49
50#define PUBLIC_CHAR '@' /* character that defines a function "public" */
51#define CTRL_CHAR '\\' /* default control character */
52
53#define DIRSEP_CHAR '/' /* directory separator character */
54
55#define sDIMEN_MAX 2 /* maximum number of array dimensions */
56#define sDEF_LITMAX 500 /* initial size of the literal pool, in "cells" */
57#define sLINEMAX (640 * 1024) /* input line length (in characters) */
58#define sDEF_AMXSTACK 4096 /* default stack size for AMX files */
59#define sSTKMAX 80 /* stack for nested #includes and other uses */
60#define PREPROC_TERM '\x7f' /* termination character for preprocessor expressions (the "DEL" code) */
61#define sDEF_PREFIX "default.inc" /* default prefix filename */
62
63typedef intptr_t stkitem; /* type of items stored on the stack */
64
65typedef struct __s_arginfo
66{ /* function argument info */
67 char name[sNAMEMAX + 1];
68 char ident; /* iVARIABLE, iREFERENCE, iREFARRAY or iVARARGS */
69 char usage; /* uCONST */
70 int *tags; /* argument tag id. list */
71 int numtags; /* number of tags in the tag list */
72 int dim[sDIMEN_MAX];
73 int numdim; /* number of dimensions */
74 unsigned char hasdefault; /* bit0: is there a default value? bit6: "tagof"; bit7: "sizeof" */
75 union
76 {
77 cell val; /* default value */
78 struct
79 {
80 char *symname; /* name of another symbol */
81 short level; /* indirection level for that symbol */
82 } size; /* used for "sizeof" default value */
83 struct
84 {
85 cell *data; /* values of default array */
86 int size; /* complete length of default array */
87 int arraysize; /* size to reserve on the heap */
88 cell addr; /* address of the default array in the data segment */
89 } array;
90 } defvalue; /* default value, or pointer to default array */
91 int defvalue_tag; /* tag of the default value */
92} arginfo;
93
94/* Equate table, tagname table, library table */
95typedef struct __s_constvalue
96{
97 struct __s_constvalue *next;
98 char name[sNAMEMAX + 1];
99 cell value;
100 short index;
101} constvalue;
102
103/* Symbol table format
104 *
105 * The symbol name read from the input file is stored in "name", the
106 * value of "addr" is written to the output file. The address in "addr"
107 * depends on the class of the symbol:
108 * global offset into the data segment
109 * local offset relative to the stack frame
110 * label generated hexadecimal number
111 * function offset into code segment
112 */
113typedef struct __s_symbol
114{
115 struct __s_symbol *next;
116 struct __s_symbol *parent; /* hierarchical types (multi-dimensional arrays) */
117 char name[sNAMEMAX + 1];
118 unsigned int hash; /* value derived from name, for quicker searching */
119 cell addr; /* address or offset (or value for constant, index for native function) */
120 char vclass; /* sLOCAL if "addr" refers to a local symbol */
121 char ident; /* see below for possible values */
122 char usage; /* see below for possible values */
123 int compound; /* compound level (braces nesting level) */
124 int tag; /* tagname id */
125 union
126 {
127 int declared; /* label: how many local variables are declared */
128 int idxtag; /* array: tag of array indices */
129 constvalue *lib; /* native function: library it is part of *///??? use "stringlist"
130 } x; /* 'x' for 'extra' */
131 union
132 {
133 arginfo *arglist; /* types of all parameters for functions */
134 struct
135 {
136 cell length; /* arrays: length (size) */
137 short level; /* number of dimensions below this level */
138 } array;
139 } dim; /* for 'dimension', both functions and arrays */
140 int fnumber; /* static global variables: file number in which the declaration is visible */
141 struct __s_symbol **refer; /* referrer list, functions that "use" this symbol */
142 int numrefers; /* number of entries in the referrer list */
143} symbol;
144
145/* Possible entries for "ident". These are used in the "symbol", "value"
146 * and arginfo structures. Not every constant is valid for every use.
147 * In an argument list, the list is terminated with a "zero" ident; labels
148 * cannot be passed as function arguments, so the value 0 is overloaded.
149 */
150#define iLABEL 0
151#define iVARIABLE 1 /* cell that has an address and that can be fetched directly (lvalue) */
152#define iREFERENCE 2 /* iVARIABLE, but must be dereferenced */
153#define iARRAY 3
154#define iREFARRAY 4 /* an array passed by reference (i.e. a pointer) */
155#define iARRAYCELL 5 /* array element, cell that must be fetched indirectly */
156#define iARRAYCHAR 6 /* array element, character from cell from array */
157#define iEXPRESSION 7 /* expression result, has no address (rvalue) */
158#define iCONSTEXPR 8 /* constant expression (or constant symbol) */
159#define iFUNCTN 9
160#define iREFFUNC 10 /* function passed as a parameter */
161#define iVARARGS 11 /* function specified ... as argument(s) */
162
163/* Possible entries for "usage"
164 *
165 * This byte is used as a serie of bits, the syntax is different for
166 * functions and other symbols:
167 *
168 * VARIABLE
169 * bits: 0 (uDEFINE) the variable is defined in the source file
170 * 1 (uREAD) the variable is "read" (accessed) in the source file
171 * 2 (uWRITTEN) the variable is altered (assigned a value)
172 * 3 (uCONST) the variable is constant (may not be assigned to)
173 * 4 (uPUBLIC) the variable is public
174 * 6 (uSTOCK) the variable is discardable (without warning)
175 *
176 * FUNCTION
177 * bits: 0 (uDEFINE) the function is defined ("implemented") in the source file
178 * 1 (uREAD) the function is invoked in the source file
179 * 2 (uRETVALUE) the function returns a value (or should return a value)
180 * 3 (uPROTOTYPED) the function was prototyped
181 * 4 (uPUBLIC) the function is public
182 * 5 (uNATIVE) the function is native
183 * 6 (uSTOCK) the function is discardable (without warning)
184 * 7 (uMISSING) the function is not implemented in this source file
185 *
186 * CONSTANT
187 * bits: 0 (uDEFINE) the symbol is defined in the source file
188 * 1 (uREAD) the constant is "read" (accessed) in the source file
189 * 3 (uPREDEF) the constant is pre-defined and should be kept between passes
190 */
191#define uDEFINE 0x01
192#define uREAD 0x02
193#define uWRITTEN 0x04
194#define uRETVALUE 0x04 /* function returns (or should return) a value */
195#define uCONST 0x08
196#define uPROTOTYPED 0x08
197#define uPREDEF 0x08 /* constant is pre-defined */
198#define uPUBLIC 0x10
199#define uNATIVE 0x20
200#define uSTOCK 0x40
201#define uMISSING 0x80
202/* uRETNONE is not stored in the "usage" field of a symbol. It is
203 * used during parsing a function, to detect a mix of "return;" and
204 * "return value;" in a few special cases.
205 */
206#define uRETNONE 0x10
207
208#define uTAGOF 0x40 /* set in the "hasdefault" field of the arginfo struct */
209#define uSIZEOF 0x80 /* set in the "hasdefault" field of the arginfo struct */
210
211#define uMAINFUNC "main"
212
213#define sGLOBAL 0 /* global/local variable/constant class */
214#define sLOCAL 1
215#define sSTATIC 2 /* global life, local scope */
216
217typedef struct
218{
219 symbol *sym; /* symbol in symbol table, NULL for (constant) expression */
220 cell constval; /* value of the constant expression (if ident==iCONSTEXPR)
221 * also used for the size of a literal array */
222 int tag; /* tagname id (of the expression) */
223 char ident; /* iCONSTEXPR, iVARIABLE, iARRAY, iARRAYCELL,
224 * iEXPRESSION or iREFERENCE */
225 char boolresult; /* boolean result for relational operators */
226 cell *arrayidx; /* last used array indices, for checking self assignment */
227} value;
228
229/* "while" statement queue (also used for "for" and "do - while" loops) */
230enum
231{
232 wqBRK, /* used to restore stack for "break" */
233 wqCONT, /* used to restore stack for "continue" */
234 wqLOOP, /* loop start label number */
235 wqEXIT, /* loop exit label number (jump if false) */
236 /* --- */
237 wqSIZE /* "while queue" size */
238};
239
240#define wqTABSZ (24*wqSIZE) /* 24 nested loop statements */
241
242enum
243{
244 statIDLE, /* not compiling yet */
245 statFIRST, /* first pass */
246 statWRITE, /* writing output */
247 statSKIP, /* skipping output */
248};
249
250typedef struct __s_stringlist
251{
252 struct __s_stringlist *next;
253 char *line;
254} stringlist;
255
256typedef struct __s_stringpair
257{
258 struct __s_stringpair *next;
259 char *first;
260 char *second;
261 int matchlength;
262} stringpair;
263
264/* macros for code generation */
265#define opcodes(n) ((n)*sizeof(cell)) /* opcode size */
266#define opargs(n) ((n)*sizeof(cell)) /* size of typical argument */
267
268/* Tokens recognized by lex()
269 * Some of these constants are assigned as well to the variable "lastst"
270 */
271#define tFIRST 256 /* value of first multi-character operator */
272#define tMIDDLE 279 /* value of last multi-character operator */
273#define tLAST 320 /* value of last multi-character match-able token */
274/* multi-character operators */
275#define taMULT 256 /* *= */
276#define taDIV 257 /* /= */
277#define taMOD 258 /* %= */
278#define taADD 259 /* += */
279#define taSUB 260 /* -= */
280#define taSHL 261 /* <<= */
281#define taSHRU 262 /* >>>= */
282#define taSHR 263 /* >>= */
283#define taAND 264 /* &= */
284#define taXOR 265 /* ^= */
285#define taOR 266 /* |= */
286#define tlOR 267 /* || */
287#define tlAND 268 /* && */
288#define tlEQ 269 /* == */
289#define tlNE 270 /* != */
290#define tlLE 271 /* <= */
291#define tlGE 272 /* >= */
292#define tSHL 273 /* << */
293#define tSHRU 274 /* >>> */
294#define tSHR 275 /* >> */
295#define tINC 276 /* ++ */
296#define tDEC 277 /* -- */
297#define tELLIPS 278 /* ... */
298#define tDBLDOT 279 /* .. */
299/* reserved words (statements) */
300#define tASSERT 280
301#define tBREAK 281
302#define tCASE 282
303#define tCHAR 283
304#define tCONST 284
305#define tCONTINUE 285
306#define tDEFAULT 286
307#define tDEFINED 287
308#define tDO 288
309#define tELSE 289
310#define tENUM 290
311#define tEXIT 291
312#define tFOR 292
313#define tFORWARD 293
314#define tGOTO 294
315#define tIF 295
316#define tNATIVE 296
317#define tNEW 297
318#define tOPERATOR 298
319#define tPUBLIC 299
320#define tRETURN 300
321#define tSIZEOF 301
322#define tSLEEP 302
323#define tSTATIC 303
324#define tSTOCK 304
325#define tSWITCH 305
326#define tTAGOF 306
327#define tWHILE 307
328/* compiler directives */
329#define tpASSERT 308 /* #assert */
330#define tpDEFINE 309
331#define tpELSE 310 /* #else */
332#define tpEMIT 311
333#define tpENDIF 312
334#define tpENDINPUT 313
335#define tpENDSCRPT 314
336#define tpFILE 315
337#define tpIF 316 /* #if */
338#define tINCLUDE 317
339#define tpLINE 318
340#define tpPRAGMA 319
341#define tpUNDEF 320
342/* semicolon is a special case, because it can be optional */
343#define tTERM 321 /* semicolon or newline */
344#define tENDEXPR 322 /* forced end of expression */
345/* other recognized tokens */
346#define tNUMBER 323 /* integer number */
347#define tRATIONAL 324 /* rational number */
348#define tSYMBOL 325
349#define tLABEL 326
350#define tSTRING 327
351#define tEXPR 328 /* for assigment to "lastst" only */
352
353/* (reversed) evaluation of staging buffer */
354#define sSTARTREORDER 1
355#define sENDREORDER 2
356#define sEXPRSTART 0xc0 /* top 2 bits set, rest is free */
357#define sMAXARGS 64 /* relates to the bit pattern of sEXPRSTART */
358
359/* codes for ffabort() */
360#define xEXIT 1 /* exit code in PRI */
361#define xASSERTION 2 /* abort caused by failing assertion */
362#define xSTACKERROR 3 /* stack/heap overflow */
363#define xBOUNDSERROR 4 /* array index out of bounds */
364#define xMEMACCESS 5 /* data access error */
365#define xINVINSTR 6 /* invalid instruction */
366#define xSTACKUNDERFLOW 7 /* stack underflow */
367#define xHEAPUNDERFLOW 8 /* heap underflow */
368#define xCALLBACKERR 9 /* no, or invalid, callback */
369#define xSLEEP 12 /* sleep, exit code in PRI, tag in ALT */
370
371/* Miscellaneous */
372#if !defined TRUE
373#define FALSE 0
374#define TRUE 1
375#endif
376#define sIN_CSEG 1 /* if parsing CODE */
377#define sIN_DSEG 2 /* if parsing DATA */
378#define sCHKBOUNDS 1 /* bit position in "debug" variable: check bounds */
379#define sSYMBOLIC 2 /* bit position in "debug" variable: symbolic info */
380#define sNOOPTIMIZE 4 /* bit position in "debug" variable: no optimization */
381#define sRESET 0 /* reset error flag */
382#define sFORCESET 1 /* force error flag on */
383#define sEXPRMARK 2 /* mark start of expression */
384#define sEXPRRELEASE 3 /* mark end of expression */
385
386#if INT_MAX<0x8000u
387#define PUBLICTAG 0x8000u
388#define FIXEDTAG 0x4000u
389#else
390#define PUBLICTAG 0x80000000Lu
391#define FIXEDTAG 0x40000000Lu
392#endif
393#define TAGMASK (~PUBLICTAG)
394
395
396/*
397 * Functions you call from the "driver" program
398 */
399 int sc_compile(int argc, char **argv);
400 int sc_addconstant(char *name, cell value, int tag);
401 int sc_addtag(char *name);
402
403/*
404 * Functions called from the compiler (to be implemented by you)
405 */
406
407/* general console output */
408 int sc_printf(const char *message, ...);
409
410/* error report function */
411 int sc_error(int number, char *message, char *filename,
412 int firstline, int lastline, va_list argptr);
413
414/* input from source file */
415 void *sc_opensrc(char *filename); /* reading only */
416 void sc_closesrc(void *handle); /* never delete */
417 void sc_resetsrc(void *handle, void *position); /* reset to a position marked earlier */
418 char *sc_readsrc(void *handle, char *target, int maxchars);
419 void *sc_getpossrc(void *handle); /* mark the current position */
420 int sc_eofsrc(void *handle);
421
422/* output to intermediate (.ASM) file */
423 void *sc_openasm(int fd); /* read/write */
424 void sc_closeasm(void *handle);
425 void sc_resetasm(void *handle);
426 int sc_writeasm(void *handle, char *str);
427 char *sc_readasm(void *handle, char *target, int maxchars);
428
429/* output to binary (.AMX) file */
430 void *sc_openbin(char *filename);
431 void sc_closebin(void *handle, int deletefile);
432 void sc_resetbin(void *handle);
433 int sc_writebin(void *handle, void *buffer, int size);
434 long sc_lengthbin(void *handle); /* return the length of the file */
435
436/* function prototypes in SC1.C */
437symbol *fetchfunc(char *name, int tag);
438char *operator_symname(char *symname, char *opername, int tag1,
439 int tag2, int numtags, int resulttag);
440char *funcdisplayname(char *dest, char *funcname);
441int constexpr(cell * val, int *tag);
442constvalue *append_constval(constvalue * table, char *name, cell val,
443 short index);
444constvalue *find_constval(constvalue * table, char *name, short index);
445void delete_consttable(constvalue * table);
446void add_constant(char *name, cell val, int vclass, int tag);
447void exporttag(int tag);
448
449/* function prototypes in SC2.C */
450void pushstk(stkitem val);
451stkitem popstk(void);
452int plungequalifiedfile(char *name); /* explicit path included */
453int plungefile(char *name, int try_currentpath, int try_includepaths); /* search through "include" paths */
454void preprocess(void);
455void lexinit(void);
456int lex(cell * lexvalue, char **lexsym);
457void lexpush(void);
458void lexclr(int clreol);
459int matchtoken(int token);
460int tokeninfo(cell * val, char **str);
461int needtoken(int token);
462void stowlit(cell value);
463int alphanum(char c);
464void delete_symbol(symbol * root, symbol * sym);
465void delete_symbols(symbol * root, int level, int del_labels,
466 int delete_functions);
467int refer_symbol(symbol * entry, symbol * bywhom);
468void markusage(symbol * sym, int usage);
469unsigned int namehash(char *name);
470symbol *findglb(char *name);
471symbol *findloc(char *name);
472symbol *findconst(char *name);
473symbol *finddepend(symbol * parent);
474symbol *addsym(char *name, cell addr, int ident, int vclass,
475 int tag, int usage);
476symbol *addvariable(char *name, cell addr, int ident, int vclass,
477 int tag, int dim[], int numdim, int idxtag[]);
478int getlabel(void);
479char *itoh(ucell val);
480
481/* function prototypes in SC3.C */
482int check_userop(void (*oper) (void), int tag1, int tag2,
483 int numparam, value * lval, int *resulttag);
484int matchtag(int formaltag, int actualtag, int allowcoerce);
485int expression(int *constant, cell * val, int *tag,
486 int chkfuncresult);
487int hier14(value * lval1); /* the highest expression level */
488
489/* function prototypes in SC4.C */
490void writeleader(void);
491void writetrailer(void);
492void begcseg(void);
493void begdseg(void);
494void setactivefile(int fnumber);
495cell nameincells(char *name);
496void setfile(char *name, int fileno);
497void setline(int line, int fileno);
498void setlabel(int index);
499void endexpr(int fullexpr);
500void startfunc(char *fname);
501void endfunc(void);
502void alignframe(int numbytes);
503void defsymbol(char *name, int ident, int vclass, cell offset,
504 int tag);
505void symbolrange(int level, cell size);
506void rvalue(value * lval);
507void address(symbol * ptr);
508void store(value * lval);
509void memcopy(cell size);
510void copyarray(symbol * sym, cell size);
511void fillarray(symbol * sym, cell size, cell value);
512void const1(cell val);
513void const2(cell val);
514void moveto1(void);
515void push1(void);
516void push2(void);
517void pushval(cell val);
518void pop1(void);
519void pop2(void);
520void swap1(void);
521void ffswitch(int label);
522void ffcase(cell value, char *labelname, int newtable);
523void ffcall(symbol * sym, int numargs);
524void ffret(void);
525void ffabort(int reason);
526void ffbounds(cell size);
527void jumplabel(int number);
528void defstorage(void);
529void modstk(int delta);
530void setstk(cell value);
531void modheap(int delta);
532void setheap_pri(void);
533void setheap(cell value);
534void cell2addr(void);
535void cell2addr_alt(void);
536void addr2cell(void);
537void char2addr(void);
538void charalign(void);
539void addconst(cell value);
540
541/* Code generation functions for arithmetic operators.
542 *
543 * Syntax: o[u|s|b]_name
544 * | | | +--- name of operator
545 * | | +----- underscore
546 * | +--------- "u"nsigned operator, "s"igned operator or "b"oth
547 * +------------- "o"perator
548 */
549void os_mult(void); /* multiplication (signed) */
550void os_div(void); /* division (signed) */
551void os_mod(void); /* modulus (signed) */
552void ob_add(void); /* addition */
553void ob_sub(void); /* subtraction */
554void ob_sal(void); /* shift left (arithmetic) */
555void os_sar(void); /* shift right (arithmetic, signed) */
556void ou_sar(void); /* shift right (logical, unsigned) */
557void ob_or(void); /* bitwise or */
558void ob_xor(void); /* bitwise xor */
559void ob_and(void); /* bitwise and */
560void ob_eq(void); /* equality */
561void ob_ne(void); /* inequality */
562void relop_prefix(void);
563void relop_suffix(void);
564void os_le(void); /* less or equal (signed) */
565void os_ge(void); /* greater or equal (signed) */
566void os_lt(void); /* less (signed) */
567void os_gt(void); /* greater (signed) */
568
569void lneg(void);
570void neg(void);
571void invert(void);
572void nooperation(void);
573void inc(value * lval);
574void dec(value * lval);
575void jmp_ne0(int number);
576void jmp_eq0(int number);
577void outval(cell val, int newline);
578
579/* function prototypes in SC5.C */
580int error(int number, ...);
581void errorset(int code);
582
583/* function prototypes in SC6.C */
584void assemble(FILE * fout, FILE * fin);
585
586/* function prototypes in SC7.C */
587void stgbuffer_cleanup(void);
588void stgmark(char mark);
589void stgwrite(char *st);
590void stgout(int index);
591void stgdel(int index, cell code_index);
592int stgget(int *index, cell * code_index);
593void stgset(int onoff);
594int phopt_init(void);
595int phopt_cleanup(void);
596
597/* function prototypes in SCLIST.C */
598stringpair *insert_alias(char *name, char *alias);
599stringpair *find_alias(char *name);
600int lookup_alias(char *target, char *name);
601void delete_aliastable(void);
602stringlist *insert_path(char *path);
603char *get_path(int index);
604void delete_pathtable(void);
605stringpair *insert_subst(char *pattern, char *substitution,
606 int prefixlen);
607int get_subst(int index, char **pattern, char **substitution);
608stringpair *find_subst(char *name, int length);
609int delete_subst(char *name, int length);
610void delete_substtable(void);
611
612/* external variables (defined in scvars.c) */
613extern symbol loctab; /* local symbol table */
614extern symbol glbtab; /* global symbol table */
615extern cell *litq; /* the literal queue */
616extern char pline[]; /* the line read from the input file */
617extern char *lptr; /* points to the current position in "pline" */
618extern constvalue tagname_tab; /* tagname table */
619extern constvalue libname_tab; /* library table (#pragma library "..." syntax) *///??? use "stringlist" type
620extern constvalue *curlibrary; /* current library */
621extern symbol *curfunc; /* pointer to current function */
622extern char *inpfname; /* name of the file currently read from */
623extern char outfname[]; /* output file name */
624extern char sc_ctrlchar; /* the control character (or escape character) */
625extern int litidx; /* index to literal table */
626extern int litmax; /* current size of the literal table */
627extern int stgidx; /* index to the staging buffer */
628extern int labnum; /* number of (internal) labels */
629extern int staging; /* true if staging output */
630extern cell declared; /* number of local cells declared */
631extern cell glb_declared; /* number of global cells declared */
632extern cell code_idx; /* number of bytes with generated code */
633extern int ntv_funcid; /* incremental number of native function */
634extern int errnum; /* number of errors */
635extern int warnnum; /* number of warnings */
636extern int sc_debug; /* debug/optimization options (bit field) */
637extern int charbits; /* number of bits for a character */
638extern int sc_packstr; /* strings are packed by default? */
639extern int sc_asmfile; /* create .ASM file? */
640extern int sc_listing; /* create .LST file? */
641extern int sc_compress; /* compress bytecode? */
642extern int sc_needsemicolon; /* semicolon required to terminate expressions? */
643extern int sc_dataalign; /* data alignment value */
644extern int sc_alignnext; /* must frame of the next function be aligned? */
645extern int curseg; /* 1 if currently parsing CODE, 2 if parsing DATA */
646extern cell sc_stksize; /* stack size */
647extern int freading; /* is there an input file ready for reading? */
648extern int fline; /* the line number in the current file */
649extern int fnumber; /* number of files in the file table (debugging) */
650extern int fcurrent; /* current file being processed (debugging) */
651extern int intest; /* true if inside a test */
652extern int sideeffect; /* true if an expression causes a side-effect */
653extern int stmtindent; /* current indent of the statement */
654extern int indent_nowarn; /* skip warning "217 loose indentation" */
655extern int sc_tabsize; /* number of spaces that a TAB represents */
656extern int sc_allowtags; /* allow/detect tagnames in lex() */
657extern int sc_status; /* read/write status */
658extern int sc_rationaltag; /* tag for rational numbers */
659extern int rational_digits; /* number of fractional digits */
660
661extern FILE *inpf; /* file read from (source or include) */
662extern FILE *inpf_org; /* main source file */
663extern FILE *outf; /* file written to */
664
665extern jmp_buf errbuf; /* target of longjmp() on a fatal error */
666
667#endif
diff --git a/libraries/embryo/src/bin/embryo_cc_sc1.c b/libraries/embryo/src/bin/embryo_cc_sc1.c
new file mode 100644
index 0000000..b28b6f3
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc1.c
@@ -0,0 +1,4079 @@
1/* Small compiler
2 * Function and variable definition and declaration, statement parser.
3 *
4 * Copyright (c) ITB CompuPhase, 1997-2003
5 *
6 * This software is provided "as-is", without any express or implied
7 * warranty. In no event will the authors be held liable for any
8 * damages arising from the use of this software. Permission is granted
9 * to anyone to use this software for any purpose, including commercial
10 * applications, and to alter it and redistribute it freely, subject to
11 * the following restrictions:
12 *
13 * 1. The origin of this software must not be misrepresented;
14 * you must not claim that you wrote the original software.
15 * If you use this software in a product, an acknowledgment in the
16 * product documentation would be appreciated but is not required.
17 * 2. Altered source versions must be plainly marked as such, and
18 * must not be misrepresented as being the original software.
19 * 3. This notice may not be removed or altered from any source
20 * distribution.
21 * Version: $Id: embryo_cc_sc1.c 61433 2011-07-16 23:19:02Z caro $
22 */
23
24
25#ifdef HAVE_CONFIG_H
26# include <config.h>
27#endif
28
29#include <assert.h>
30#include <ctype.h>
31#include <limits.h>
32#include <stdarg.h>
33#include <stdio.h>
34#include <stdlib.h>
35#include <string.h>
36
37#ifdef HAVE_UNISTD_H
38# include <unistd.h>
39#endif
40
41#ifdef HAVE_EVIL
42# include <Evil.h>
43#endif /* HAVE_EVIL */
44
45#include "embryo_cc_sc.h"
46#include "embryo_cc_prefix.h"
47
48#define VERSION_STR "2.4"
49#define VERSION_INT 240
50
51static void resetglobals(void);
52static void initglobals(void);
53static void setopt(int argc, char **argv,
54 char *iname, char *oname,
55 char *pname, char *rname);
56static void setconfig(char *root);
57static void about(void);
58static void setconstants(void);
59static void parse(void);
60static void dumplits(void);
61static void dumpzero(int count);
62static void declfuncvar(int tok, char *symname,
63 int tag, int fpublic,
64 int fstatic, int fstock, int fconst);
65static void declglb(char *firstname, int firsttag,
66 int fpublic, int fstatic, int stock, int fconst);
67static int declloc(int fstatic);
68static void decl_const(int table);
69static void decl_enum(int table);
70static cell needsub(int *tag);
71static void initials(int ident, int tag,
72 cell * size, int dim[], int numdim);
73static cell initvector(int ident, int tag, cell size, int fillzero);
74static cell init(int ident, int *tag);
75static void funcstub(int native);
76static int newfunc(char *firstname, int firsttag,
77 int fpublic, int fstatic, int stock);
78static int declargs(symbol * sym);
79static void doarg(char *name, int ident, int offset,
80 int tags[], int numtags,
81 int fpublic, int fconst, arginfo * arg);
82static void reduce_referrers(symbol * root);
83static int testsymbols(symbol * root, int level,
84 int testlabs, int testconst);
85static void destructsymbols(symbol * root, int level);
86static constvalue *find_constval_byval(constvalue * table, cell val);
87static void statement(int *lastindent, int allow_decl);
88static void compound(void);
89static void doexpr(int comma, int chkeffect,
90 int allowarray, int mark_endexpr,
91 int *tag, int chkfuncresult);
92static void doassert(void);
93static void doexit(void);
94static void test(int label, int parens, int invert);
95static void doif(void);
96static void dowhile(void);
97static void dodo(void);
98static void dofor(void);
99static void doswitch(void);
100static void dogoto(void);
101static void dolabel(void);
102static symbol *fetchlab(char *name);
103static void doreturn(void);
104static void dobreak(void);
105static void docont(void);
106static void dosleep(void);
107static void addwhile(int *ptr);
108static void delwhile(void);
109static int *readwhile(void);
110
111static int lastst = 0; /* last executed statement type */
112static int nestlevel = 0; /* number of active (open) compound statements */
113static int rettype = 0; /* the type that a "return" expression should have */
114static int skipinput = 0; /* number of lines to skip from the first input file */
115static int wq[wqTABSZ]; /* "while queue", internal stack for nested loops */
116static int *wqptr; /* pointer to next entry */
117static char binfname[PATH_MAX]; /* binary file name */
118
119int
120main(int argc, char *argv[], char *env[] __UNUSED__)
121{
122 e_prefix_determine(argv[0]);
123 return sc_compile(argc, argv);
124}
125
126int
127sc_error(int number, char *message, char *filename, int firstline,
128 int lastline, va_list argptr)
129{
130 static char *prefix[3] = { "error", "fatal error", "warning" };
131
132 if (number != 0)
133 {
134 char *pre;
135
136 pre = prefix[number / 100];
137 if (firstline >= 0)
138 fprintf(stderr, "%s(%d -- %d) : %s %03d: ", filename, firstline,
139 lastline, pre, number);
140 else
141 fprintf(stderr, "%s(%d) : %s %03d: ", filename, lastline, pre,
142 number);
143 } /* if */
144 vfprintf(stderr, message, argptr);
145 fflush(stderr);
146 return 0;
147}
148
149void *
150sc_opensrc(char *filename)
151{
152 return fopen(filename, "rb");
153}
154
155void
156sc_closesrc(void *handle)
157{
158 assert(handle != NULL);
159 fclose((FILE *) handle);
160}
161
162void
163sc_resetsrc(void *handle, void *position)
164{
165 assert(handle != NULL);
166 fsetpos((FILE *) handle, (fpos_t *) position);
167}
168
169char *
170sc_readsrc(void *handle, char *target, int maxchars)
171{
172 return fgets(target, maxchars, (FILE *) handle);
173}
174
175void *
176sc_getpossrc(void *handle)
177{
178 static fpos_t lastpos; /* may need to have a LIFO stack of
179 * such positions */
180
181 fgetpos((FILE *) handle, &lastpos);
182 return &lastpos;
183}
184
185int
186sc_eofsrc(void *handle)
187{
188 return feof((FILE *) handle);
189}
190
191void *
192sc_openasm(int fd)
193{
194 return fdopen(fd, "w+");
195}
196
197void
198sc_closeasm(void *handle)
199{
200 if (handle)
201 fclose((FILE *) handle);
202}
203
204void
205sc_resetasm(void *handle)
206{
207 fflush((FILE *) handle);
208 fseek((FILE *) handle, 0, SEEK_SET);
209}
210
211int
212sc_writeasm(void *handle, char *st)
213{
214 return fputs(st, (FILE *) handle) >= 0;
215}
216
217char *
218sc_readasm(void *handle, char *target, int maxchars)
219{
220 return fgets(target, maxchars, (FILE *) handle);
221}
222
223void *
224sc_openbin(char *filename)
225{
226 return fopen(filename, "wb");
227}
228
229void
230sc_closebin(void *handle, int deletefile)
231{
232 fclose((FILE *) handle);
233 if (deletefile)
234 unlink(binfname);
235}
236
237void
238sc_resetbin(void *handle)
239{
240 fflush((FILE *) handle);
241 fseek((FILE *) handle, 0, SEEK_SET);
242}
243
244int
245sc_writebin(void *handle, void *buffer, int size)
246{
247 return (int)fwrite(buffer, 1, size, (FILE *) handle) == size;
248}
249
250long
251sc_lengthbin(void *handle)
252{
253 return ftell((FILE *) handle);
254}
255
256/* "main" of the compiler
257 */
258int
259sc_compile(int argc, char *argv[])
260{
261 int entry, i, jmpcode, fd_out;
262 int retcode;
263 char incfname[PATH_MAX];
264 char reportname[PATH_MAX];
265 FILE *binf;
266 void *inpfmark;
267 char lcl_ctrlchar;
268 int lcl_packstr, lcl_needsemicolon, lcl_tabsize;
269 char *tmpdir;
270
271 /* set global variables to their initial value */
272 binf = NULL;
273 initglobals();
274 errorset(sRESET);
275 errorset(sEXPRRELEASE);
276 lexinit();
277
278 /* make sure that we clean up on a fatal error; do this before the
279 * first call to error(). */
280 if ((jmpcode = setjmp(errbuf)) != 0)
281 goto cleanup;
282
283 /* allocate memory for fixed tables */
284 inpfname = (char *)malloc(PATH_MAX);
285 litq = (cell *) malloc(litmax * sizeof(cell));
286 if (!litq)
287 error(103); /* insufficient memory */
288 if (!phopt_init())
289 error(103); /* insufficient memory */
290
291 setopt(argc, argv, inpfname, binfname, incfname, reportname);
292
293 /* open the output file */
294
295#ifndef HAVE_EVIL
296 tmpdir = getenv("TMPDIR");
297 if (!tmpdir) tmpdir = "/tmp";
298#else
299 tmpdir = (char *)evil_tmpdir_get();
300#endif /* ! HAVE_EVIL */
301
302 snprintf(outfname, PATH_MAX, "%s/embryo_cc.asm-tmp-XXXXXX", tmpdir);
303 fd_out = mkstemp(outfname);
304 if (fd_out < 0)
305 error(101, outfname);
306
307 setconfig(argv[0]); /* the path to the include files */
308 lcl_ctrlchar = sc_ctrlchar;
309 lcl_packstr = sc_packstr;
310 lcl_needsemicolon = sc_needsemicolon;
311 lcl_tabsize = sc_tabsize;
312 inpf = inpf_org = (FILE *) sc_opensrc(inpfname);
313 if (!inpf)
314 error(100, inpfname);
315 freading = TRUE;
316 outf = (FILE *) sc_openasm(fd_out); /* first write to assembler
317 * file (may be temporary) */
318 if (!outf)
319 error(101, outfname);
320 /* immediately open the binary file, for other programs to check */
321 binf = (FILE *) sc_openbin(binfname);
322 if (!binf)
323 error(101, binfname);
324 setconstants(); /* set predefined constants and tagnames */
325 for (i = 0; i < skipinput; i++) /* skip lines in the input file */
326 if (sc_readsrc(inpf, pline, sLINEMAX))
327 fline++; /* keep line number up to date */
328 skipinput = fline;
329 sc_status = statFIRST;
330 /* do the first pass through the file */
331 inpfmark = sc_getpossrc(inpf);
332 if (incfname[0] != '\0')
333 {
334 if (strcmp(incfname, sDEF_PREFIX) == 0)
335 {
336 plungefile(incfname, FALSE, TRUE); /* parse "default.inc" */
337 }
338 else
339 {
340 if (!plungequalifiedfile(incfname)) /* parse "prefix" include
341 * file */
342 error(100, incfname); /* cannot read from ... (fatal error) */
343 } /* if */
344 } /* if */
345 preprocess(); /* fetch first line */
346 parse(); /* process all input */
347
348 /* second pass */
349 sc_status = statWRITE; /* set, to enable warnings */
350
351 /* ??? for re-parsing the listing file instead of the original source
352 * file (and doing preprocessing twice):
353 * - close input file, close listing file
354 * - re-open listing file for reading (inpf)
355 * - open assembler file (outf)
356 */
357
358 /* reset "defined" flag of all functions and global variables */
359 reduce_referrers(&glbtab);
360 delete_symbols(&glbtab, 0, TRUE, FALSE);
361#if !defined NO_DEFINE
362 delete_substtable();
363#endif
364 resetglobals();
365 sc_ctrlchar = lcl_ctrlchar;
366 sc_packstr = lcl_packstr;
367 sc_needsemicolon = lcl_needsemicolon;
368 sc_tabsize = lcl_tabsize;
369 errorset(sRESET);
370 /* reset the source file */
371 inpf = inpf_org;
372 freading = TRUE;
373 sc_resetsrc(inpf, inpfmark); /* reset file position */
374 fline = skipinput; /* reset line number */
375 lexinit(); /* clear internal flags of lex() */
376 sc_status = statWRITE; /* allow to write --this variable was reset
377 * by resetglobals() */
378 writeleader();
379 setfile(inpfname, fnumber);
380 if (incfname[0] != '\0')
381 {
382 if (strcmp(incfname, sDEF_PREFIX) == 0)
383 plungefile(incfname, FALSE, TRUE); /* parse "default.inc" (again) */
384 else
385 plungequalifiedfile(incfname); /* parse implicit include
386 * file (again) */
387 } /* if */
388 preprocess(); /* fetch first line */
389 parse(); /* process all input */
390 /* inpf is already closed when readline() attempts to pop of a file */
391 writetrailer(); /* write remaining stuff */
392
393 entry = testsymbols(&glbtab, 0, TRUE, FALSE); /* test for unused
394 * or undefined functions and variables */
395 if (!entry)
396 error(13); /* no entry point (no public functions) */
397
398 cleanup:
399 if (inpf) /* main source file is not closed, do it now */
400 sc_closesrc(inpf);
401 /* write the binary file (the file is already open) */
402 if (errnum == 0 && jmpcode == 0)
403 {
404 assert(binf != NULL);
405 sc_resetasm(outf); /* flush and loop back, for reading */
406 assemble(binf, outf); /* assembler file is now input */
407 } /* if */
408 if (outf)
409 sc_closeasm(outf);
410 unlink (outfname);
411 if (binf)
412 sc_closebin(binf, errnum != 0);
413
414 if (inpfname)
415 free(inpfname);
416 if (litq)
417 free(litq);
418 phopt_cleanup();
419 stgbuffer_cleanup();
420 assert(jmpcode != 0 || loctab.next == NULL); /* on normal flow,
421 * local symbols
422 * should already have been deleted */
423 delete_symbols(&loctab, 0, TRUE, TRUE); /* delete local variables
424 * if not yet done (i.e.
425 * on a fatal error) */
426 delete_symbols(&glbtab, 0, TRUE, TRUE);
427 delete_consttable(&tagname_tab);
428 delete_consttable(&libname_tab);
429 delete_aliastable();
430 delete_pathtable();
431#if !defined NO_DEFINE
432 delete_substtable();
433#endif
434 if (errnum != 0)
435 {
436 printf("\n%d Error%s.\n", errnum, (errnum > 1) ? "s" : "");
437 retcode = 2;
438 }
439 else if (warnnum != 0)
440 {
441 printf("\n%d Warning%s.\n", warnnum, (warnnum > 1) ? "s" : "");
442 retcode = 1;
443 }
444 else
445 {
446 retcode = jmpcode;
447 } /* if */
448 return retcode;
449}
450
451int
452sc_addconstant(char *name, cell value, int tag)
453{
454 errorset(sFORCESET); /* make sure error engine is silenced */
455 sc_status = statIDLE;
456 add_constant(name, value, sGLOBAL, tag);
457 return 1;
458}
459
460int
461sc_addtag(char *name)
462{
463 cell val;
464 constvalue *ptr;
465 int last, tag;
466
467 if (!name)
468 {
469 /* no tagname was given, check for one */
470 if (lex(&val, &name) != tLABEL)
471 {
472 lexpush();
473 return 0; /* untagged */
474 } /* if */
475 } /* if */
476
477 last = 0;
478 ptr = tagname_tab.next;
479 while (ptr)
480 {
481 tag = (int)(ptr->value & TAGMASK);
482 if (strcmp(name, ptr->name) == 0)
483 return tag; /* tagname is known, return its sequence number */
484 tag &= (int)~FIXEDTAG;
485 if (tag > last)
486 last = tag;
487 ptr = ptr->next;
488 } /* while */
489
490 /* tagname currently unknown, add it */
491 tag = last + 1; /* guaranteed not to exist already */
492 if (isupper(*name))
493 tag |= (int)FIXEDTAG;
494 append_constval(&tagname_tab, name, (cell) tag, 0);
495 return tag;
496}
497
498static void
499resetglobals(void)
500{
501 /* reset the subset of global variables that is modified by the
502 * first pass */
503 curfunc = NULL; /* pointer to current function */
504 lastst = 0; /* last executed statement type */
505 nestlevel = 0; /* number of active (open) compound statements */
506 rettype = 0; /* the type that a "return" expression should have */
507 litidx = 0; /* index to literal table */
508 stgidx = 0; /* index to the staging buffer */
509 labnum = 0; /* number of (internal) labels */
510 staging = 0; /* true if staging output */
511 declared = 0; /* number of local cells declared */
512 glb_declared = 0; /* number of global cells declared */
513 code_idx = 0; /* number of bytes with generated code */
514 ntv_funcid = 0; /* incremental number of native function */
515 curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */
516 freading = FALSE; /* no input file ready yet */
517 fline = 0; /* the line number in the current file */
518 fnumber = 0; /* the file number in the file table (debugging) */
519 fcurrent = 0; /* current file being processed (debugging) */
520 intest = 0; /* true if inside a test */
521 sideeffect = 0; /* true if an expression causes a side-effect */
522 stmtindent = 0; /* current indent of the statement */
523 indent_nowarn = TRUE; /* do not skip warning "217 loose indentation" */
524 sc_allowtags = TRUE; /* allow/detect tagnames */
525 sc_status = statIDLE;
526}
527
528static void
529initglobals(void)
530{
531 resetglobals();
532
533 skipinput = 0; /* number of lines to skip from the first
534 * input file */
535 sc_ctrlchar = CTRL_CHAR; /* the escape character */
536 litmax = sDEF_LITMAX; /* current size of the literal table */
537 errnum = 0; /* number of errors */
538 warnnum = 0; /* number of warnings */
539/* sc_debug=sCHKBOUNDS; by default: bounds checking+assertions */
540 sc_debug = 0; /* by default: no debug */
541 charbits = 8; /* a "char" is 8 bits */
542 sc_packstr = FALSE; /* strings are unpacked by default */
543/* sc_compress=TRUE; compress output bytecodes */
544 sc_compress = FALSE; /* compress output bytecodes */
545 sc_needsemicolon = FALSE; /* semicolon required to terminate
546 * expressions? */
547 sc_dataalign = 4;
548 sc_stksize = sDEF_AMXSTACK; /* default stack size */
549 sc_tabsize = 8; /* assume a TAB is 8 spaces */
550 sc_rationaltag = 0; /* assume no support for rational numbers */
551 rational_digits = 0; /* number of fractional digits */
552
553 outfname[0] = '\0'; /* output file name */
554 inpf = NULL; /* file read from */
555 inpfname = NULL; /* pointer to name of the file currently
556 * read from */
557 outf = NULL; /* file written to */
558 litq = NULL; /* the literal queue */
559 glbtab.next = NULL; /* clear global variables/constants table */
560 loctab.next = NULL; /* " local " / " " */
561 tagname_tab.next = NULL; /* tagname table */
562 libname_tab.next = NULL; /* library table (#pragma library "..."
563 * syntax) */
564
565 pline[0] = '\0'; /* the line read from the input file */
566 lptr = NULL; /* points to the current position in "pline" */
567 curlibrary = NULL; /* current library */
568 inpf_org = NULL; /* main source file */
569
570 wqptr = wq; /* initialize while queue pointer */
571
572}
573
574static void
575parseoptions(int argc, char **argv, char *iname, char *oname,
576 char *pname __UNUSED__, char *rname __UNUSED__)
577{
578 char str[PATH_MAX];
579 int i, stack_size;
580 size_t len;
581
582 /* use embryo include dir always */
583 snprintf(str, sizeof(str), "%s/include/", e_prefix_data_get());
584 insert_path(str);
585 insert_path("./");
586
587 for (i = 1; i < argc; i++)
588 {
589 if (!strcmp (argv[i], "-i") && (i + 1 < argc) && *argv[i + 1])
590 {
591 /* include directory */
592 i++;
593 strncpy(str, argv[i], sizeof(str));
594
595 len = strlen(str);
596 if (str[len - 1] != DIRSEP_CHAR)
597 {
598 str[len] = DIRSEP_CHAR;
599 str[len + 1] = '\0';
600 }
601
602 insert_path(str);
603 }
604 else if (!strcmp (argv[i], "-o") && (i + 1 < argc) && *argv[i + 1])
605 {
606 /* output file */
607 i++;
608 strcpy(oname, argv[i]); /* FIXME */
609 }
610 else if (!strcmp (argv[i], "-S") && (i + 1 < argc) && *argv[i + 1])
611 {
612 /* stack size */
613 i++;
614 stack_size = atoi(argv[i]);
615
616 if (stack_size > 64)
617 sc_stksize = (cell) stack_size;
618 else
619 about();
620 }
621 else if (!*iname)
622 {
623 /* input file */
624 strcpy(iname, argv[i]); /* FIXME */
625 }
626 else
627 {
628 /* only allow one input filename */
629 about();
630 }
631 }
632}
633
634static void
635setopt(int argc, char **argv, char *iname, char *oname,
636 char *pname, char *rname)
637{
638 *iname = '\0';
639 *oname = '\0';
640 *pname = '\0';
641 *rname = '\0';
642 strcpy(pname, sDEF_PREFIX);
643
644 parseoptions(argc, argv, iname, oname, pname, rname);
645 if (iname[0] == '\0')
646 about();
647}
648
649static void
650setconfig(char *root)
651{
652 char path[PATH_MAX];
653 char *ptr;
654 int len;
655
656 /* add the default "include" directory */
657 if (root)
658 {
659 /* path + filename (hopefully) */
660 strncpy(path, root, sizeof(path) - 1);
661 path[sizeof(path) - 1] = 0;
662 }
663/* terminate just behind last \ or : */
664 if ((ptr = strrchr(path, DIRSEP_CHAR))
665 || (ptr = strchr(path, ':')))
666 {
667 /* If there was no terminating "\" or ":",
668 * the filename probably does not
669 * contain the path; so we just don't add it
670 * to the list in that case
671 */
672 *(ptr + 1) = '\0';
673 if (strlen(path) < (sizeof(path) - 1 - 7))
674 {
675 strcat(path, "include");
676 }
677 len = strlen(path);
678 path[len] = DIRSEP_CHAR;
679 path[len + 1] = '\0';
680 insert_path(path);
681 } /* if */
682}
683
684static void
685about(void)
686{
687 printf("Usage: embryo_cc <filename> [options]\n\n");
688 printf("Options:\n");
689#if 0
690 printf
691 (" -A<num> alignment in bytes of the data segment and the\
692 stack\n");
693
694 printf
695 (" -a output assembler code (skip code generation\
696 pass)\n");
697
698 printf
699 (" -C[+/-] compact encoding for output file (default=%c)\n",
700 sc_compress ? '+' : '-');
701 printf(" -c8 [default] a character is 8-bits\
702 (ASCII/ISO Latin-1)\n");
703
704 printf(" -c16 a character is 16-bits (Unicode)\n");
705#if defined dos_setdrive
706 printf(" -Dpath active directory path\n");
707#endif
708 printf
709 (" -d0 no symbolic information, no run-time checks\n");
710 printf(" -d1 [default] run-time checks, no symbolic\
711 information\n");
712 printf
713 (" -d2 full debug information and dynamic checking\n");
714 printf(" -d3 full debug information, dynamic checking,\
715 no optimization\n");
716#endif
717 printf(" -i <name> path for include files\n");
718#if 0
719 printf(" -l create list file (preprocess only)\n");
720#endif
721 printf(" -o <name> set base name of output file\n");
722#if 0
723 printf
724 (" -P[+/-] strings are \"packed\" by default (default=%c)\n",
725 sc_packstr ? '+' : '-');
726 printf(" -p<name> set name of \"prefix\" file\n");
727 if (!waitkey())
728 longjmp(errbuf, 3);
729#endif
730 printf
731 (" -S <num> stack/heap size in cells (default=%d, min=65)\n",
732 (int)sc_stksize);
733#if 0
734 printf(" -s<num> skip lines from the input file\n");
735 printf
736 (" -t<num> TAB indent size (in character positions)\n");
737 printf(" -\\ use '\\' for escape characters\n");
738 printf(" -^ use '^' for escape characters\n");
739 printf(" -;[+/-] require a semicolon to end each statement\
740 (default=%c)\n", sc_needsemicolon ? '+' : '-');
741
742 printf
743 (" sym=val define constant \"sym\" with value \"val\"\n");
744 printf(" sym= define constant \"sym\" with value 0\n");
745#endif
746 longjmp(errbuf, 3); /* user abort */
747}
748
749static void
750setconstants(void)
751{
752 int debug;
753
754 assert(sc_status == statIDLE);
755 append_constval(&tagname_tab, "_", 0, 0); /* "untagged" */
756 append_constval(&tagname_tab, "bool", 1, 0);
757
758 add_constant("true", 1, sGLOBAL, 1); /* boolean flags */
759 add_constant("false", 0, sGLOBAL, 1);
760 add_constant("EOS", 0, sGLOBAL, 0); /* End Of String, or '\0' */
761 add_constant("cellbits", 32, sGLOBAL, 0);
762 add_constant("cellmax", INT_MAX, sGLOBAL, 0);
763 add_constant("cellmin", INT_MIN, sGLOBAL, 0);
764 add_constant("charbits", charbits, sGLOBAL, 0);
765 add_constant("charmin", 0, sGLOBAL, 0);
766 add_constant("charmax", (charbits == 16) ? 0xffff : 0xff, sGLOBAL, 0);
767
768 add_constant("__Small", VERSION_INT, sGLOBAL, 0);
769
770 debug = 0;
771 if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC)) == (sCHKBOUNDS | sSYMBOLIC))
772 debug = 2;
773 else if ((sc_debug & sCHKBOUNDS) == sCHKBOUNDS)
774 debug = 1;
775 add_constant("debug", debug, sGLOBAL, 0);
776}
777
778/* parse - process all input text
779 *
780 * At this level, only static declarations and function definitions
781 * are legal.
782 */
783static void
784parse(void)
785{
786 int tok, tag, fconst, fstock, fstatic;
787 cell val;
788 char *str;
789
790 while (freading)
791 {
792 /* first try whether a declaration possibly is native or public */
793 tok = lex(&val, &str); /* read in (new) token */
794 switch (tok)
795 {
796 case 0:
797 /* ignore zero's */
798 break;
799 case tNEW:
800 fconst = matchtoken(tCONST);
801 declglb(NULL, 0, FALSE, FALSE, FALSE, fconst);
802 break;
803 case tSTATIC:
804 /* This can be a static function or a static global variable;
805 * we know which of the two as soon as we have parsed up to the
806 * point where an opening parenthesis of a function would be
807 * expected. To back out after deciding it was a declaration of
808 * a static variable after all, we have to store the symbol name
809 * and tag.
810 */
811 fstock = matchtoken(tSTOCK);
812 fconst = matchtoken(tCONST);
813 tag = sc_addtag(NULL);
814 tok = lex(&val, &str);
815 if (tok == tNATIVE || tok == tPUBLIC)
816 {
817 error(42); /* invalid combination of class specifiers */
818 break;
819 } /* if */
820 declfuncvar(tok, str, tag, FALSE, TRUE, fstock, fconst);
821 break;
822 case tCONST:
823 decl_const(sGLOBAL);
824 break;
825 case tENUM:
826 decl_enum(sGLOBAL);
827 break;
828 case tPUBLIC:
829 /* This can be a public function or a public variable;
830 * see the comment above (for static functions/variables)
831 * for details.
832 */
833 fconst = matchtoken(tCONST);
834 tag = sc_addtag(NULL);
835 tok = lex(&val, &str);
836 if (tok == tNATIVE || tok == tSTOCK || tok == tSTATIC)
837 {
838 error(42); /* invalid combination of class specifiers */
839 break;
840 } /* if */
841 declfuncvar(tok, str, tag, TRUE, FALSE, FALSE, fconst);
842 break;
843 case tSTOCK:
844 /* This can be a stock function or a stock *global) variable;
845 * see the comment above (for static functions/variables) for
846 * details.
847 */
848 fstatic = matchtoken(tSTATIC);
849 fconst = matchtoken(tCONST);
850 tag = sc_addtag(NULL);
851 tok = lex(&val, &str);
852 if (tok == tNATIVE || tok == tPUBLIC)
853 {
854 error(42); /* invalid combination of class specifiers */
855 break;
856 } /* if */
857 declfuncvar(tok, str, tag, FALSE, fstatic, TRUE, fconst);
858 break;
859 case tLABEL:
860 case tSYMBOL:
861 case tOPERATOR:
862 lexpush();
863 if (!newfunc(NULL, -1, FALSE, FALSE, FALSE))
864 {
865 error(10); /* illegal function or declaration */
866 lexclr(TRUE); /* drop the rest of the line */
867 } /* if */
868 break;
869 case tNATIVE:
870 funcstub(TRUE); /* create a dummy function */
871 break;
872 case tFORWARD:
873 funcstub(FALSE);
874 break;
875 case '}':
876 error(54); /* unmatched closing brace */
877 break;
878 case '{':
879 error(55); /* start of function body without function header */
880 break;
881 default:
882 if (freading)
883 {
884 error(10); /* illegal function or declaration */
885 lexclr(TRUE); /* drop the rest of the line */
886 } /* if */
887 } /* switch */
888 } /* while */
889}
890
891/* dumplits
892 *
893 * Dump the literal pool (strings etc.)
894 *
895 * Global references: litidx (referred to only)
896 */
897static void
898dumplits(void)
899{
900 int j, k;
901
902 k = 0;
903 while (k < litidx)
904 {
905 /* should be in the data segment */
906 assert(curseg == 2);
907 defstorage();
908 j = 16; /* 16 values per line */
909 while (j && k < litidx)
910 {
911 outval(litq[k], FALSE);
912 stgwrite(" ");
913 k++;
914 j--;
915 if (j == 0 || k >= litidx)
916 stgwrite("\n"); /* force a newline after 10 dumps */
917 /* Note: stgwrite() buffers a line until it is complete. It recognizes
918 * the end of line as a sequence of "\n\0", so something like "\n\t"
919 * so should not be passed to stgwrite().
920 */
921 } /* while */
922 } /* while */
923}
924
925/* dumpzero
926 *
927 * Dump zero's for default initial values
928 */
929static void
930dumpzero(int count)
931{
932 int i;
933
934 if (count <= 0)
935 return;
936 assert(curseg == 2);
937 defstorage();
938 i = 0;
939 while (count-- > 0)
940 {
941 outval(0, FALSE);
942 i = (i + 1) % 16;
943 stgwrite((i == 0 || count == 0) ? "\n" : " ");
944 if (i == 0 && count > 0)
945 defstorage();
946 } /* while */
947}
948
949static void
950aligndata(int numbytes)
951{
952 if ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
953 {
954 while ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
955 stowlit(0);
956 } /* if */
957
958}
959
960static void
961declfuncvar(int tok, char *symname, int tag, int fpublic, int fstatic,
962 int fstock, int fconst)
963{
964 char name[sNAMEMAX + 1];
965
966 if (tok != tSYMBOL && tok != tOPERATOR)
967 {
968 if (freading)
969 error(20, symname); /* invalid symbol name */
970 return;
971 } /* if */
972 if (tok == tOPERATOR)
973 {
974 lexpush();
975 if (!newfunc(NULL, tag, fpublic, fstatic, fstock))
976 error(10); /* illegal function or declaration */
977 }
978 else
979 {
980 assert(strlen(symname) <= sNAMEMAX);
981 strcpy(name, symname);
982 if (fconst || !newfunc(name, tag, fpublic, fstatic, fstock))
983 declglb(name, tag, fpublic, fstatic, fstock, fconst);
984 /* if not a static function, try a static variable */
985 } /* if */
986}
987
988/* declglb - declare global symbols
989 *
990 * Declare a static (global) variable. Global variables are stored in
991 * the DATA segment.
992 *
993 * global references: glb_declared (altered)
994 */
995static void
996declglb(char *firstname, int firsttag, int fpublic, int fstatic,
997 int stock, int fconst)
998{
999 int ident, tag, ispublic;
1000 int idxtag[sDIMEN_MAX];
1001 char name[sNAMEMAX + 1];
1002 cell val, size, cidx;
1003 char *str;
1004 int dim[sDIMEN_MAX];
1005 int numdim, level;
1006 int filenum;
1007 symbol *sym;
1008
1009#if !defined NDEBUG
1010 cell glbdecl = 0;
1011#endif
1012
1013 filenum = fcurrent; /* save file number at the start of the
1014 * declaration */
1015 do
1016 {
1017 size = 1; /* single size (no array) */
1018 numdim = 0; /* no dimensions */
1019 ident = iVARIABLE;
1020 if (firstname)
1021 {
1022 assert(strlen(firstname) <= sNAMEMAX);
1023 strcpy(name, firstname); /* save symbol name */
1024 tag = firsttag;
1025 firstname = NULL;
1026 }
1027 else
1028 {
1029 tag = sc_addtag(NULL);
1030 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1031 error(20, str); /* invalid symbol name */
1032 assert(strlen(str) <= sNAMEMAX);
1033 strcpy(name, str); /* save symbol name */
1034 } /* if */
1035 sym = findglb(name);
1036 if (!sym)
1037 sym = findconst(name);
1038 if (sym && (sym->usage & uDEFINE) != 0)
1039 error(21, name); /* symbol already defined */
1040 ispublic = fpublic;
1041 if (name[0] == PUBLIC_CHAR)
1042 {
1043 ispublic = TRUE; /* implicitly public variable */
1044 if (stock || fstatic)
1045 error(42); /* invalid combination of class specifiers */
1046 } /* if */
1047 while (matchtoken('['))
1048 {
1049 ident = iARRAY;
1050 if (numdim == sDIMEN_MAX)
1051 {
1052 error(53); /* exceeding maximum number of dimensions */
1053 return;
1054 } /* if */
1055 if (numdim > 0 && dim[numdim - 1] == 0)
1056 error(52); /* only last dimension may be variable length */
1057 size = needsub(&idxtag[numdim]); /* get size; size==0 for
1058 * "var[]" */
1059#if INT_MAX < LONG_MAX
1060 if (size > INT_MAX)
1061 error(105); /* overflow, exceeding capacity */
1062#endif
1063 if (ispublic)
1064 error(56, name); /* arrays cannot be public */
1065 dim[numdim++] = (int)size;
1066 } /* while */
1067 /* if this variable is never used (which can be detected only in
1068 * the second stage), shut off code generation; make an exception
1069 * for public variables
1070 */
1071 cidx = 0; /* only to avoid a compiler warning */
1072 if (sc_status == statWRITE && sym
1073 && (sym->usage & (uREAD | uWRITTEN | uPUBLIC)) == 0)
1074 {
1075 sc_status = statSKIP;
1076 cidx = code_idx;
1077#if !defined NDEBUG
1078 glbdecl = glb_declared;
1079#endif
1080 } /* if */
1081 defsymbol(name, ident, sGLOBAL, sizeof(cell) * glb_declared, tag);
1082 begdseg(); /* real (initialized) data in data segment */
1083 assert(litidx == 0); /* literal queue should be empty */
1084 if (sc_alignnext)
1085 {
1086 litidx = 0;
1087 aligndata(sc_dataalign);
1088 dumplits(); /* dump the literal queue */
1089 sc_alignnext = FALSE;
1090 litidx = 0; /* global initial data is dumped, so restart at zero */
1091 } /* if */
1092 initials(ident, tag, &size, dim, numdim); /* stores values in
1093 * the literal queue */
1094 if (numdim == 1)
1095 dim[0] = (int)size;
1096 dumplits(); /* dump the literal queue */
1097 dumpzero((int)size - litidx);
1098 litidx = 0;
1099 if (!sym)
1100 { /* define only if not yet defined */
1101 sym =
1102 addvariable(name, sizeof(cell) * glb_declared, ident, sGLOBAL,
1103 tag, dim, numdim, idxtag);
1104 }
1105 else
1106 { /* if declared but not yet defined, adjust the
1107 * variable's address */
1108 sym->addr = sizeof(cell) * glb_declared;
1109 sym->usage |= uDEFINE;
1110 } /* if */
1111 if (ispublic)
1112 sym->usage |= uPUBLIC;
1113 if (fconst)
1114 sym->usage |= uCONST;
1115 if (stock)
1116 sym->usage |= uSTOCK;
1117 if (fstatic)
1118 sym->fnumber = filenum;
1119 if (ident == iARRAY)
1120 for (level = 0; level < numdim; level++)
1121 symbolrange(level, dim[level]);
1122 if (sc_status == statSKIP)
1123 {
1124 sc_status = statWRITE;
1125 code_idx = cidx;
1126 assert(glb_declared == glbdecl);
1127 }
1128 else
1129 {
1130 glb_declared += (int)size; /* add total number of cells */
1131 } /* if */
1132 }
1133 while (matchtoken(',')); /* enddo *//* more? */
1134 needtoken(tTERM); /* if not comma, must be semicolumn */
1135}
1136
1137/* declloc - declare local symbols
1138 *
1139 * Declare local (automatic) variables. Since these variables are
1140 * relative to the STACK, there is no switch to the DATA segment.
1141 * These variables cannot be initialized either.
1142 *
1143 * global references: declared (altered)
1144 * funcstatus (referred to only)
1145 */
1146static int
1147declloc(int fstatic)
1148{
1149 int ident, tag;
1150 int idxtag[sDIMEN_MAX];
1151 char name[sNAMEMAX + 1];
1152 symbol *sym;
1153 cell val, size;
1154 char *str;
1155 value lval = { NULL, 0, 0, 0, 0, NULL };
1156 int cur_lit = 0;
1157 int dim[sDIMEN_MAX];
1158 int numdim, level;
1159 int fconst;
1160
1161 fconst = matchtoken(tCONST);
1162 do
1163 {
1164 ident = iVARIABLE;
1165 size = 1;
1166 numdim = 0; /* no dimensions */
1167 tag = sc_addtag(NULL);
1168 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1169 error(20, str); /* invalid symbol name */
1170 assert(strlen(str) <= sNAMEMAX);
1171 strcpy(name, str); /* save symbol name */
1172 if (name[0] == PUBLIC_CHAR)
1173 error(56, name); /* local variables cannot be public */
1174 /* Note: block locals may be named identical to locals at higher
1175 * compound blocks (as with standard C); so we must check (and add)
1176 * the "nesting level" of local variables to verify the
1177 * multi-definition of symbols.
1178 */
1179 if ((sym = findloc(name)) && sym->compound == nestlevel)
1180 error(21, name); /* symbol already defined */
1181 /* Although valid, a local variable whose name is equal to that
1182 * of a global variable or to that of a local variable at a lower
1183 * level might indicate a bug.
1184 */
1185 if (((sym = findloc(name)) && sym->compound != nestlevel)
1186 || findglb(name))
1187 error(219, name); /* variable shadows another symbol */
1188 while (matchtoken('['))
1189 {
1190 ident = iARRAY;
1191 if (numdim == sDIMEN_MAX)
1192 {
1193 error(53); /* exceeding maximum number of dimensions */
1194 return ident;
1195 } /* if */
1196 if (numdim > 0 && dim[numdim - 1] == 0)
1197 error(52); /* only last dimension may be variable length */
1198 size = needsub(&idxtag[numdim]); /* get size; size==0 for "var[]" */
1199#if INT_MAX < LONG_MAX
1200 if (size > INT_MAX)
1201 error(105); /* overflow, exceeding capacity */
1202#endif
1203 dim[numdim++] = (int)size;
1204 } /* while */
1205 if (ident == iARRAY || fstatic)
1206 {
1207 if (sc_alignnext)
1208 {
1209 aligndata(sc_dataalign);
1210 sc_alignnext = FALSE;
1211 } /* if */
1212 cur_lit = litidx; /* save current index in the literal table */
1213 initials(ident, tag, &size, dim, numdim);
1214 if (size == 0)
1215 return ident; /* error message already given */
1216 if (numdim == 1)
1217 dim[0] = (int)size;
1218 } /* if */
1219 /* reserve memory (on the stack) for the variable */
1220 if (fstatic)
1221 {
1222 /* write zeros for uninitialized fields */
1223 while (litidx < cur_lit + size)
1224 stowlit(0);
1225 sym =
1226 addvariable(name, (cur_lit + glb_declared) * sizeof(cell),
1227 ident, sSTATIC, tag, dim, numdim, idxtag);
1228 defsymbol(name, ident, sSTATIC,
1229 (cur_lit + glb_declared) * sizeof(cell), tag);
1230 }
1231 else
1232 {
1233 declared += (int)size; /* variables are put on stack,
1234 * adjust "declared" */
1235 sym =
1236 addvariable(name, -declared * sizeof(cell), ident, sLOCAL, tag,
1237 dim, numdim, idxtag);
1238 defsymbol(name, ident, sLOCAL, -declared * sizeof(cell), tag);
1239 modstk(-(int)size * sizeof(cell));
1240 } /* if */
1241 /* now that we have reserved memory for the variable, we can
1242 * proceed to initialize it */
1243 sym->compound = nestlevel; /* for multiple declaration/shadowing */
1244 if (fconst)
1245 sym->usage |= uCONST;
1246 if (ident == iARRAY)
1247 for (level = 0; level < numdim; level++)
1248 symbolrange(level, dim[level]);
1249 if (!fstatic)
1250 { /* static variables already initialized */
1251 if (ident == iVARIABLE)
1252 {
1253 /* simple variable, also supports initialization */
1254 int ctag = tag; /* set to "tag" by default */
1255 int explicit_init = FALSE; /* is the variable explicitly
1256 * initialized? */
1257 if (matchtoken('='))
1258 {
1259 doexpr(FALSE, FALSE, FALSE, FALSE, &ctag, TRUE);
1260 explicit_init = TRUE;
1261 }
1262 else
1263 {
1264 const1(0); /* uninitialized variable, set to zero */
1265 } /* if */
1266 /* now try to save the value (still in PRI) in the variable */
1267 lval.sym = sym;
1268 lval.ident = iVARIABLE;
1269 lval.constval = 0;
1270 lval.tag = tag;
1271 check_userop(NULL, ctag, lval.tag, 2, NULL, &ctag);
1272 store(&lval);
1273 endexpr(TRUE); /* full expression ends after the store */
1274 if (!matchtag(tag, ctag, TRUE))
1275 error(213); /* tag mismatch */
1276 /* if the variable was not explicitly initialized, reset the
1277 * "uWRITTEN" flag that store() set */
1278 if (!explicit_init)
1279 sym->usage &= ~uWRITTEN;
1280 }
1281 else
1282 {
1283 /* an array */
1284 if (litidx - cur_lit < size)
1285 fillarray(sym, size * sizeof(cell), 0);
1286 if (cur_lit < litidx)
1287 {
1288 /* check whether the complete array is set to a single value;
1289 * if it is, more compact code can be generated */
1290 cell first = litq[cur_lit];
1291 int i;
1292
1293 for (i = cur_lit; i < litidx && litq[i] == first; i++)
1294 /* nothing */ ;
1295 if (i == litidx)
1296 {
1297 /* all values are the same */
1298 fillarray(sym, (litidx - cur_lit) * sizeof(cell),
1299 first);
1300 litidx = cur_lit; /* reset literal table */
1301 }
1302 else
1303 {
1304 /* copy the literals to the array */
1305 const1((cur_lit + glb_declared) * sizeof(cell));
1306 copyarray(sym, (litidx - cur_lit) * sizeof(cell));
1307 } /* if */
1308 } /* if */
1309 } /* if */
1310 } /* if */
1311 }
1312 while (matchtoken(',')); /* enddo *//* more? */
1313 needtoken(tTERM); /* if not comma, must be semicolumn */
1314 return ident;
1315}
1316
1317static cell
1318calc_arraysize(int dim[], int numdim, int cur)
1319{
1320 if (cur == numdim)
1321 return 0;
1322 return dim[cur] + (dim[cur] * calc_arraysize(dim, numdim, cur + 1));
1323}
1324
1325/* initials
1326 *
1327 * Initialize global objects and local arrays.
1328 * size==array cells (count), if 0 on input, the routine counts
1329 * the number of elements
1330 * tag==required tagname id (not the returned tag)
1331 *
1332 * Global references: litidx (altered)
1333 */
1334static void
1335initials(int ident, int tag, cell * size, int dim[], int numdim)
1336{
1337 int ctag;
1338 int curlit = litidx;
1339 int d;
1340
1341 if (!matchtoken('='))
1342 {
1343 if (ident == iARRAY && dim[numdim - 1] == 0)
1344 {
1345 /* declared as "myvar[];" which is senseless (note: this *does* make
1346 * sense in the case of a iREFARRAY, which is a function parameter)
1347 */
1348 error(9); /* array has zero length -> invalid size */
1349 } /* if */
1350 if (numdim > 1)
1351 {
1352 /* initialize the indirection tables */
1353#if sDIMEN_MAX>2
1354#error Array algorithms for more than 2 dimensions are not implemented
1355#endif
1356 assert(numdim == 2);
1357 *size = calc_arraysize(dim, numdim, 0);
1358 for (d = 0; d < dim[0]; d++)
1359 stowlit((dim[0] + d * (dim[1] - 1)) * sizeof(cell));
1360 } /* if */
1361 return;
1362 } /* if */
1363
1364 if (ident == iVARIABLE)
1365 {
1366 assert(*size == 1);
1367 init(ident, &ctag);
1368 if (!matchtag(tag, ctag, TRUE))
1369 error(213); /* tag mismatch */
1370 }
1371 else
1372 {
1373 assert(numdim > 0);
1374 if (numdim == 1)
1375 {
1376 *size = initvector(ident, tag, dim[0], FALSE);
1377 }
1378 else
1379 {
1380 cell offs, dsize;
1381
1382 /* The simple algorithm below only works for arrays with one or
1383 * two dimensions. This should be some recursive algorithm.
1384 */
1385 if (dim[numdim - 1] != 0)
1386 /* set size to (known) full size */
1387 *size = calc_arraysize(dim, numdim, 0);
1388 /* dump indirection tables */
1389 for (d = 0; d < dim[0]; d++)
1390 stowlit(0);
1391 /* now dump individual vectors */
1392 needtoken('{');
1393 offs = dim[0];
1394 for (d = 0; d < dim[0]; d++)
1395 {
1396 litq[curlit + d] = offs * sizeof(cell);
1397 dsize = initvector(ident, tag, dim[1], TRUE);
1398 offs += dsize - 1;
1399 if (d + 1 < dim[0])
1400 needtoken(',');
1401 if (matchtoken('{') || matchtoken(tSTRING))
1402 /* expect a '{' or a string */
1403 lexpush();
1404 else
1405 break;
1406 } /* for */
1407 matchtoken(',');
1408 needtoken('}');
1409 } /* if */
1410 } /* if */
1411
1412 if (*size == 0)
1413 *size = litidx - curlit; /* number of elements defined */
1414}
1415
1416/* initvector
1417 * Initialize a single dimensional array
1418 */
1419static cell
1420initvector(int ident, int tag, cell size, int fillzero)
1421{
1422 cell prev1 = 0, prev2 = 0;
1423 int ctag;
1424 int ellips = FALSE;
1425 int curlit = litidx;
1426
1427 assert(ident == iARRAY || ident == iREFARRAY);
1428 if (matchtoken('{'))
1429 {
1430 do
1431 {
1432 if (matchtoken('}'))
1433 { /* to allow for trailing ',' after the initialization */
1434 lexpush();
1435 break;
1436 } /* if */
1437 if ((ellips = matchtoken(tELLIPS)) != 0)
1438 break;
1439 prev2 = prev1;
1440 prev1 = init(ident, &ctag);
1441 if (!matchtag(tag, ctag, TRUE))
1442 error(213); /* tag mismatch */
1443 }
1444 while (matchtoken(',')); /* do */
1445 needtoken('}');
1446 }
1447 else
1448 {
1449 init(ident, &ctag);
1450 if (!matchtag(tag, ctag, TRUE))
1451 error(213); /* tagname mismatch */
1452 } /* if */
1453 /* fill up the literal queue with a series */
1454 if (ellips)
1455 {
1456 cell step =
1457 ((litidx - curlit) == 1) ? (cell) 0 : prev1 - prev2;
1458 if (size == 0 || (litidx - curlit) == 0)
1459 error(41); /* invalid ellipsis, array size unknown */
1460 else if ((litidx - curlit) == (int)size)
1461 error(18); /* initialisation data exceeds declared size */
1462 while ((litidx - curlit) < (int)size)
1463 {
1464 prev1 += step;
1465 stowlit(prev1);
1466 } /* while */
1467 } /* if */
1468 if (fillzero && size > 0)
1469 {
1470 while ((litidx - curlit) < (int)size)
1471 stowlit(0);
1472 } /* if */
1473 if (size == 0)
1474 {
1475 size = litidx - curlit; /* number of elements defined */
1476 }
1477 else if (litidx - curlit > (int)size)
1478 { /* e.g. "myvar[3]={1,2,3,4};" */
1479 error(18); /* initialisation data exceeds declared size */
1480 litidx = (int)size + curlit; /* avoid overflow in memory moves */
1481 } /* if */
1482 return size;
1483}
1484
1485/* init
1486 *
1487 * Evaluate one initializer.
1488 */
1489static cell
1490init(int ident, int *tag)
1491{
1492 cell i = 0;
1493
1494 if (matchtoken(tSTRING))
1495 {
1496 /* lex() automatically stores strings in the literal table (and
1497 * increases "litidx") */
1498 if (ident == iVARIABLE)
1499 {
1500 error(6); /* must be assigned to an array */
1501 litidx = 1; /* reset literal queue */
1502 } /* if */
1503 *tag = 0;
1504 }
1505 else if (constexpr(&i, tag))
1506 {
1507 stowlit(i); /* store expression result in literal table */
1508 } /* if */
1509 return i;
1510}
1511
1512/* needsub
1513 *
1514 * Get required array size
1515 */
1516static cell
1517needsub(int *tag)
1518{
1519 cell val;
1520
1521 *tag = 0;
1522 if (matchtoken(']')) /* we've already seen "[" */
1523 return 0; /* null size (like "char msg[]") */
1524 constexpr(&val, tag); /* get value (must be constant expression) */
1525 if (val < 0)
1526 {
1527 error(9); /* negative array size is invalid; assumed zero */
1528 val = 0;
1529 } /* if */
1530 needtoken(']');
1531 return val; /* return array size */
1532}
1533
1534/* decl_const - declare a single constant
1535 *
1536 */
1537static void
1538decl_const(int vclass)
1539{
1540 char constname[sNAMEMAX + 1];
1541 cell val;
1542 char *str;
1543 int tag, exprtag;
1544 int symbolline;
1545
1546 tag = sc_addtag(NULL);
1547 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1548 error(20, str); /* invalid symbol name */
1549 symbolline = fline; /* save line where symbol was found */
1550 strcpy(constname, str); /* save symbol name */
1551 needtoken('=');
1552 constexpr(&val, &exprtag); /* get value */
1553 needtoken(tTERM);
1554 /* add_constant() checks for duplicate definitions */
1555 if (!matchtag(tag, exprtag, FALSE))
1556 {
1557 /* temporarily reset the line number to where the symbol was
1558 * defined */
1559 int orgfline = fline;
1560
1561 fline = symbolline;
1562 error(213); /* tagname mismatch */
1563 fline = orgfline;
1564 } /* if */
1565 add_constant(constname, val, vclass, tag);
1566}
1567
1568/* decl_enum - declare enumerated constants
1569 *
1570 */
1571static void
1572decl_enum(int vclass)
1573{
1574 char enumname[sNAMEMAX + 1], constname[sNAMEMAX + 1];
1575 cell val, value, size;
1576 char *str;
1577 int tok, tag, explicittag;
1578 cell increment, multiplier;
1579
1580 /* get an explicit tag, if any (we need to remember whether an
1581 * explicit tag was passed, even if that explicit tag was "_:", so we
1582 * cannot call sc_addtag() here
1583 */
1584 if (lex(&val, &str) == tLABEL)
1585 {
1586 tag = sc_addtag(str);
1587 explicittag = TRUE;
1588 }
1589 else
1590 {
1591 lexpush();
1592 tag = 0;
1593 explicittag = FALSE;
1594 } /* if */
1595
1596 /* get optional enum name (also serves as a tag if no explicit
1597 * tag was set) */
1598 if (lex(&val, &str) == tSYMBOL)
1599 { /* read in (new) token */
1600 strcpy(enumname, str); /* save enum name (last constant) */
1601 if (!explicittag)
1602 tag = sc_addtag(enumname);
1603 }
1604 else
1605 {
1606 lexpush(); /* analyze again */
1607 enumname[0] = '\0';
1608 } /* if */
1609
1610 /* get increment and multiplier */
1611 increment = 1;
1612 multiplier = 1;
1613 if (matchtoken('('))
1614 {
1615 if (matchtoken(taADD))
1616 {
1617 constexpr(&increment, NULL);
1618 }
1619 else if (matchtoken(taMULT))
1620 {
1621 constexpr(&multiplier, NULL);
1622 }
1623 else if (matchtoken(taSHL))
1624 {
1625 constexpr(&val, NULL);
1626 while (val-- > 0)
1627 multiplier *= 2;
1628 } /* if */
1629 needtoken(')');
1630 } /* if */
1631
1632 needtoken('{');
1633 /* go through all constants */
1634 value = 0; /* default starting value */
1635 do
1636 {
1637 if (matchtoken('}'))
1638 { /* quick exit if '}' follows ',' */
1639 lexpush();
1640 break;
1641 } /* if */
1642 tok = lex(&val, &str); /* read in (new) token */
1643 if (tok != tSYMBOL && tok != tLABEL)
1644 error(20, str); /* invalid symbol name */
1645 strcpy(constname, str); /* save symbol name */
1646 size = increment; /* default increment of 'val' */
1647 if (tok == tLABEL || matchtoken(':'))
1648 constexpr(&size, NULL); /* get size */
1649 if (matchtoken('='))
1650 constexpr(&value, NULL); /* get value */
1651 /* add_constant() checks whether a variable (global or local) or
1652 * a constant with the same name already exists */
1653 add_constant(constname, value, vclass, tag);
1654 if (multiplier == 1)
1655 value += size;
1656 else
1657 value *= size * multiplier;
1658 }
1659 while (matchtoken(','));
1660 needtoken('}'); /* terminates the constant list */
1661 matchtoken(';'); /* eat an optional ; */
1662
1663 /* set the enum name to the last value plus one */
1664 if (enumname[0] != '\0')
1665 add_constant(enumname, value, vclass, tag);
1666}
1667
1668/*
1669 * Finds a function in the global symbol table or creates a new entry.
1670 * It does some basic processing and error checking.
1671 */
1672symbol *
1673fetchfunc(char *name, int tag)
1674{
1675 symbol *sym;
1676 cell offset;
1677
1678 offset = code_idx;
1679 if ((sc_debug & sSYMBOLIC) != 0)
1680 {
1681 offset += opcodes(1) + opargs(3) + nameincells(name);
1682 /* ^^^ The address for the symbol is the code address. But the
1683 * "symbol" instruction itself generates code. Therefore the
1684 * offset is pre-adjusted to the value it will have after the
1685 * symbol instruction.
1686 */
1687 } /* if */
1688 if ((sym = findglb(name)))
1689 { /* already in symbol table? */
1690 if (sym->ident != iFUNCTN)
1691 {
1692 error(21, name); /* yes, but not as a function */
1693 return NULL; /* make sure the old symbol is not damaged */
1694 }
1695 else if ((sym->usage & uDEFINE) != 0)
1696 {
1697 error(21, name); /* yes, and it's already defined */
1698 }
1699 else if ((sym->usage & uNATIVE) != 0)
1700 {
1701 error(21, name); /* yes, and it is an native */
1702 } /* if */
1703 assert(sym->vclass == sGLOBAL);
1704 if ((sym->usage & uDEFINE) == 0)
1705 {
1706 /* as long as the function stays undefined, update the address
1707 * and the tag */
1708 sym->addr = offset;
1709 sym->tag = tag;
1710 } /* if */
1711 }
1712 else
1713 {
1714 /* don't set the "uDEFINE" flag; it may be a prototype */
1715 sym = addsym(name, offset, iFUNCTN, sGLOBAL, tag, 0);
1716 /* assume no arguments */
1717 sym->dim.arglist = (arginfo *) malloc(1 * sizeof(arginfo));
1718 sym->dim.arglist[0].ident = 0;
1719 /* set library ID to NULL (only for native functions) */
1720 sym->x.lib = NULL;
1721 } /* if */
1722 return sym;
1723}
1724
1725/* This routine adds symbolic information for each argument.
1726 */
1727static void
1728define_args(void)
1729{
1730 symbol *sym;
1731
1732 /* At this point, no local variables have been declared. All
1733 * local symbols are function arguments.
1734 */
1735 sym = loctab.next;
1736 while (sym)
1737 {
1738 assert(sym->ident != iLABEL);
1739 assert(sym->vclass == sLOCAL);
1740 defsymbol(sym->name, sym->ident, sLOCAL, sym->addr, sym->tag);
1741 if (sym->ident == iREFARRAY)
1742 {
1743 symbol *sub = sym;
1744
1745 while (sub)
1746 {
1747 symbolrange(sub->dim.array.level, sub->dim.array.length);
1748 sub = finddepend(sub);
1749 } /* while */
1750 } /* if */
1751 sym = sym->next;
1752 } /* while */
1753}
1754
1755static int
1756operatorname(char *name)
1757{
1758 int opertok;
1759 char *str;
1760 cell val;
1761
1762 assert(name != NULL);
1763
1764 /* check the operator */
1765 opertok = lex(&val, &str);
1766 switch (opertok)
1767 {
1768 case '+':
1769 case '-':
1770 case '*':
1771 case '/':
1772 case '%':
1773 case '>':
1774 case '<':
1775 case '!':
1776 case '~':
1777 case '=':
1778 name[0] = (char)opertok;
1779 name[1] = '\0';
1780 break;
1781 case tINC:
1782 strcpy(name, "++");
1783 break;
1784 case tDEC:
1785 strcpy(name, "--");
1786 break;
1787 case tlEQ:
1788 strcpy(name, "==");
1789 break;
1790 case tlNE:
1791 strcpy(name, "!=");
1792 break;
1793 case tlLE:
1794 strcpy(name, "<=");
1795 break;
1796 case tlGE:
1797 strcpy(name, ">=");
1798 break;
1799 default:
1800 name[0] = '\0';
1801 error(61); /* operator cannot be redefined
1802 * (or bad operator name) */
1803 return 0;
1804 } /* switch */
1805
1806 return opertok;
1807}
1808
1809static int
1810operatoradjust(int opertok, symbol * sym, char *opername, int resulttag)
1811{
1812 int tags[2] = { 0, 0 };
1813 int count = 0;
1814 arginfo *arg;
1815 char tmpname[sNAMEMAX + 1];
1816 symbol *oldsym;
1817
1818 if (opertok == 0)
1819 return TRUE;
1820
1821 /* count arguments and save (first two) tags */
1822 while (arg = &sym->dim.arglist[count], arg->ident != 0)
1823 {
1824 if (count < 2)
1825 {
1826 if (arg->numtags > 1)
1827 error(65, count + 1); /* function argument may only have
1828 * a single tag */
1829 else if (arg->numtags == 1)
1830 tags[count] = arg->tags[0];
1831 } /* if */
1832 if (opertok == '~' && count == 0)
1833 {
1834 if (arg->ident != iREFARRAY)
1835 error(73, arg->name); /* must be an array argument */
1836 }
1837 else
1838 {
1839 if (arg->ident != iVARIABLE)
1840 error(66, arg->name); /* must be non-reference argument */
1841 } /* if */
1842 if (arg->hasdefault)
1843 error(59, arg->name); /* arguments of an operator may not
1844 * have a default value */
1845 count++;
1846 } /* while */
1847
1848 /* for '!', '++' and '--', count must be 1
1849 * for '-', count may be 1 or 2
1850 * for '=', count must be 1, and the resulttag is also important
1851 * for all other (binary) operators and the special '~'
1852 * operator, count must be 2
1853 */
1854 switch (opertok)
1855 {
1856 case '!':
1857 case '=':
1858 case tINC:
1859 case tDEC:
1860 if (count != 1)
1861 error(62); /* number or placement of the operands does
1862 * not fit the operator */
1863 break;
1864 case '-':
1865 if (count != 1 && count != 2)
1866 error(62); /* number or placement of the operands does
1867 * not fit the operator */
1868 break;
1869 default:
1870 if (count != 2)
1871 error(62); /* number or placement of the operands does
1872 * not fit the operator */
1873 } /* switch */
1874
1875 if (tags[0] == 0
1876 && ((opertok != '=' && tags[1] == 0) || (opertok == '=' && resulttag == 0)))
1877 error(64); /* cannot change predefined operators */
1878
1879 /* change the operator name */
1880 assert(opername[0] != '\0');
1881 operator_symname(tmpname, opername, tags[0], tags[1], count, resulttag);
1882 if ((oldsym = findglb(tmpname)))
1883 {
1884 int i;
1885
1886 if ((oldsym->usage & uDEFINE) != 0)
1887 {
1888 char errname[2 * sNAMEMAX + 16];
1889
1890 funcdisplayname(errname, tmpname);
1891 error(21, errname); /* symbol already defined */
1892 } /* if */
1893 sym->usage |= oldsym->usage; /* copy flags from the previous
1894 * definition */
1895 for (i = 0; i < oldsym->numrefers; i++)
1896 if (oldsym->refer[i])
1897 refer_symbol(sym, oldsym->refer[i]);
1898 delete_symbol(&glbtab, oldsym);
1899 } /* if */
1900 if ((sc_debug & sSYMBOLIC) != 0)
1901 sym->addr += nameincells(tmpname) - nameincells(sym->name);
1902 strcpy(sym->name, tmpname);
1903 sym->hash = namehash(sym->name); /* calculate new hash */
1904
1905 /* operators should return a value, except the '~' operator */
1906 if (opertok != '~')
1907 sym->usage |= uRETVALUE;
1908
1909 return TRUE;
1910}
1911
1912static int
1913check_operatortag(int opertok, int resulttag, char *opername)
1914{
1915 assert(opername != NULL && opername[0] != '\0');
1916 switch (opertok)
1917 {
1918 case '!':
1919 case '<':
1920 case '>':
1921 case tlEQ:
1922 case tlNE:
1923 case tlLE:
1924 case tlGE:
1925 if (resulttag != sc_addtag("bool"))
1926 {
1927 error(63, opername, "bool:"); /* operator X requires
1928 * a "bool:" result tag */
1929 return FALSE;
1930 } /* if */
1931 break;
1932 case '~':
1933 if (resulttag != 0)
1934 {
1935 error(63, opername, "_:"); /* operator "~" requires
1936 * a "_:" result tag */
1937 return FALSE;
1938 } /* if */
1939 break;
1940 } /* switch */
1941 return TRUE;
1942}
1943
1944static char *
1945tag2str(char *dest, int tag)
1946{
1947 tag &= TAGMASK;
1948 assert(tag >= 0);
1949 sprintf(dest, "0%x", tag);
1950 return isdigit(dest[1]) ? &dest[1] : dest;
1951}
1952
1953char *
1954operator_symname(char *symname, char *opername, int tag1, int tag2,
1955 int numtags, int resulttag)
1956{
1957 char tagstr1[10], tagstr2[10];
1958 int opertok;
1959
1960 assert(numtags >= 1 && numtags <= 2);
1961 opertok = (opername[1] == '\0') ? opername[0] : 0;
1962 if (opertok == '=')
1963 sprintf(symname, "%s%s%s", tag2str(tagstr1, resulttag), opername,
1964 tag2str(tagstr2, tag1));
1965 else if (numtags == 1 || opertok == '~')
1966 sprintf(symname, "%s%s", opername, tag2str(tagstr1, tag1));
1967 else
1968 sprintf(symname, "%s%s%s", tag2str(tagstr1, tag1), opername,
1969 tag2str(tagstr2, tag2));
1970 return symname;
1971}
1972
1973static int
1974parse_funcname(char *fname, int *tag1, int *tag2, char *opname)
1975{
1976 char *ptr, *name;
1977 int unary;
1978
1979 /* tags are only positive, so if the function name starts with a '-',
1980 * the operator is an unary '-' or '--' operator.
1981 */
1982 if (*fname == '-')
1983 {
1984 *tag1 = 0;
1985 unary = TRUE;
1986 ptr = fname;
1987 }
1988 else
1989 {
1990 *tag1 = (int)strtol(fname, &ptr, 16);
1991 unary = ptr == fname; /* unary operator if it doesn't start
1992 * with a tag name */
1993 } /* if */
1994 assert(!unary || *tag1 == 0);
1995 assert(*ptr != '\0');
1996 for (name = opname; !isdigit(*ptr);)
1997 *name++ = *ptr++;
1998 *name = '\0';
1999 *tag2 = (int)strtol(ptr, NULL, 16);
2000 return unary;
2001}
2002
2003char *
2004funcdisplayname(char *dest, char *funcname)
2005{
2006 int tags[2];
2007 char opname[10];
2008 constvalue *tagsym[2];
2009 int unary;
2010
2011 if (isalpha(*funcname) || *funcname == '_' || *funcname == PUBLIC_CHAR
2012 || *funcname == '\0')
2013 {
2014 if (dest != funcname)
2015 strcpy(dest, funcname);
2016 return dest;
2017 } /* if */
2018
2019 unary = parse_funcname(funcname, &tags[0], &tags[1], opname);
2020 tagsym[1] = find_constval_byval(&tagname_tab, tags[1]);
2021 assert(tagsym[1] != NULL);
2022 if (unary)
2023 {
2024 sprintf(dest, "operator%s(%s:)", opname, tagsym[1]->name);
2025 }
2026 else
2027 {
2028 tagsym[0] = find_constval_byval(&tagname_tab, tags[0]);
2029 /* special case: the assignment operator has the return value
2030 * as the 2nd tag */
2031 if (opname[0] == '=' && opname[1] == '\0')
2032 sprintf(dest, "%s:operator%s(%s:)", tagsym[0]->name, opname,
2033 tagsym[1]->name);
2034 else
2035 sprintf(dest, "operator%s(%s:,%s:)", opname, tagsym[0]->name,
2036 tagsym[1]->name);
2037 } /* if */
2038 return dest;
2039}
2040
2041static void
2042funcstub(int native)
2043{
2044 int tok, tag;
2045 char *str;
2046 cell val;
2047 char symbolname[sNAMEMAX + 1];
2048 symbol *sym;
2049 int opertok;
2050
2051 opertok = 0;
2052 lastst = 0;
2053 litidx = 0; /* clear the literal pool */
2054
2055 tag = sc_addtag(NULL);
2056 tok = lex(&val, &str);
2057 if (native)
2058 {
2059 if (tok == tPUBLIC || tok == tSTOCK || tok == tSTATIC ||
2060 (tok == tSYMBOL && *str == PUBLIC_CHAR))
2061 error(42); /* invalid combination of class specifiers */
2062 }
2063 else
2064 {
2065 if (tok == tPUBLIC || tok == tSTATIC)
2066 tok = lex(&val, &str);
2067 } /* if */
2068 if (tok == tOPERATOR)
2069 {
2070 opertok = operatorname(symbolname);
2071 if (opertok == 0)
2072 return; /* error message already given */
2073 check_operatortag(opertok, tag, symbolname);
2074 }
2075 else
2076 {
2077 if (tok != tSYMBOL && freading)
2078 {
2079 error(10); /* illegal function or declaration */
2080 return;
2081 } /* if */
2082 strcpy(symbolname, str);
2083 } /* if */
2084 needtoken('('); /* only functions may be native/forward */
2085
2086 sym = fetchfunc(symbolname, tag); /* get a pointer to the
2087 * function entry */
2088 if (!sym)
2089 return;
2090 if (native)
2091 {
2092 sym->usage = uNATIVE | uRETVALUE | uDEFINE;
2093 sym->x.lib = curlibrary;
2094 } /* if */
2095
2096 declargs(sym);
2097 /* "declargs()" found the ")" */
2098 if (!operatoradjust(opertok, sym, symbolname, tag))
2099 sym->usage &= ~uDEFINE;
2100 /* for a native operator, also need to specify an "exported"
2101 * function name; for a native function, this is optional
2102 */
2103 if (native)
2104 {
2105 if (opertok != 0)
2106 {
2107 needtoken('=');
2108 lexpush(); /* push back, for matchtoken() to retrieve again */
2109 } /* if */
2110 if (matchtoken('='))
2111 {
2112 /* allow number or symbol */
2113 if (matchtoken(tSYMBOL))
2114 {
2115 tokeninfo(&val, &str);
2116 if (strlen(str) > sEXPMAX)
2117 {
2118 error(220, str, sEXPMAX);
2119 str[sEXPMAX] = '\0';
2120 } /* if */
2121 insert_alias(sym->name, str);
2122 }
2123 else
2124 {
2125 constexpr(&val, NULL);
2126 sym->addr = val;
2127 /*
2128 * ?? Must mark this address, so that it won't be generated again
2129 * and it won't be written to the output file. At the moment,
2130 * I have assumed that this syntax is only valid if val < 0.
2131 * To properly mix "normal" native functions and indexed native
2132 * functions, one should use negative indices anyway.
2133 * Special code for a negative index in sym->addr exists in
2134 * SC4.C (ffcall()) and in SC6.C (the loops for counting the
2135 * number of native variables and for writing them).
2136 */
2137 } /* if */
2138 } /* if */
2139 } /* if */
2140 needtoken(tTERM);
2141
2142 litidx = 0; /* clear the literal pool */
2143 /* clear local variables queue */
2144 delete_symbols(&loctab, 0, TRUE, TRUE);
2145}
2146
2147/* newfunc - begin a function
2148 *
2149 * This routine is called from "parse" and tries to make a function
2150 * out of the following text
2151 *
2152 * Global references: funcstatus,lastst,litidx
2153 * rettype (altered)
2154 * curfunc (altered)
2155 * declared (altered)
2156 * glb_declared (altered)
2157 * sc_alignnext (altered)
2158 */
2159static int
2160newfunc(char *firstname, int firsttag, int fpublic, int fstatic, int stock)
2161{
2162 symbol *sym;
2163 int argcnt, tok, tag, funcline;
2164 int opertok, opererror;
2165 char symbolname[sNAMEMAX + 1];
2166 char *str;
2167 cell val, cidx, glbdecl;
2168 int filenum;
2169
2170 litidx = 0; /* clear the literal pool ??? */
2171 opertok = 0;
2172 lastst = 0; /* no statement yet */
2173 cidx = 0; /* just to avoid compiler warnings */
2174 glbdecl = 0;
2175 filenum = fcurrent; /* save file number at start of declaration */
2176
2177 if (firstname)
2178 {
2179 assert(strlen(firstname) <= sNAMEMAX);
2180 strcpy(symbolname, firstname); /* save symbol name */
2181 tag = firsttag;
2182 }
2183 else
2184 {
2185 tag = (firsttag >= 0) ? firsttag : sc_addtag(NULL);
2186 tok = lex(&val, &str);
2187 assert(!fpublic);
2188 if (tok == tNATIVE || (tok == tPUBLIC && stock))
2189 error(42); /* invalid combination of class specifiers */
2190 if (tok == tOPERATOR)
2191 {
2192 opertok = operatorname(symbolname);
2193 if (opertok == 0)
2194 return TRUE; /* error message already given */
2195 check_operatortag(opertok, tag, symbolname);
2196 }
2197 else
2198 {
2199 if (tok != tSYMBOL && freading)
2200 {
2201 error(20, str); /* invalid symbol name */
2202 return FALSE;
2203 } /* if */
2204 assert(strlen(str) <= sNAMEMAX);
2205 strcpy(symbolname, str);
2206 } /* if */
2207 } /* if */
2208 /* check whether this is a function or a variable declaration */
2209 if (!matchtoken('('))
2210 return FALSE;
2211 /* so it is a function, proceed */
2212 funcline = fline; /* save line at which the function is defined */
2213 if (symbolname[0] == PUBLIC_CHAR)
2214 {
2215 fpublic = TRUE; /* implicitly public function */
2216 if (stock)
2217 error(42); /* invalid combination of class specifiers */
2218 } /* if */
2219 sym = fetchfunc(symbolname, tag); /* get a pointer to the
2220 * function entry */
2221 if (!sym)
2222 return TRUE;
2223 if (fpublic)
2224 sym->usage |= uPUBLIC;
2225 if (fstatic)
2226 sym->fnumber = filenum;
2227 /* declare all arguments */
2228 argcnt = declargs(sym);
2229 opererror = !operatoradjust(opertok, sym, symbolname, tag);
2230 if (strcmp(symbolname, uMAINFUNC) == 0)
2231 {
2232 if (argcnt > 0)
2233 error(5); /* "main()" function may not have any arguments */
2234 sym->usage |= uREAD; /* "main()" is the program's entry point:
2235 * always used */
2236 } /* if */
2237 /* "declargs()" found the ")"; if a ";" appears after this, it was a
2238 * prototype */
2239 if (matchtoken(';'))
2240 {
2241 if (!sc_needsemicolon)
2242 error(218); /* old style prototypes used with optional
2243 * semicolumns */
2244 delete_symbols(&loctab, 0, TRUE, TRUE); /* prototype is done;
2245 * forget everything */
2246 return TRUE;
2247 } /* if */
2248 /* so it is not a prototype, proceed */
2249 /* if this is a function that is not referred to (this can only be
2250 * detected in the second stage), shut code generation off */
2251 if (sc_status == statWRITE && (sym->usage & uREAD) == 0)
2252 {
2253 sc_status = statSKIP;
2254 cidx = code_idx;
2255 glbdecl = glb_declared;
2256 } /* if */
2257 begcseg();
2258 sym->usage |= uDEFINE; /* set the definition flag */
2259 if (fpublic)
2260 sym->usage |= uREAD; /* public functions are always "used" */
2261 if (stock)
2262 sym->usage |= uSTOCK;
2263 if (opertok != 0 && opererror)
2264 sym->usage &= ~uDEFINE;
2265 defsymbol(sym->name, iFUNCTN, sGLOBAL,
2266 code_idx + opcodes(1) + opargs(3) + nameincells(sym->name), tag);
2267 /* ^^^ The address for the symbol is the code address. But the
2268 * "symbol" instruction itself generates code. Therefore the
2269 * offset is pre-adjusted to the value it will have after the
2270 * symbol instruction.
2271 */
2272 startfunc(sym->name); /* creates stack frame */
2273 if ((sc_debug & sSYMBOLIC) != 0)
2274 setline(funcline, fcurrent);
2275 if (sc_alignnext)
2276 {
2277 alignframe(sc_dataalign);
2278 sc_alignnext = FALSE;
2279 } /* if */
2280 declared = 0; /* number of local cells */
2281 rettype = (sym->usage & uRETVALUE); /* set "return type" variable */
2282 curfunc = sym;
2283 define_args(); /* add the symbolic info for the function arguments */
2284 statement(NULL, FALSE);
2285 if ((rettype & uRETVALUE) != 0)
2286 sym->usage |= uRETVALUE;
2287 if (declared != 0)
2288 {
2289 /* This happens only in a very special (and useless) case, where a
2290 * function has only a single statement in its body (no compound
2291 * block) and that statement declares a new variable
2292 */
2293 modstk((int)declared * sizeof(cell)); /* remove all local
2294 * variables */
2295 declared = 0;
2296 } /* if */
2297 if ((lastst != tRETURN) && (lastst != tGOTO))
2298 {
2299 const1(0);
2300 ffret();
2301 if ((sym->usage & uRETVALUE) != 0)
2302 {
2303 char symname[2 * sNAMEMAX + 16]; /* allow space for user
2304 * defined operators */
2305 funcdisplayname(symname, sym->name);
2306 error(209, symname); /* function should return a value */
2307 } /* if */
2308 } /* if */
2309 endfunc();
2310 if (litidx)
2311 { /* if there are literals defined */
2312 glb_declared += litidx;
2313 begdseg(); /* flip to DATA segment */
2314 dumplits(); /* dump literal strings */
2315 litidx = 0;
2316 } /* if */
2317 testsymbols(&loctab, 0, TRUE, TRUE); /* test for unused arguments
2318 * and labels */
2319 delete_symbols(&loctab, 0, TRUE, TRUE); /* clear local variables
2320 * queue */
2321 assert(loctab.next == NULL);
2322 curfunc = NULL;
2323 if (sc_status == statSKIP)
2324 {
2325 sc_status = statWRITE;
2326 code_idx = cidx;
2327 glb_declared = glbdecl;
2328 } /* if */
2329 return TRUE;
2330}
2331
2332static int
2333argcompare(arginfo * a1, arginfo * a2)
2334{
2335 int result, level;
2336
2337 result = strcmp(a1->name, a2->name) == 0;
2338 if (result)
2339 result = a1->ident == a2->ident;
2340 if (result)
2341 result = a1->usage == a2->usage;
2342 if (result)
2343 result = a1->numtags == a2->numtags;
2344 if (result)
2345 {
2346 int i;
2347
2348 for (i = 0; i < a1->numtags && result; i++)
2349 result = a1->tags[i] == a2->tags[i];
2350 } /* if */
2351 if (result)
2352 result = a1->hasdefault == a2->hasdefault;
2353 if (a1->hasdefault)
2354 {
2355 if (a1->ident == iREFARRAY)
2356 {
2357 if (result)
2358 result = a1->defvalue.array.size == a2->defvalue.array.size;
2359 if (result)
2360 result =
2361 a1->defvalue.array.arraysize == a2->defvalue.array.arraysize;
2362 /* also check the dimensions of both arrays */
2363 if (result)
2364 result = a1->numdim == a2->numdim;
2365 for (level = 0; result && level < a1->numdim; level++)
2366 result = a1->dim[level] == a2->dim[level];
2367 /* ??? should also check contents of the default array
2368 * (these troubles go away in a 2-pass compiler that forbids
2369 * double declarations, but Small currently does not forbid them)
2370 */
2371 }
2372 else
2373 {
2374 if (result)
2375 {
2376 if ((a1->hasdefault & uSIZEOF) != 0
2377 || (a1->hasdefault & uTAGOF) != 0)
2378 result = a1->hasdefault == a2->hasdefault
2379 && strcmp(a1->defvalue.size.symname,
2380 a2->defvalue.size.symname) == 0
2381 && a1->defvalue.size.level == a2->defvalue.size.level;
2382 else
2383 result = a1->defvalue.val == a2->defvalue.val;
2384 } /* if */
2385 } /* if */
2386 if (result)
2387 result = a1->defvalue_tag == a2->defvalue_tag;
2388 } /* if */
2389 return result;
2390}
2391
2392/* declargs()
2393 *
2394 * This routine adds an entry in the local symbol table for each
2395 * argument found in the argument list.
2396 * It returns the number of arguments.
2397 */
2398static int
2399declargs(symbol * sym)
2400{
2401#define MAXTAGS 16
2402 char *ptr;
2403 int argcnt, oldargcnt, tok, tags[MAXTAGS], numtags;
2404 cell val;
2405 arginfo arg, *arglist;
2406 char name[sNAMEMAX + 1];
2407 int ident, fpublic, fconst;
2408 int idx;
2409
2410 /* if the function is already defined earlier, get the number of
2411 * arguments of the existing definition
2412 */
2413 oldargcnt = 0;
2414 if ((sym->usage & uPROTOTYPED) != 0)
2415 while (sym->dim.arglist[oldargcnt].ident != 0)
2416 oldargcnt++;
2417 argcnt = 0; /* zero aruments up to now */
2418 ident = iVARIABLE;
2419 numtags = 0;
2420 fconst = FALSE;
2421 fpublic = (sym->usage & uPUBLIC) != 0;
2422 /* the '(' parantheses has already been parsed */
2423 if (!matchtoken(')'))
2424 {
2425 do
2426 { /* there are arguments; process them */
2427 /* any legal name increases argument count (and stack offset) */
2428 tok = lex(&val, &ptr);
2429 switch (tok)
2430 {
2431 case 0:
2432 /* nothing */
2433 break;
2434 case '&':
2435 if (ident != iVARIABLE || numtags > 0)
2436 error(1, "-identifier-", "&");
2437 ident = iREFERENCE;
2438 break;
2439 case tCONST:
2440 if (ident != iVARIABLE || numtags > 0)
2441 error(1, "-identifier-", "const");
2442 fconst = TRUE;
2443 break;
2444 case tLABEL:
2445 if (numtags > 0)
2446 error(1, "-identifier-", "-tagname-");
2447 tags[0] = sc_addtag(ptr);
2448 numtags = 1;
2449 break;
2450 case '{':
2451 if (numtags > 0)
2452 error(1, "-identifier-", "-tagname-");
2453 numtags = 0;
2454 while (numtags < MAXTAGS)
2455 {
2456 if (!matchtoken('_') && !needtoken(tSYMBOL))
2457 break;
2458 tokeninfo(&val, &ptr);
2459 tags[numtags++] = sc_addtag(ptr);
2460 if (matchtoken('}'))
2461 break;
2462 needtoken(',');
2463 } /* for */
2464 needtoken(':');
2465 tok = tLABEL; /* for outer loop:
2466 * flag that we have seen a tagname */
2467 break;
2468 case tSYMBOL:
2469 if (argcnt >= sMAXARGS)
2470 error(45); /* too many function arguments */
2471 strcpy(name, ptr); /* save symbol name */
2472 if (name[0] == PUBLIC_CHAR)
2473 error(56, name); /* function arguments cannot be public */
2474 if (numtags == 0)
2475 tags[numtags++] = 0; /* default tag */
2476 /* Stack layout:
2477 * base + 0*sizeof(cell) == previous "base"
2478 * base + 1*sizeof(cell) == function return address
2479 * base + 2*sizeof(cell) == number of arguments
2480 * base + 3*sizeof(cell) == first argument of the function
2481 * So the offset of each argument is:
2482 * "(argcnt+3) * sizeof(cell)".
2483 */
2484 doarg(name, ident, (argcnt + 3) * sizeof(cell), tags, numtags,
2485 fpublic, fconst, &arg);
2486 if (fpublic && arg.hasdefault)
2487 error(59, name); /* arguments of a public function may not
2488 * have a default value */
2489 if ((sym->usage & uPROTOTYPED) == 0)
2490 {
2491 /* redimension the argument list, add the entry */
2492 sym->dim.arglist =
2493 (arginfo *) realloc(sym->dim.arglist,
2494 (argcnt + 2) * sizeof(arginfo));
2495 if (!sym->dim.arglist)
2496 error(103); /* insufficient memory */
2497 sym->dim.arglist[argcnt] = arg;
2498 sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
2499 * terminated */
2500 }
2501 else
2502 {
2503 /* check the argument with the earlier definition */
2504 if (argcnt > oldargcnt
2505 || !argcompare(&sym->dim.arglist[argcnt], &arg))
2506 error(25); /* function definition does not match prototype */
2507 /* may need to free default array argument and the tag list */
2508 if (arg.ident == iREFARRAY && arg.hasdefault)
2509 free(arg.defvalue.array.data);
2510 else if (arg.ident == iVARIABLE
2511 && ((arg.hasdefault & uSIZEOF) != 0
2512 || (arg.hasdefault & uTAGOF) != 0))
2513 free(arg.defvalue.size.symname);
2514 free(arg.tags);
2515 } /* if */
2516 argcnt++;
2517 ident = iVARIABLE;
2518 numtags = 0;
2519 fconst = FALSE;
2520 break;
2521 case tELLIPS:
2522 if (ident != iVARIABLE)
2523 error(10); /* illegal function or declaration */
2524 if (numtags == 0)
2525 tags[numtags++] = 0; /* default tag */
2526 if ((sym->usage & uPROTOTYPED) == 0)
2527 {
2528 /* redimension the argument list, add the entry iVARARGS */
2529 sym->dim.arglist =
2530 (arginfo *) realloc(sym->dim.arglist,
2531 (argcnt + 2) * sizeof(arginfo));
2532 if (!sym->dim.arglist)
2533 error(103); /* insufficient memory */
2534 sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
2535 * terminated */
2536 sym->dim.arglist[argcnt].ident = iVARARGS;
2537 sym->dim.arglist[argcnt].hasdefault = FALSE;
2538 sym->dim.arglist[argcnt].defvalue.val = 0;
2539 sym->dim.arglist[argcnt].defvalue_tag = 0;
2540 sym->dim.arglist[argcnt].numtags = numtags;
2541 sym->dim.arglist[argcnt].tags =
2542 (int *)malloc(numtags * sizeof tags[0]);
2543 if (!sym->dim.arglist[argcnt].tags)
2544 error(103); /* insufficient memory */
2545 memcpy(sym->dim.arglist[argcnt].tags, tags,
2546 numtags * sizeof tags[0]);
2547 }
2548 else
2549 {
2550 if (argcnt > oldargcnt
2551 || sym->dim.arglist[argcnt].ident != iVARARGS)
2552 error(25); /* function definition does not match prototype */
2553 } /* if */
2554 argcnt++;
2555 break;
2556 default:
2557 error(10); /* illegal function or declaration */
2558 } /* switch */
2559 }
2560 while (tok == '&' || tok == tLABEL || tok == tCONST || (tok != tELLIPS && matchtoken(','))); /* more? */
2561 /* if the next token is not ",", it should be ")" */
2562 needtoken(')');
2563 } /* if */
2564 /* resolve any "sizeof" arguments (now that all arguments are known) */
2565 assert(sym->dim.arglist != NULL);
2566 arglist = sym->dim.arglist;
2567 for (idx = 0; idx < argcnt && arglist[idx].ident != 0; idx++)
2568 {
2569 if ((arglist[idx].hasdefault & uSIZEOF) != 0
2570 || (arglist[idx].hasdefault & uTAGOF) != 0)
2571 {
2572 int altidx;
2573
2574 /* Find the argument with the name mentioned after the "sizeof".
2575 * Note that we cannot use findloc here because we need the
2576 * arginfo struct, not the symbol.
2577 */
2578 ptr = arglist[idx].defvalue.size.symname;
2579 for (altidx = 0;
2580 altidx < argcnt && strcmp(ptr, arglist[altidx].name) != 0;
2581 altidx++)
2582 /* nothing */ ;
2583 if (altidx >= argcnt)
2584 {
2585 error(17, ptr); /* undefined symbol */
2586 }
2587 else
2588 {
2589 /* check the level against the number of dimensions */
2590 /* the level must be zero for "tagof" values */
2591 assert(arglist[idx].defvalue.size.level == 0
2592 || (arglist[idx].hasdefault & uSIZEOF) != 0);
2593 if (arglist[idx].defvalue.size.level > 0
2594 && arglist[idx].defvalue.size.level >=
2595 arglist[altidx].numdim)
2596 error(28); /* invalid subscript */
2597 if (arglist[altidx].ident != iREFARRAY)
2598 {
2599 assert(arglist[altidx].ident == iVARIABLE
2600 || arglist[altidx].ident == iREFERENCE);
2601 error(223, ptr); /* redundant sizeof */
2602 } /* if */
2603 } /* if */
2604 } /* if */
2605 } /* for */
2606
2607 sym->usage |= uPROTOTYPED;
2608 errorset(sRESET); /* reset error flag (clear the "panic mode") */
2609 return argcnt;
2610}
2611
2612/* doarg - declare one argument type
2613 *
2614 * this routine is called from "declargs()" and adds an entry in the
2615 * local symbol table for one argument. "fpublic" indicates whether
2616 * the function for this argument list is public.
2617 * The arguments themselves are never public.
2618 */
2619static void
2620doarg(char *name, int ident, int offset, int tags[], int numtags,
2621 int fpublic, int fconst, arginfo * arg)
2622{
2623 symbol *argsym;
2624 cell size;
2625 int idxtag[sDIMEN_MAX];
2626
2627 strcpy(arg->name, name);
2628 arg->hasdefault = FALSE; /* preset (most common case) */
2629 arg->defvalue.val = 0; /* clear */
2630 arg->defvalue_tag = 0;
2631 arg->numdim = 0;
2632 if (matchtoken('['))
2633 {
2634 if (ident == iREFERENCE)
2635 error(67, name); /*illegal declaration ("&name[]" is unsupported) */
2636 do
2637 {
2638 if (arg->numdim == sDIMEN_MAX)
2639 {
2640 error(53); /* exceeding maximum number of dimensions */
2641 return;
2642 } /* if */
2643 /* there is no check for non-zero major dimensions here, only if
2644 * the array parameter has a default value, we enforce that all
2645 * array dimensions, except the last, are non-zero
2646 */
2647 size = needsub(&idxtag[arg->numdim]); /* may be zero here,
2648 *it is a pointer anyway */
2649#if INT_MAX < LONG_MAX
2650 if (size > INT_MAX)
2651 error(105); /* overflow, exceeding capacity */
2652#endif
2653 arg->dim[arg->numdim] = (int)size;
2654 arg->numdim += 1;
2655 }
2656 while (matchtoken('['));
2657 ident = iREFARRAY; /* "reference to array" (is a pointer) */
2658 if (matchtoken('='))
2659 {
2660 int level;
2661
2662 lexpush(); /* initials() needs the "=" token again */
2663 assert(numtags > 0);
2664 /* for the moment, when a default value is given for the array,
2665 * all dimension sizes, except the last, must be non-zero
2666 * (function initials() requires to know the major dimensions)
2667 */
2668 for (level = 0; level < arg->numdim - 1; level++)
2669 if (arg->dim[level] == 0)
2670 error(52); /* only last dimension may be variable length */
2671 initials(ident, tags[0], &size, arg->dim, arg->numdim);
2672 assert(size >= litidx);
2673 /* allocate memory to hold the initial values */
2674 arg->defvalue.array.data = (cell *) malloc(litidx * sizeof(cell));
2675 if (arg->defvalue.array.data)
2676 {
2677 int i;
2678
2679 memcpy(arg->defvalue.array.data, litq, litidx * sizeof(cell));
2680 arg->hasdefault = TRUE; /* argument has default value */
2681 arg->defvalue.array.size = litidx;
2682 arg->defvalue.array.addr = -1;
2683 /* calculate size to reserve on the heap */
2684 arg->defvalue.array.arraysize = 1;
2685 for (i = 0; i < arg->numdim; i++)
2686 arg->defvalue.array.arraysize *= arg->dim[i];
2687 if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
2688 arg->defvalue.array.arraysize = arg->defvalue.array.size;
2689 } /* if */
2690 litidx = 0; /* reset */
2691 } /* if */
2692 }
2693 else
2694 {
2695 if (matchtoken('='))
2696 {
2697 unsigned char size_tag_token;
2698
2699 assert(ident == iVARIABLE || ident == iREFERENCE);
2700 arg->hasdefault = TRUE; /* argument has a default value */
2701 size_tag_token =
2702 (unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
2703 if (size_tag_token == 0)
2704 size_tag_token =
2705 (unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
2706 if (size_tag_token != 0)
2707 {
2708 int paranthese;
2709
2710 if (ident == iREFERENCE)
2711 error(66, name); /* argument may not be a reference */
2712 paranthese = 0;
2713 while (matchtoken('('))
2714 paranthese++;
2715 if (needtoken(tSYMBOL))
2716 {
2717 /* save the name of the argument whose size id to take */
2718 char *name;
2719 cell val;
2720
2721 tokeninfo(&val, &name);
2722 if (!(arg->defvalue.size.symname = strdup(name)))
2723 error(103); /* insufficient memory */
2724 arg->defvalue.size.level = 0;
2725 if (size_tag_token == uSIZEOF)
2726 {
2727 while (matchtoken('['))
2728 {
2729 arg->defvalue.size.level += (short)1;
2730 needtoken(']');
2731 } /* while */
2732 } /* if */
2733 if (ident == iVARIABLE) /* make sure we set this only if
2734 * not a reference */
2735 arg->hasdefault |= size_tag_token; /* uSIZEOF or uTAGOF */
2736 } /* if */
2737 while (paranthese--)
2738 needtoken(')');
2739 }
2740 else
2741 {
2742 constexpr(&arg->defvalue.val, &arg->defvalue_tag);
2743 assert(numtags > 0);
2744 if (!matchtag(tags[0], arg->defvalue_tag, TRUE))
2745 error(213); /* tagname mismatch */
2746 } /* if */
2747 } /* if */
2748 } /* if */
2749 arg->ident = (char)ident;
2750 arg->usage = (char)(fconst ? uCONST : 0);
2751 arg->numtags = numtags;
2752 arg->tags = (int *)malloc(numtags * sizeof tags[0]);
2753 if (!arg->tags)
2754 error(103); /* insufficient memory */
2755 memcpy(arg->tags, tags, numtags * sizeof tags[0]);
2756 argsym = findloc(name);
2757 if (argsym)
2758 {
2759 error(21, name); /* symbol already defined */
2760 }
2761 else
2762 {
2763 if ((argsym = findglb(name)) && argsym->ident != iFUNCTN)
2764 error(219, name); /* variable shadows another symbol */
2765 /* add details of type and address */
2766 assert(numtags > 0);
2767 argsym = addvariable(name, offset, ident, sLOCAL, tags[0],
2768 arg->dim, arg->numdim, idxtag);
2769 argsym->compound = 0;
2770 if (ident == iREFERENCE)
2771 argsym->usage |= uREAD; /* because references are passed back */
2772 if (fpublic)
2773 argsym->usage |= uREAD; /* arguments of public functions
2774 * are always "used" */
2775 if (fconst)
2776 argsym->usage |= uCONST;
2777 } /* if */
2778}
2779
2780static int
2781count_referrers(symbol * entry)
2782{
2783 int i, count;
2784
2785 count = 0;
2786 for (i = 0; i < entry->numrefers; i++)
2787 if (entry->refer[i])
2788 count++;
2789 return count;
2790}
2791
2792/* Every symbol has a referrer list, that contains the functions that
2793 * use the symbol. Now, if function "apple" is accessed by functions
2794 * "banana" and "citron", but neither function "banana" nor "citron" are
2795 * used by anyone else, then, by inference, function "apple" is not used
2796 * either. */
2797static void
2798reduce_referrers(symbol * root)
2799{
2800 int i, restart;
2801 symbol *sym, *ref;
2802
2803 do
2804 {
2805 restart = 0;
2806 for (sym = root->next; sym; sym = sym->next)
2807 {
2808 if (sym->parent)
2809 continue; /* hierarchical data type */
2810 if (sym->ident == iFUNCTN
2811 && (sym->usage & uNATIVE) == 0
2812 && (sym->usage & uPUBLIC) == 0
2813 && strcmp(sym->name, uMAINFUNC) != 0
2814 && count_referrers(sym) == 0)
2815 {
2816 sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
2817 * there is no referrer */
2818 /* find all symbols that are referred by this symbol */
2819 for (ref = root->next; ref; ref = ref->next)
2820 {
2821 if (ref->parent)
2822 continue; /* hierarchical data type */
2823 assert(ref->refer != NULL);
2824 for (i = 0; i < ref->numrefers && ref->refer[i] != sym;
2825 i++)
2826 /* nothing */ ;
2827 if (i < ref->numrefers)
2828 {
2829 assert(ref->refer[i] == sym);
2830 ref->refer[i] = NULL;
2831 restart++;
2832 } /* if */
2833 } /* for */
2834 }
2835 else if ((sym->ident == iVARIABLE || sym->ident == iARRAY)
2836 && (sym->usage & uPUBLIC) == 0
2837 && !sym->parent && count_referrers(sym) == 0)
2838 {
2839 sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
2840 * there is no referrer */
2841 } /* if */
2842 } /* for */
2843 /* after removing a symbol, check whether more can be removed */
2844 }
2845 while (restart > 0);
2846}
2847
2848/* testsymbols - test for unused local or global variables
2849 *
2850 * "Public" functions are excluded from the check, since these
2851 * may be exported to other object modules.
2852 * Labels are excluded from the check if the argument 'testlabs'
2853 * is 0. Thus, labels are not tested until the end of the function.
2854 * Constants may also be excluded (convenient for global constants).
2855 *
2856 * When the nesting level drops below "level", the check stops.
2857 *
2858 * The function returns whether there is an "entry" point for the file.
2859 * This flag will only be 1 when browsing the global symbol table.
2860 */
2861static int
2862testsymbols(symbol * root, int level, int testlabs, int testconst)
2863{
2864 char symname[2 * sNAMEMAX + 16];
2865 int entry = FALSE;
2866
2867 symbol *sym = root->next;
2868
2869 while (sym && sym->compound >= level)
2870 {
2871 switch (sym->ident)
2872 {
2873 case iLABEL:
2874 if (testlabs)
2875 {
2876 if ((sym->usage & uDEFINE) == 0)
2877 error(19, sym->name); /* not a label: ... */
2878 else if ((sym->usage & uREAD) == 0)
2879 error(203, sym->name); /* symbol isn't used: ... */
2880 } /* if */
2881 break;
2882 case iFUNCTN:
2883 if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK)) == uDEFINE)
2884 {
2885 funcdisplayname(symname, sym->name);
2886 if (symname[0] != '\0')
2887 error(203, symname); /* symbol isn't used ...
2888 * (and not native/stock) */
2889 } /* if */
2890 if ((sym->usage & uPUBLIC) != 0
2891 || strcmp(sym->name, uMAINFUNC) == 0)
2892 entry = TRUE; /* there is an entry point */
2893 break;
2894 case iCONSTEXPR:
2895 if (testconst && (sym->usage & uREAD) == 0)
2896 error(203, sym->name); /* symbol isn't used: ... */
2897 break;
2898 default:
2899 /* a variable */
2900 if (sym->parent)
2901 break; /* hierarchical data type */
2902 if ((sym->usage & (uWRITTEN | uREAD | uSTOCK | uPUBLIC)) == 0)
2903 error(203, sym->name); /* symbol isn't used (and not stock
2904 * or public) */
2905 else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC)) == 0)
2906 error(204, sym->name); /* value assigned to symbol is
2907 * never used */
2908#if 0 /*// ??? not sure whether it is a good idea to
2909 * force people use "const" */
2910 else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST)) == 0
2911 && sym->ident == iREFARRAY)
2912 error(214, sym->name); /* make array argument "const" */
2913#endif
2914 } /* if */
2915 sym = sym->next;
2916 } /* while */
2917
2918 return entry;
2919}
2920
2921static cell
2922calc_array_datasize(symbol * sym, cell * offset)
2923{
2924 cell length;
2925
2926 assert(sym != NULL);
2927 assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
2928 length = sym->dim.array.length;
2929 if (sym->dim.array.level > 0)
2930 {
2931 cell sublength =
2932 calc_array_datasize(finddepend(sym), offset);
2933 if (offset)
2934 *offset = length * (*offset + sizeof(cell));
2935 if (sublength > 0)
2936 length *= length * sublength;
2937 else
2938 length = 0;
2939 }
2940 else
2941 {
2942 if (offset)
2943 *offset = 0;
2944 } /* if */
2945 return length;
2946}
2947
2948static void
2949destructsymbols(symbol * root, int level)
2950{
2951 cell offset = 0;
2952 int savepri = FALSE;
2953 symbol *sym = root->next;
2954
2955 while (sym && sym->compound >= level)
2956 {
2957 if (sym->ident == iVARIABLE || sym->ident == iARRAY)
2958 {
2959 char symbolname[16];
2960 symbol *opsym;
2961 cell elements;
2962
2963 /* check that the '~' operator is defined for this tag */
2964 operator_symname(symbolname, "~", sym->tag, 0, 1, 0);
2965 if ((opsym = findglb(symbolname)))
2966 {
2967 /* save PRI, in case of a return statement */
2968 if (!savepri)
2969 {
2970 push1(); /* right-hand operand is in PRI */
2971 savepri = TRUE;
2972 } /* if */
2973 /* if the variable is an array, get the number of elements */
2974 if (sym->ident == iARRAY)
2975 {
2976 elements = calc_array_datasize(sym, &offset);
2977 /* "elements" can be zero when the variable is declared like
2978 * new mytag: myvar[2][] = { {1, 2}, {3, 4} }
2979 * one should declare all dimensions!
2980 */
2981 if (elements == 0)
2982 error(46, sym->name); /* array size is unknown */
2983 }
2984 else
2985 {
2986 elements = 1;
2987 offset = 0;
2988 } /* if */
2989 pushval(elements);
2990 /* call the '~' operator */
2991 address(sym);
2992 addconst(offset); /*add offset to array data to the address */
2993 push1();
2994 pushval(2 * sizeof(cell)); /* 2 parameters */
2995 ffcall(opsym, 1);
2996 if (sc_status != statSKIP)
2997 markusage(opsym, uREAD); /* do not mark as "used" when this
2998 * call itself is skipped */
2999 if (opsym->x.lib)
3000 opsym->x.lib->value += 1; /* increment "usage count"
3001 * of the library */
3002 } /* if */
3003 } /* if */
3004 sym = sym->next;
3005 } /* while */
3006 /* restore PRI, if it was saved */
3007 if (savepri)
3008 pop1();
3009}
3010
3011static constvalue *
3012insert_constval(constvalue * prev, constvalue * next, char *name,
3013 cell val, short index)
3014{
3015 constvalue *cur;
3016
3017 if (!(cur = (constvalue *)malloc(sizeof(constvalue))))
3018 error(103); /* insufficient memory (fatal error) */
3019 memset(cur, 0, sizeof(constvalue));
3020 strcpy(cur->name, name);
3021 cur->value = val;
3022 cur->index = index;
3023 cur->next = next;
3024 prev->next = cur;
3025 return cur;
3026}
3027
3028constvalue *
3029append_constval(constvalue * table, char *name, cell val, short index)
3030{
3031 constvalue *cur, *prev;
3032
3033 /* find the end of the constant table */
3034 for (prev = table, cur = table->next; cur;
3035 prev = cur, cur = cur->next)
3036 /* nothing */ ;
3037 return insert_constval(prev, NULL, name, val, index);
3038}
3039
3040constvalue *
3041find_constval(constvalue * table, char *name, short index)
3042{
3043 constvalue *ptr = table->next;
3044
3045 while (ptr)
3046 {
3047 if (strcmp(name, ptr->name) == 0 && ptr->index == index)
3048 return ptr;
3049 ptr = ptr->next;
3050 } /* while */
3051 return NULL;
3052}
3053
3054static constvalue *
3055find_constval_byval(constvalue * table, cell val)
3056{
3057 constvalue *ptr = table->next;
3058
3059 while (ptr)
3060 {
3061 if (ptr->value == val)
3062 return ptr;
3063 ptr = ptr->next;
3064 } /* while */
3065 return NULL;
3066}
3067
3068#if 0 /* never used */
3069static int
3070delete_constval(constvalue * table, char *name)
3071{
3072 constvalue *prev = table;
3073 constvalue *cur = prev->next;
3074
3075 while (cur != NULL)
3076 {
3077 if (strcmp(name, cur->name) == 0)
3078 {
3079 prev->next = cur->next;
3080 free(cur);
3081 return TRUE;
3082 } /* if */
3083 prev = cur;
3084 cur = cur->next;
3085 } /* while */
3086 return FALSE;
3087}
3088#endif
3089
3090void
3091delete_consttable(constvalue * table)
3092{
3093 constvalue *cur = table->next, *next;
3094
3095 while (cur)
3096 {
3097 next = cur->next;
3098 free(cur);
3099 cur = next;
3100 } /* while */
3101 memset(table, 0, sizeof(constvalue));
3102}
3103
3104/* add_constant
3105 *
3106 * Adds a symbol to the #define symbol table.
3107 */
3108void
3109add_constant(char *name, cell val, int vclass, int tag)
3110{
3111 symbol *sym;
3112
3113 /* Test whether a global or local symbol with the same name exists. Since
3114 * constants are stored in the symbols table, this also finds previously
3115 * defind constants. */
3116 sym = findglb(name);
3117 if (!sym)
3118 sym = findloc(name);
3119 if (sym)
3120 {
3121 /* silently ignore redefinitions of constants with the same value */
3122 if (sym->ident == iCONSTEXPR)
3123 {
3124 if (sym->addr != val)
3125 error(201, name); /* redefinition of constant (different value) */
3126 }
3127 else
3128 {
3129 error(21, name); /* symbol already defined */
3130 } /* if */
3131 return;
3132 } /* if */
3133
3134 /* constant doesn't exist yet, an entry must be created */
3135 sym = addsym(name, val, iCONSTEXPR, vclass, tag, uDEFINE);
3136 if (sc_status == statIDLE)
3137 sym->usage |= uPREDEF;
3138}
3139
3140/* statement - The Statement Parser
3141 *
3142 * This routine is called whenever the parser needs to know what
3143 * statement it encounters (i.e. whenever program syntax requires a
3144 * statement).
3145 */
3146static void
3147statement(int *lastindent, int allow_decl)
3148{
3149 int tok;
3150 cell val;
3151 char *st;
3152
3153 if (!freading)
3154 {
3155 error(36); /* empty statement */
3156 return;
3157 } /* if */
3158 errorset(sRESET);
3159
3160 tok = lex(&val, &st);
3161 if (tok != '{')
3162 setline(fline, fcurrent);
3163 /* lex() has set stmtindent */
3164 if (lastindent && tok != tLABEL)
3165 {
3166#if 0
3167 if (*lastindent >= 0 && *lastindent != stmtindent &&
3168 !indent_nowarn && sc_tabsize > 0)
3169 error(217); /* loose indentation */
3170#endif
3171 *lastindent = stmtindent;
3172 indent_nowarn = TRUE; /* if warning was blocked, re-enable it */
3173 } /* if */
3174 switch (tok)
3175 {
3176 case 0:
3177 /* nothing */
3178 break;
3179 case tNEW:
3180 if (allow_decl)
3181 {
3182 declloc(FALSE);
3183 lastst = tNEW;
3184 }
3185 else
3186 {
3187 error(3); /* declaration only valid in a block */
3188 } /* if */
3189 break;
3190 case tSTATIC:
3191 if (allow_decl)
3192 {
3193 declloc(TRUE);
3194 lastst = tNEW;
3195 }
3196 else
3197 {
3198 error(3); /* declaration only valid in a block */
3199 } /* if */
3200 break;
3201 case '{':
3202 if (!matchtoken('}')) /* {} is the empty statement */
3203 compound();
3204 /* lastst (for "last statement") does not change */
3205 break;
3206 case ';':
3207 error(36); /* empty statement */
3208 break;
3209 case tIF:
3210 doif();
3211 lastst = tIF;
3212 break;
3213 case tWHILE:
3214 dowhile();
3215 lastst = tWHILE;
3216 break;
3217 case tDO:
3218 dodo();
3219 lastst = tDO;
3220 break;
3221 case tFOR:
3222 dofor();
3223 lastst = tFOR;
3224 break;
3225 case tSWITCH:
3226 doswitch();
3227 lastst = tSWITCH;
3228 break;
3229 case tCASE:
3230 case tDEFAULT:
3231 error(14); /* not in switch */
3232 break;
3233 case tGOTO:
3234 dogoto();
3235 lastst = tGOTO;
3236 break;
3237 case tLABEL:
3238 dolabel();
3239 lastst = tLABEL;
3240 break;
3241 case tRETURN:
3242 doreturn();
3243 lastst = tRETURN;
3244 break;
3245 case tBREAK:
3246 dobreak();
3247 lastst = tBREAK;
3248 break;
3249 case tCONTINUE:
3250 docont();
3251 lastst = tCONTINUE;
3252 break;
3253 case tEXIT:
3254 doexit();
3255 lastst = tEXIT;
3256 break;
3257 case tASSERT:
3258 doassert();
3259 lastst = tASSERT;
3260 break;
3261 case tSLEEP:
3262 dosleep();
3263 lastst = tSLEEP;
3264 break;
3265 case tCONST:
3266 decl_const(sLOCAL);
3267 break;
3268 case tENUM:
3269 decl_enum(sLOCAL);
3270 break;
3271 default: /* non-empty expression */
3272 lexpush(); /* analyze token later */
3273 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE);
3274 needtoken(tTERM);
3275 lastst = tEXPR;
3276 } /* switch */
3277}
3278
3279static void
3280compound(void)
3281{
3282 int indent = -1;
3283 cell save_decl = declared;
3284 int count_stmt = 0;
3285
3286 nestlevel += 1; /* increase compound statement level */
3287 while (matchtoken('}') == 0)
3288 { /* repeat until compound statement is closed */
3289 if (!freading)
3290 {
3291 needtoken('}'); /* gives error: "expected token }" */
3292 break;
3293 }
3294 else
3295 {
3296 if (count_stmt > 0
3297 && (lastst == tRETURN || lastst == tBREAK
3298 || lastst == tCONTINUE))
3299 error(225); /* unreachable code */
3300 statement(&indent, TRUE); /* do a statement */
3301 count_stmt++;
3302 } /* if */
3303 } /* while */
3304 if (lastst != tRETURN)
3305 destructsymbols(&loctab, nestlevel);
3306 if (lastst != tRETURN && lastst != tGOTO)
3307 /* delete local variable space */
3308 modstk((int)(declared - save_decl) * sizeof(cell));
3309
3310 testsymbols(&loctab, nestlevel, FALSE, TRUE); /* look for unused
3311 * block locals */
3312 declared = save_decl;
3313 delete_symbols(&loctab, nestlevel, FALSE, TRUE);
3314 /* erase local symbols, but
3315 * retain block local labels
3316 * (within the function) */
3317
3318 nestlevel -= 1; /* decrease compound statement level */
3319}
3320
3321/* doexpr
3322 *
3323 * Global references: stgidx (referred to only)
3324 */
3325static void
3326doexpr(int comma, int chkeffect, int allowarray, int mark_endexpr,
3327 int *tag, int chkfuncresult)
3328{
3329 int constant, index, ident;
3330 int localstaging = FALSE;
3331 cell val;
3332
3333 if (!staging)
3334 {
3335 stgset(TRUE); /* start stage-buffering */
3336 localstaging = TRUE;
3337 assert(stgidx == 0);
3338 } /* if */
3339 index = stgidx;
3340 errorset(sEXPRMARK);
3341 do
3342 {
3343 /* on second round through, mark the end of the previous expression */
3344 if (index != stgidx)
3345 endexpr(TRUE);
3346 sideeffect = FALSE;
3347 ident = expression(&constant, &val, tag, chkfuncresult);
3348 if (!allowarray && (ident == iARRAY || ident == iREFARRAY))
3349 error(33, "-unknown-"); /* array must be indexed */
3350 if (chkeffect && !sideeffect)
3351 error(215); /* expression has no effect */
3352 }
3353 while (comma && matchtoken(',')); /* more? */
3354 if (mark_endexpr)
3355 endexpr(TRUE); /* optionally, mark the end of the expression */
3356 errorset(sEXPRRELEASE);
3357 if (localstaging)
3358 {
3359 stgout(index);
3360 stgset(FALSE); /* stop staging */
3361 } /* if */
3362}
3363
3364/* constexpr
3365 */
3366int
3367constexpr(cell * val, int *tag)
3368{
3369 int constant, index;
3370 cell cidx;
3371
3372 stgset(TRUE); /* start stage-buffering */
3373 stgget(&index, &cidx); /* mark position in code generator */
3374 errorset(sEXPRMARK);
3375 expression(&constant, val, tag, FALSE);
3376 stgdel(index, cidx); /* scratch generated code */
3377 stgset(FALSE); /* stop stage-buffering */
3378 if (constant == 0)
3379 error(8); /* must be constant expression */
3380 errorset(sEXPRRELEASE);
3381 return constant;
3382}
3383
3384/* test
3385 *
3386 * In the case a "simple assignment" operator ("=") is used within a
3387 * test, * the warning "possibly unintended assignment" is displayed.
3388 * This routine sets the global variable "intest" to true, it is
3389 * restored upon termination. In the case the assignment was intended,
3390 * use parantheses around the expression to avoid the warning;
3391 * primary() sets "intest" to 0.
3392 *
3393 * Global references: intest (altered, but restored upon termination)
3394 */
3395static void
3396test(int label, int parens, int invert)
3397{
3398 int index, tok;
3399 cell cidx;
3400 value lval = { NULL, 0, 0, 0, 0, NULL };
3401 int localstaging = FALSE;
3402
3403 if (!staging)
3404 {
3405 stgset(TRUE); /* start staging */
3406 localstaging = TRUE;
3407#if !defined NDEBUG
3408 stgget(&index, &cidx); /* should start at zero if started
3409 * locally */
3410 assert(index == 0);
3411#endif
3412 } /* if */
3413
3414 pushstk((stkitem) intest);
3415 intest = 1;
3416 if (parens)
3417 needtoken('(');
3418 do
3419 {
3420 stgget(&index, &cidx); /* mark position (of last expression) in
3421 * code generator */
3422 if (hier14(&lval))
3423 rvalue(&lval);
3424 tok = matchtoken(',');
3425 if (tok)
3426 endexpr(TRUE);
3427 }
3428 while (tok); /* do */
3429 if (parens)
3430 needtoken(')');
3431 if (lval.ident == iARRAY || lval.ident == iREFARRAY)
3432 {
3433 char *ptr =
3434 (lval.sym->name) ? lval.sym->name : "-unknown-";
3435 error(33, ptr); /* array must be indexed */
3436 } /* if */
3437 if (lval.ident == iCONSTEXPR)
3438 { /* constant expression */
3439 intest = (int)(long)popstk(); /* restore stack */
3440 stgdel(index, cidx);
3441 if (lval.constval)
3442 { /* code always executed */
3443 error(206); /* redundant test: always non-zero */
3444 }
3445 else
3446 {
3447 error(205); /* redundant code: never executed */
3448 jumplabel(label);
3449 } /* if */
3450 if (localstaging)
3451 {
3452 stgout(0); /* write "jumplabel" code */
3453 stgset(FALSE); /* stop staging */
3454 } /* if */
3455 return;
3456 } /* if */
3457 if (lval.tag != 0 && lval.tag != sc_addtag("bool"))
3458 if (check_userop(lneg, lval.tag, 0, 1, NULL, &lval.tag))
3459 invert = !invert; /* user-defined ! operator inverted result */
3460 if (invert)
3461 jmp_ne0(label); /* jump to label if true (different from 0) */
3462 else
3463 jmp_eq0(label); /* jump to label if false (equal to 0) */
3464 endexpr(TRUE); /* end expression (give optimizer a chance) */
3465 intest = (int)(long)popstk(); /* double typecast to avoid warning
3466 * with Microsoft C */
3467 if (localstaging)
3468 {
3469 stgout(0); /* output queue from the very beginning (see
3470 * assert() when localstaging is set to TRUE) */
3471 stgset(FALSE); /* stop staging */
3472 } /* if */
3473}
3474
3475static void
3476doif(void)
3477{
3478 int flab1, flab2;
3479 int ifindent;
3480
3481 ifindent = stmtindent; /* save the indent of the "if" instruction */
3482 flab1 = getlabel(); /* get label number for false branch */
3483 test(flab1, TRUE, FALSE); /*get expression, branch to flab1 if false */
3484 statement(NULL, FALSE); /* if true, do a statement */
3485 if (matchtoken(tELSE) == 0)
3486 { /* if...else ? */
3487 setlabel(flab1); /* no, simple if..., print false label */
3488 }
3489 else
3490 {
3491 /* to avoid the "dangling else" error, we want a warning if the "else"
3492 * has a lower indent than the matching "if" */
3493#if 0
3494 if (stmtindent < ifindent && sc_tabsize > 0)
3495 error(217); /* loose indentation */
3496#endif
3497 flab2 = getlabel();
3498 if ((lastst != tRETURN) && (lastst != tGOTO))
3499 jumplabel(flab2);
3500 setlabel(flab1); /* print false label */
3501 statement(NULL, FALSE); /* do "else" clause */
3502 setlabel(flab2); /* print true label */
3503 } /* endif */
3504}
3505
3506static void
3507dowhile(void)
3508{
3509 int wq[wqSIZE]; /* allocate local queue */
3510
3511 addwhile(wq); /* add entry to queue for "break" */
3512 setlabel(wq[wqLOOP]); /* loop label */
3513 /* The debugger uses the "line" opcode to be able to "break" out of
3514 * a loop. To make sure that each loop has a line opcode, even for the
3515 * tiniest loop, set it below the top of the loop */
3516 setline(fline, fcurrent);
3517 test(wq[wqEXIT], TRUE, FALSE); /* branch to wq[wqEXIT] if false */
3518 statement(NULL, FALSE); /* if so, do a statement */
3519 jumplabel(wq[wqLOOP]); /* and loop to "while" start */
3520 setlabel(wq[wqEXIT]); /* exit label */
3521 delwhile(); /* delete queue entry */
3522}
3523
3524/*
3525 * Note that "continue" will in this case not jump to the top of the
3526 * loop, but to the end: just before the TRUE-or-FALSE testing code.
3527 */
3528static void
3529dodo(void)
3530{
3531 int wq[wqSIZE], top;
3532
3533 addwhile(wq); /* see "dowhile" for more info */
3534 top = getlabel(); /* make a label first */
3535 setlabel(top); /* loop label */
3536 statement(NULL, FALSE);
3537 needtoken(tWHILE);
3538 setlabel(wq[wqLOOP]); /* "continue" always jumps to WQLOOP. */
3539 setline(fline, fcurrent);
3540 test(wq[wqEXIT], TRUE, FALSE);
3541 jumplabel(top);
3542 setlabel(wq[wqEXIT]);
3543 delwhile();
3544 needtoken(tTERM);
3545}
3546
3547static void
3548dofor(void)
3549{
3550 int wq[wqSIZE], skiplab;
3551 cell save_decl;
3552 int save_nestlevel, index;
3553 int *ptr;
3554
3555 save_decl = declared;
3556 save_nestlevel = nestlevel;
3557
3558 addwhile(wq);
3559 skiplab = getlabel();
3560 needtoken('(');
3561 if (matchtoken(';') == 0)
3562 {
3563 /* new variable declarations are allowed here */
3564 if (matchtoken(tNEW))
3565 {
3566 /* The variable in expr1 of the for loop is at a
3567 * 'compound statement' level of it own.
3568 */
3569 nestlevel++;
3570 declloc(FALSE); /* declare local variable */
3571 }
3572 else
3573 {
3574 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 1 */
3575 needtoken(';');
3576 } /* if */
3577 } /* if */
3578 /* Adjust the "declared" field in the "while queue", in case that
3579 * local variables were declared in the first expression of the
3580 * "for" loop. These are deleted in separately, so a "break" or a
3581 * "continue" must ignore these fields.
3582 */
3583 ptr = readwhile();
3584 assert(ptr != NULL);
3585 ptr[wqBRK] = (int)declared;
3586 ptr[wqCONT] = (int)declared;
3587 jumplabel(skiplab); /* skip expression 3 1st time */
3588 setlabel(wq[wqLOOP]); /* "continue" goes to this label: expr3 */
3589 setline(fline, fcurrent);
3590 /* Expressions 2 and 3 are reversed in the generated code:
3591 * expression 3 precedes expression 2.
3592 * When parsing, the code is buffered and marks for
3593 * the start of each expression are insterted in the buffer.
3594 */
3595 assert(!staging);
3596 stgset(TRUE); /* start staging */
3597 assert(stgidx == 0);
3598 index = stgidx;
3599 stgmark(sSTARTREORDER);
3600 stgmark((char)(sEXPRSTART + 0)); /* mark start of 2nd expression
3601 * in stage */
3602 setlabel(skiplab); /*jump to this point after 1st expression */
3603 if (matchtoken(';') == 0)
3604 {
3605 test(wq[wqEXIT], FALSE, FALSE); /* expression 2
3606 *(jump to wq[wqEXIT] if false) */
3607 needtoken(';');
3608 } /* if */
3609 stgmark((char)(sEXPRSTART + 1)); /* mark start of 3th expression
3610 * in stage */
3611 if (matchtoken(')') == 0)
3612 {
3613 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 3 */
3614 needtoken(')');
3615 } /* if */
3616 stgmark(sENDREORDER); /* mark end of reversed evaluation */
3617 stgout(index);
3618 stgset(FALSE); /* stop staging */
3619 statement(NULL, FALSE);
3620 jumplabel(wq[wqLOOP]);
3621 setlabel(wq[wqEXIT]);
3622 delwhile();
3623
3624 assert(nestlevel >= save_nestlevel);
3625 if (nestlevel > save_nestlevel)
3626 {
3627 /* Clean up the space and the symbol table for the local
3628 * variable in "expr1".
3629 */
3630 destructsymbols(&loctab, nestlevel);
3631 modstk((int)(declared - save_decl) * sizeof(cell));
3632 declared = save_decl;
3633 delete_symbols(&loctab, nestlevel, FALSE, TRUE);
3634 nestlevel = save_nestlevel; /* reset 'compound statement'
3635 * nesting level */
3636 } /* if */
3637}
3638
3639/* The switch statement is incompatible with its C sibling:
3640 * 1. the cases are not drop through
3641 * 2. only one instruction may appear below each case, use a compound
3642 * instruction to execute multiple instructions
3643 * 3. the "case" keyword accepts a comma separated list of values to
3644 * match, it also accepts a range using the syntax "1 .. 4"
3645 *
3646 * SWITCH param
3647 * PRI = expression result
3648 * param = table offset (code segment)
3649 *
3650 */
3651static void
3652doswitch(void)
3653{
3654 int lbl_table, lbl_exit, lbl_case;
3655 int tok, swdefault, casecount;
3656 cell val;
3657 char *str;
3658 constvalue caselist = { NULL, "", 0, 0 }; /*case list starts empty */
3659 constvalue *cse, *csp;
3660 char labelname[sNAMEMAX + 1];
3661
3662 needtoken('(');
3663 doexpr(TRUE, FALSE, FALSE, TRUE, NULL, FALSE); /* evaluate
3664 * switch expression */
3665 needtoken(')');
3666 /* generate the code for the switch statement, the label is the
3667 * address of the case table (to be generated later).
3668 */
3669 lbl_table = getlabel();
3670 lbl_case = 0; /* just to avoid a compiler warning */
3671 ffswitch(lbl_table);
3672
3673 needtoken('{');
3674 lbl_exit = getlabel(); /*get label number for jumping out of switch */
3675 swdefault = FALSE;
3676 casecount = 0;
3677 do
3678 {
3679 tok = lex(&val, &str); /* read in (new) token */
3680 switch (tok)
3681 {
3682 case tCASE:
3683 if (swdefault != FALSE)
3684 error(15); /* "default" case must be last in switch
3685 * statement */
3686 lbl_case = getlabel();
3687 sc_allowtags = FALSE; /* do not allow tagnames here */
3688 do
3689 {
3690 casecount++;
3691
3692 /* ??? enforce/document that, in a switch, a statement cannot
3693 * start an opening brace (marks the start of a compound
3694 * statement) and search for the right-most colon before that
3695 * statement.
3696 * Now, by replacing the ':' by a special COLON token, you can
3697 * parse all expressions until that special token.
3698 */
3699
3700 constexpr(&val, NULL);
3701 /* Search the insertion point (the table is kept in sorted
3702 * order, so that advanced abstract machines can sift the
3703 * case table with a binary search). Check for duplicate
3704 * case values at the same time.
3705 */
3706 for (csp = &caselist, cse = caselist.next;
3707 cse && cse->value < val;
3708 csp = cse, cse = cse->next)
3709 /* nothing */ ;
3710 if (cse && cse->value == val)
3711 error(40, val); /* duplicate "case" label */
3712 /* Since the label is stored as a string in the
3713 * "constvalue", the size of an identifier must
3714 * be at least 8, as there are 8
3715 * hexadecimal digits in a 32-bit number.
3716 */
3717#if sNAMEMAX < 8
3718#error Length of identifier (sNAMEMAX) too small.
3719#endif
3720 insert_constval(csp, cse, itoh(lbl_case), val, 0);
3721 if (matchtoken(tDBLDOT))
3722 {
3723 cell end;
3724
3725 constexpr(&end, NULL);
3726 if (end <= val)
3727 error(50); /* invalid range */
3728 while (++val <= end)
3729 {
3730 casecount++;
3731 /* find the new insertion point */
3732 for (csp = &caselist, cse = caselist.next;
3733 cse && cse->value < val;
3734 csp = cse, cse = cse->next)
3735 /* nothing */ ;
3736 if (cse && cse->value == val)
3737 error(40, val); /* duplicate "case" label */
3738 insert_constval(csp, cse, itoh(lbl_case), val, 0);
3739 } /* if */
3740 } /* if */
3741 }
3742 while (matchtoken(','));
3743 needtoken(':'); /* ':' ends the case */
3744 sc_allowtags = TRUE; /* reset */
3745 setlabel(lbl_case);
3746 statement(NULL, FALSE);
3747 jumplabel(lbl_exit);
3748 break;
3749 case tDEFAULT:
3750 if (swdefault != FALSE)
3751 error(16); /* multiple defaults in switch */
3752 lbl_case = getlabel();
3753 setlabel(lbl_case);
3754 needtoken(':');
3755 swdefault = TRUE;
3756 statement(NULL, FALSE);
3757 /* Jump to lbl_exit, even thouh this is the last clause in the
3758 *switch, because the jump table is generated between the last
3759 * clause of the switch and the exit label.
3760 */
3761 jumplabel(lbl_exit);
3762 break;
3763 case '}':
3764 /* nothing, but avoid dropping into "default" */
3765 break;
3766 default:
3767 error(2);
3768 indent_nowarn = TRUE; /* disable this check */
3769 tok = '}'; /* break out of the loop after an error */
3770 } /* switch */
3771 }
3772 while (tok != '}');
3773
3774#if !defined NDEBUG
3775 /* verify that the case table is sorted (unfortunately, duplicates can
3776 * occur; there really shouldn't be duplicate cases, but the compiler
3777 * may not crash or drop into an assertion for a user error). */
3778 for (cse = caselist.next; cse && cse->next; cse = cse->next)
3779 ; /* empty. no idea whether this is correct, but we MUST NOT do
3780 * the setlabel(lbl_table) call in the loop body. doing so breaks
3781 * switch statements that only have one case statement following.
3782 */
3783#endif
3784
3785 /* generate the table here, before lbl_exit (general jump target) */
3786 setlabel(lbl_table);
3787
3788 if (swdefault == FALSE)
3789 {
3790 /* store lbl_exit as the "none-matched" label in the switch table */
3791 strcpy(labelname, itoh(lbl_exit));
3792 }
3793 else
3794 {
3795 /* lbl_case holds the label of the "default" clause */
3796 strcpy(labelname, itoh(lbl_case));
3797 } /* if */
3798 ffcase(casecount, labelname, TRUE);
3799 /* generate the rest of the table */
3800 for (cse = caselist.next; cse; cse = cse->next)
3801 ffcase(cse->value, cse->name, FALSE);
3802
3803 setlabel(lbl_exit);
3804 delete_consttable(&caselist); /* clear list of case labels */
3805}
3806
3807static void
3808doassert(void)
3809{
3810 int flab1, index;
3811 cell cidx;
3812 value lval = { NULL, 0, 0, 0, 0, NULL };
3813
3814 if ((sc_debug & sCHKBOUNDS) != 0)
3815 {
3816 flab1 = getlabel(); /* get label number for "OK" branch */
3817 test(flab1, FALSE, TRUE); /* get expression and branch
3818 * to flab1 if true */
3819 setline(fline, fcurrent); /* make sure we abort on the correct
3820 * line number */
3821 ffabort(xASSERTION);
3822 setlabel(flab1);
3823 }
3824 else
3825 {
3826 stgset(TRUE); /* start staging */
3827 stgget(&index, &cidx); /* mark position in code generator */
3828 do
3829 {
3830 if (hier14(&lval))
3831 rvalue(&lval);
3832 stgdel(index, cidx); /* just scrap the code */
3833 }
3834 while (matchtoken(','));
3835 stgset(FALSE); /* stop staging */
3836 } /* if */
3837 needtoken(tTERM);
3838}
3839
3840static void
3841dogoto(void)
3842{
3843 char *st;
3844 cell val;
3845 symbol *sym;
3846
3847 if (lex(&val, &st) == tSYMBOL)
3848 {
3849 sym = fetchlab(st);
3850 jumplabel((int)sym->addr);
3851 sym->usage |= uREAD; /* set "uREAD" bit */
3852 /*
3853 * // ??? if the label is defined (check sym->usage & uDEFINE), check
3854 * // sym->compound (nesting level of the label) against nestlevel;
3855 * // if sym->compound < nestlevel, call the destructor operator
3856 */
3857 }
3858 else
3859 {
3860 error(20, st); /* illegal symbol name */
3861 } /* if */
3862 needtoken(tTERM);
3863}
3864
3865static void
3866dolabel(void)
3867{
3868 char *st;
3869 cell val;
3870 symbol *sym;
3871
3872 tokeninfo(&val, &st); /* retrieve label name again */
3873 if (find_constval(&tagname_tab, st, 0))
3874 error(221, st); /* label name shadows tagname */
3875 sym = fetchlab(st);
3876 setlabel((int)sym->addr);
3877 /* since one can jump around variable declarations or out of compound
3878 * blocks, the stack must be manually adjusted
3879 */
3880 setstk(-declared * sizeof(cell));
3881 sym->usage |= uDEFINE; /* label is now defined */
3882}
3883
3884/* fetchlab
3885 *
3886 * Finds a label from the (local) symbol table or adds one to it.
3887 * Labels are local in scope.
3888 *
3889 * Note: The "_usage" bit is set to zero. The routines that call
3890 * "fetchlab()" must set this bit accordingly.
3891 */
3892static symbol *
3893fetchlab(char *name)
3894{
3895 symbol *sym;
3896
3897 sym = findloc(name); /* labels are local in scope */
3898 if (sym)
3899 {
3900 if (sym->ident != iLABEL)
3901 error(19, sym->name); /* not a label: ... */
3902 }
3903 else
3904 {
3905 sym = addsym(name, getlabel(), iLABEL, sLOCAL, 0, 0);
3906 sym->x.declared = (int)declared;
3907 sym->compound = nestlevel;
3908 } /* if */
3909 return sym;
3910}
3911
3912/* doreturn
3913 *
3914 * Global references: rettype (altered)
3915 */
3916static void
3917doreturn(void)
3918{
3919 int tag;
3920
3921 if (matchtoken(tTERM) == 0)
3922 {
3923 if ((rettype & uRETNONE) != 0)
3924 error(208); /* mix "return;" and "return value;" */
3925 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
3926 needtoken(tTERM);
3927 rettype |= uRETVALUE; /* function returns a value */
3928 /* check tagname with function tagname */
3929 assert(curfunc != NULL);
3930 if (!matchtag(curfunc->tag, tag, TRUE))
3931 error(213); /* tagname mismatch */
3932 }
3933 else
3934 {
3935 /* this return statement contains no expression */
3936 const1(0);
3937 if ((rettype & uRETVALUE) != 0)
3938 {
3939 char symname[2 * sNAMEMAX + 16]; /* allow space for user
3940 * defined operators */
3941 assert(curfunc != NULL);
3942 funcdisplayname(symname, curfunc->name);
3943 error(209, symname); /* function should return a value */
3944 } /* if */
3945 rettype |= uRETNONE; /* function does not return anything */
3946 } /* if */
3947 destructsymbols(&loctab, 0); /*call destructor for *all* locals */
3948 modstk((int)declared * sizeof(cell)); /* end of function, remove
3949 *all* * local variables*/
3950 ffret();
3951}
3952
3953static void
3954dobreak(void)
3955{
3956 int *ptr;
3957
3958 ptr = readwhile(); /* readwhile() gives an error if not in loop */
3959 needtoken(tTERM);
3960 if (!ptr)
3961 return;
3962 destructsymbols(&loctab, nestlevel);
3963 modstk(((int)declared - ptr[wqBRK]) * sizeof(cell));
3964 jumplabel(ptr[wqEXIT]);
3965}
3966
3967static void
3968docont(void)
3969{
3970 int *ptr;
3971
3972 ptr = readwhile(); /* readwhile() gives an error if not in loop */
3973 needtoken(tTERM);
3974 if (!ptr)
3975 return;
3976 destructsymbols(&loctab, nestlevel);
3977 modstk(((int)declared - ptr[wqCONT]) * sizeof(cell));
3978 jumplabel(ptr[wqLOOP]);
3979}
3980
3981void
3982exporttag(int tag)
3983{
3984 /* find the tag by value in the table, then set the top bit to mark it
3985 * "public"
3986 */
3987 if (tag != 0)
3988 {
3989 constvalue *ptr;
3990
3991 assert((tag & PUBLICTAG) == 0);
3992 for (ptr = tagname_tab.next;
3993 ptr && tag != (int)(ptr->value & TAGMASK); ptr = ptr->next)
3994 /* nothing */ ;
3995 if (ptr)
3996 ptr->value |= PUBLICTAG;
3997 } /* if */
3998}
3999
4000static void
4001doexit(void)
4002{
4003 int tag = 0;
4004
4005 if (matchtoken(tTERM) == 0)
4006 {
4007 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
4008 needtoken(tTERM);
4009 }
4010 else
4011 {
4012 const1(0);
4013 } /* if */
4014 const2(tag);
4015 exporttag(tag);
4016 destructsymbols(&loctab, 0); /* call destructor for *all* locals */
4017 ffabort(xEXIT);
4018}
4019
4020static void
4021dosleep(void)
4022{
4023 int tag = 0;
4024
4025 if (matchtoken(tTERM) == 0)
4026 {
4027 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
4028 needtoken(tTERM);
4029 }
4030 else
4031 {
4032 const1(0);
4033 } /* if */
4034 const2(tag);
4035 exporttag(tag);
4036 ffabort(xSLEEP);
4037}
4038
4039static void
4040addwhile(int *ptr)
4041{
4042 int k;
4043
4044 ptr[wqBRK] = (int)declared; /* stack pointer (for "break") */
4045 ptr[wqCONT] = (int)declared; /* for "continue", possibly adjusted later */
4046 ptr[wqLOOP] = getlabel();
4047 ptr[wqEXIT] = getlabel();
4048 if (wqptr >= (wq + wqTABSZ - wqSIZE))
4049 error(102, "loop table"); /* loop table overflow (too many active loops) */
4050 k = 0;
4051 while (k < wqSIZE)
4052 { /* copy "ptr" to while queue table */
4053 *wqptr = *ptr;
4054 wqptr += 1;
4055 ptr += 1;
4056 k += 1;
4057 } /* while */
4058}
4059
4060static void
4061delwhile(void)
4062{
4063 if (wqptr > wq)
4064 wqptr -= wqSIZE;
4065}
4066
4067static int *
4068readwhile(void)
4069{
4070 if (wqptr <= wq)
4071 {
4072 error(24); /* out of context */
4073 return NULL;
4074 }
4075 else
4076 {
4077 return (wqptr - wqSIZE);
4078 } /* if */
4079}
diff --git a/libraries/embryo/src/bin/embryo_cc_sc2.c b/libraries/embryo/src/bin/embryo_cc_sc2.c
new file mode 100644
index 0000000..b3f4fae
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc2.c
@@ -0,0 +1,2779 @@
1/* Small compiler - File input, preprocessing and lexical analysis functions
2 *
3 * Copyright (c) ITB CompuPhase, 1997-2003
4 *
5 * This software is provided "as-is", without any express or implied warranty.
6 * In no event will the authors be held liable for any damages arising from
7 * the use of this software.
8 *
9 * Permission is granted to anyone to use this software for any purpose,
10 * including commercial applications, and to alter it and redistribute it
11 * freely, subject to the following restrictions:
12 *
13 * 1. The origin of this software must not be misrepresented; you must not
14 * claim that you wrote the original software. If you use this software in
15 * a product, an acknowledgment in the product documentation would be
16 * appreciated but is not required.
17 * 2. Altered source versions must be plainly marked as such, and must not be
18 * misrepresented as being the original software.
19 * 3. This notice may not be removed or altered from any source distribution.
20 *
21 * Version: $Id: embryo_cc_sc2.c 62382 2011-08-12 12:39:29Z billiob $
22 */
23
24
25#ifdef HAVE_CONFIG_H
26# include <config.h>
27#endif
28
29#include <assert.h>
30#include <stdio.h>
31#include <stdlib.h>
32#include <string.h>
33#include <ctype.h>
34#include <math.h>
35#include "embryo_cc_sc.h"
36#include "Embryo.h"
37
38static int match(char *st, int end);
39static cell litchar(char **lptr, int rawmode);
40static int alpha(char c);
41
42static int icomment; /* currently in multiline comment? */
43static int iflevel; /* nesting level if #if/#else/#endif */
44static int skiplevel; /* level at which we started skipping */
45static int elsedone; /* level at which we have seen an #else */
46static char term_expr[] = "";
47static int listline = -1; /* "current line" for the list file */
48
49/* pushstk & popstk
50 *
51 * Uses a LIFO stack to store information. The stack is used by doinclude(),
52 * doswitch() (to hold the state of "swactive") and some other routines.
53 *
54 * Porting note: I made the bold assumption that an integer will not be
55 * larger than a pointer (it may be smaller). That is, the stack element
56 * is typedef'ed as a pointer type, but I also store integers on it. See
57 * SC.H for "stkitem"
58 *
59 * Global references: stack,stkidx (private to pushstk() and popstk())
60 */
61static stkitem stack[sSTKMAX];
62static int stkidx;
63void
64pushstk(stkitem val)
65{
66 if (stkidx >= sSTKMAX)
67 error(102, "parser stack"); /* stack overflow (recursive include?) */
68 stack[stkidx] = val;
69 stkidx += 1;
70}
71
72stkitem
73popstk(void)
74{
75 if (stkidx == 0)
76 return (stkitem) - 1; /* stack is empty */
77 stkidx -= 1;
78 return stack[stkidx];
79}
80
81int
82plungequalifiedfile(char *name)
83{
84 static char *extensions[] = { ".inc", ".sma", ".small" };
85 FILE *fp;
86 char *ext;
87 int ext_idx;
88
89 ext_idx = 0;
90 do
91 {
92 fp = (FILE *) sc_opensrc(name);
93 ext = strchr(name, '\0'); /* save position */
94 if (!fp)
95 {
96 /* try to append an extension */
97 strcpy(ext, extensions[ext_idx]);
98 fp = (FILE *) sc_opensrc(name);
99 if (!fp)
100 *ext = '\0'; /* on failure, restore filename */
101 } /* if */
102 ext_idx++;
103 }
104 while ((!fp) &&
105 (ext_idx < (int)(sizeof extensions / sizeof extensions[0])));
106 if (!fp)
107 {
108 *ext = '\0'; /* restore filename */
109 return FALSE;
110 } /* if */
111 pushstk((stkitem) inpf);
112 pushstk((stkitem) inpfname); /* pointer to current file name */
113 pushstk((stkitem) curlibrary);
114 pushstk((stkitem) iflevel);
115 assert(skiplevel == 0);
116 pushstk((stkitem) icomment);
117 pushstk((stkitem) fcurrent);
118 pushstk((stkitem) fline);
119 inpfname = strdup(name); /* set name of include file */
120 if (!inpfname)
121 error(103); /* insufficient memory */
122 inpf = fp; /* set input file pointer to include file */
123 fnumber++;
124 fline = 0; /* set current line number to 0 */
125 fcurrent = fnumber;
126 icomment = FALSE;
127 setfile(inpfname, fcurrent);
128 listline = -1; /* force a #line directive when changing the file */
129 setactivefile(fcurrent);
130 return TRUE;
131}
132
133int
134plungefile(char *name, int try_currentpath, int try_includepaths)
135{
136 int result = FALSE;
137 int i;
138 char *ptr;
139
140 if (try_currentpath)
141 result = plungequalifiedfile(name);
142
143 if (try_includepaths && name[0] != DIRSEP_CHAR)
144 {
145 for (i = 0; !result && (ptr = get_path(i)); i++)
146 {
147 char path[PATH_MAX];
148
149 strncpy(path, ptr, sizeof path);
150 path[sizeof path - 1] = '\0'; /* force '\0' termination */
151 strncat(path, name, sizeof(path) - strlen(path));
152 path[sizeof path - 1] = '\0';
153 result = plungequalifiedfile(path);
154 } /* while */
155 } /* if */
156 return result;
157}
158
159static void
160check_empty(char *lptr)
161{
162 /* verifies that the string contains only whitespace */
163 while (*lptr <= ' ' && *lptr != '\0')
164 lptr++;
165 if (*lptr != '\0')
166 error(38); /* extra characters on line */
167}
168
169/* doinclude
170 *
171 * Gets the name of an include file, pushes the old file on the stack and
172 * sets some options. This routine doesn't use lex(), since lex() doesn't
173 * recognize file names (and directories).
174 *
175 * Global references: inpf (altered)
176 * inpfname (altered)
177 * fline (altered)
178 * lptr (altered)
179 */
180static void
181doinclude(void)
182{
183 char name[PATH_MAX], c;
184 int i, result;
185
186 while (*lptr <= ' ' && *lptr != 0) /* skip leading whitespace */
187 lptr++;
188 if (*lptr == '<' || *lptr == '\"')
189 {
190 c = (char)((*lptr == '\"') ? '\"' : '>'); /* termination character */
191 lptr++;
192 while (*lptr <= ' ' && *lptr != 0) /* skip whitespace after quote */
193 lptr++;
194 }
195 else
196 {
197 c = '\0';
198 } /* if */
199
200 i = 0;
201 while ((*lptr != c) && (*lptr != '\0') && (i < (int)(sizeof(name) - 1))) /* find the end of the string */
202 name[i++] = *lptr++;
203 while (i > 0 && name[i - 1] <= ' ')
204 i--; /* strip trailing whitespace */
205 assert((i >= 0) && (i < (int)(sizeof(name))));
206 name[i] = '\0'; /* zero-terminate the string */
207
208 if (*lptr != c)
209 { /* verify correct string termination */
210 error(37); /* invalid string */
211 return;
212 } /* if */
213 if (c != '\0')
214 check_empty(lptr + 1); /* verify that the rest of the line is whitespace */
215
216 /* Include files between "..." or without quotes are read from the current
217 * directory, or from a list of "include directories". Include files
218 * between <...> are only read from the list of include directories.
219 */
220 result = plungefile(name, (c != '>'), TRUE);
221 if (!result)
222 error(100, name); /* cannot read from ... (fatal error) */
223}
224
225/* readline
226 *
227 * Reads in a new line from the input file pointed to by "inpf". readline()
228 * concatenates lines that end with a \ with the next line. If no more data
229 * can be read from the file, readline() attempts to pop off the previous file
230 * from the stack. If that fails too, it sets "freading" to 0.
231 *
232 * Global references: inpf,fline,inpfname,freading,icomment (altered)
233 */
234static void
235readline(char *line)
236{
237 int i, num, cont;
238 char *ptr;
239
240 if (lptr == term_expr)
241 return;
242 num = sLINEMAX;
243 cont = FALSE;
244 do
245 {
246 if (!inpf || sc_eofsrc(inpf))
247 {
248 if (cont)
249 error(49); /* invalid line continuation */
250 if (inpf && inpf != inpf_org)
251 sc_closesrc(inpf);
252 i = (int)(long)popstk();
253 if (i == -1)
254 { /* All's done; popstk() returns "stack is empty" */
255 freading = FALSE;
256 *line = '\0';
257 /* when there is nothing more to read, the #if/#else stack should
258 * be empty and we should not be in a comment
259 */
260 assert(iflevel >= 0);
261 if (iflevel > 0)
262 error(1, "#endif", "-end of file-");
263 else if (icomment)
264 error(1, "*/", "-end of file-");
265 return;
266 } /* if */
267 fline = i;
268 fcurrent = (int)(long)popstk();
269 icomment = (int)(long)popstk();
270 assert(skiplevel == 0); /* skiplevel was not stored on stack, because it should always be zero at this point */
271 iflevel = (int)(long)popstk();
272 curlibrary = (constvalue *) popstk();
273 free(inpfname); /* return memory allocated for the include file name */
274 inpfname = (char *)popstk();
275 inpf = (FILE *) popstk();
276 setactivefile(fcurrent);
277 listline = -1; /* force a #line directive when changing the file */
278 elsedone = 0;
279 } /* if */
280
281 if (!sc_readsrc(inpf, line, num))
282 {
283 *line = '\0'; /* delete line */
284 cont = FALSE;
285 }
286 else
287 {
288 /* check whether to erase leading spaces */
289 if (cont)
290 {
291 char *ptr = line;
292
293 while (*ptr == ' ' || *ptr == '\t')
294 ptr++;
295 if (ptr != line)
296 memmove(line, ptr, strlen(ptr) + 1);
297 } /* if */
298 cont = FALSE;
299 /* check whether a full line was read */
300 if (!strchr(line, '\n') && !sc_eofsrc(inpf))
301 error(75); /* line too long */
302 /* check if the next line must be concatenated to this line */
303 if ((ptr = strchr(line, '\n')) && ptr > line)
304 {
305 assert(*(ptr + 1) == '\0'); /* '\n' should be last in the string */
306 while (ptr > line
307 && (*ptr == '\n' || *ptr == ' ' || *ptr == '\t'))
308 ptr--; /* skip trailing whitespace */
309 if (*ptr == '\\')
310 {
311 cont = TRUE;
312 /* set '\a' at the position of '\\' to make it possible to check
313 * for a line continuation in a single line comment (error 49)
314 */
315 *ptr++ = '\a';
316 *ptr = '\0'; /* erase '\n' (and any trailing whitespace) */
317 } /* if */
318 } /* if */
319 num -= strlen(line);
320 line += strlen(line);
321 } /* if */
322 fline += 1;
323 }
324 while (num >= 0 && cont);
325}
326
327/* stripcom
328 *
329 * Replaces all comments from the line by space characters. It updates
330 * a global variable ("icomment") for multiline comments.
331 *
332 * This routine also supports the C++ extension for single line comments.
333 * These comments are started with "//" and end at the end of the line.
334 *
335 * Global references: icomment (private to "stripcom")
336 */
337static void
338stripcom(char *line)
339{
340 char c;
341
342 while (*line)
343 {
344 if (icomment)
345 {
346 if (*line == '*' && *(line + 1) == '/')
347 {
348 icomment = FALSE; /* comment has ended */
349 *line = ' '; /* replace '*' and '/' characters by spaces */
350 *(line + 1) = ' ';
351 line += 2;
352 }
353 else
354 {
355 if (*line == '/' && *(line + 1) == '*')
356 error(216); /* nested comment */
357 *line = ' '; /* replace comments by spaces */
358 line += 1;
359 } /* if */
360 }
361 else
362 {
363 if (*line == '/' && *(line + 1) == '*')
364 {
365 icomment = TRUE; /* start comment */
366 *line = ' '; /* replace '/' and '*' characters by spaces */
367 *(line + 1) = ' ';
368 line += 2;
369 }
370 else if (*line == '/' && *(line + 1) == '/')
371 { /* comment to end of line */
372 if (strchr(line, '\a'))
373 error(49); /* invalid line continuation */
374 *line++ = '\n'; /* put "newline" at first slash */
375 *line = '\0'; /* put "zero-terminator" at second slash */
376 }
377 else
378 {
379 if (*line == '\"' || *line == '\'')
380 { /* leave literals unaltered */
381 c = *line; /* ending quote, single or double */
382 line += 1;
383 while ((*line != c || *(line - 1) == '\\')
384 && *line != '\0')
385 line += 1;
386 line += 1; /* skip final quote */
387 }
388 else
389 {
390 line += 1;
391 } /* if */
392 } /* if */
393 } /* if */
394 } /* while */
395}
396
397/* btoi
398 *
399 * Attempts to interpret a numeric symbol as a boolean value. On success
400 * it returns the number of characters processed (so the line pointer can be
401 * adjusted) and the value is stored in "val". Otherwise it returns 0 and
402 * "val" is garbage.
403 *
404 * A boolean value must start with "0b"
405 */
406static int
407btoi(cell * val, char *curptr)
408{
409 char *ptr;
410
411 *val = 0;
412 ptr = curptr;
413 if (*ptr == '0' && *(ptr + 1) == 'b')
414 {
415 ptr += 2;
416 while (*ptr == '0' || *ptr == '1' || *ptr == '_')
417 {
418 if (*ptr != '_')
419 *val = (*val << 1) | (*ptr - '0');
420 ptr++;
421 } /* while */
422 }
423 else
424 {
425 return 0;
426 } /* if */
427 if (alphanum(*ptr)) /* number must be delimited by non-alphanumeric char */
428 return 0;
429 else
430 return (int)(ptr - curptr);
431}
432
433/* dtoi
434 *
435 * Attempts to interpret a numeric symbol as a decimal value. On success
436 * it returns the number of characters processed and the value is stored in
437 * "val". Otherwise it returns 0 and "val" is garbage.
438 */
439static int
440dtoi(cell * val, char *curptr)
441{
442 char *ptr;
443
444 *val = 0;
445 ptr = curptr;
446 if (!isdigit(*ptr)) /* should start with digit */
447 return 0;
448 while (isdigit(*ptr) || *ptr == '_')
449 {
450 if (*ptr != '_')
451 *val = (*val * 10) + (*ptr - '0');
452 ptr++;
453 } /* while */
454 if (alphanum(*ptr)) /* number must be delimited by non-alphanumerical */
455 return 0;
456 if (*ptr == '.' && isdigit(*(ptr + 1)))
457 return 0; /* but a fractional part must not be present */
458 return (int)(ptr - curptr);
459}
460
461/* htoi
462 *
463 * Attempts to interpret a numeric symbol as a hexadecimal value. On
464 * success it returns the number of characters processed and the value is
465 * stored in "val". Otherwise it return 0 and "val" is garbage.
466 */
467static int
468htoi(cell * val, char *curptr)
469{
470 char *ptr;
471
472 *val = 0;
473 ptr = curptr;
474 if (!isdigit(*ptr)) /* should start with digit */
475 return 0;
476 if (*ptr == '0' && *(ptr + 1) == 'x')
477 { /* C style hexadecimal notation */
478 ptr += 2;
479 while (isxdigit(*ptr) || *ptr == '_')
480 {
481 if (*ptr != '_')
482 {
483 assert(isxdigit(*ptr));
484 *val = *val << 4;
485 if (isdigit(*ptr))
486 *val += (*ptr - '0');
487 else
488 *val += (tolower(*ptr) - 'a' + 10);
489 } /* if */
490 ptr++;
491 } /* while */
492 }
493 else
494 {
495 return 0;
496 } /* if */
497 if (alphanum(*ptr))
498 return 0;
499 else
500 return (int)(ptr - curptr);
501}
502
503#if defined LINUX
504static double
505pow10(int value)
506{
507 double res = 1.0;
508
509 while (value >= 4)
510 {
511 res *= 10000.0;
512 value -= 5;
513 } /* while */
514 while (value >= 2)
515 {
516 res *= 100.0;
517 value -= 2;
518 } /* while */
519 while (value >= 1)
520 {
521 res *= 10.0;
522 value -= 1;
523 } /* while */
524 return res;
525}
526#endif
527
528/* ftoi
529 *
530 * Attempts to interpret a numeric symbol as a rational number, either as
531 * IEEE 754 single precision floating point or as a fixed point integer.
532 * On success it returns the number of characters processed and the value is
533 * stored in "val". Otherwise it returns 0 and "val" is unchanged.
534 *
535 * Small has stricter definition for floating point numbers than most:
536 * o the value must start with a digit; ".5" is not a valid number, you
537 * should write "0.5"
538 * o a period must appear in the value, even if an exponent is given; "2e3"
539 * is not a valid number, you should write "2.0e3"
540 * o at least one digit must follow the period; "6." is not a valid number,
541 * you should write "6.0"
542 */
543static int
544ftoi(cell * val, char *curptr)
545{
546 char *ptr;
547 double fnum, ffrac, fmult;
548 unsigned long dnum, dbase;
549 int i, ignore;
550
551 assert(rational_digits >= 0 && rational_digits < 9);
552 for (i = 0, dbase = 1; i < rational_digits; i++)
553 dbase *= 10;
554 fnum = 0.0;
555 dnum = 0L;
556 ptr = curptr;
557 if (!isdigit(*ptr)) /* should start with digit */
558 return 0;
559 while (isdigit(*ptr) || *ptr == '_')
560 {
561 if (*ptr != '_')
562 {
563 fnum = (fnum * 10.0) + (*ptr - '0');
564 dnum = (dnum * 10L) + (*ptr - '0') * dbase;
565 } /* if */
566 ptr++;
567 } /* while */
568 if (*ptr != '.')
569 return 0; /* there must be a period */
570 ptr++;
571 if (!isdigit(*ptr)) /* there must be at least one digit after the dot */
572 return 0;
573 ffrac = 0.0;
574 fmult = 1.0;
575 ignore = FALSE;
576 while (isdigit(*ptr) || *ptr == '_')
577 {
578 if (*ptr != '_')
579 {
580 ffrac = (ffrac * 10.0) + (*ptr - '0');
581 fmult = fmult / 10.0;
582 dbase /= 10L;
583 dnum += (*ptr - '0') * dbase;
584 if (dbase == 0L && sc_rationaltag && rational_digits > 0
585 && !ignore)
586 {
587 error(222); /* number of digits exceeds rational number precision */
588 ignore = TRUE;
589 } /* if */
590 } /* if */
591 ptr++;
592 } /* while */
593 fnum += ffrac * fmult; /* form the number so far */
594 if (*ptr == 'e')
595 { /* optional fractional part */
596 int exp, sign;
597
598 ptr++;
599 if (*ptr == '-')
600 {
601 sign = -1;
602 ptr++;
603 }
604 else
605 {
606 sign = 1;
607 } /* if */
608 if (!isdigit(*ptr)) /* 'e' should be followed by a digit */
609 return 0;
610 exp = 0;
611 while (isdigit(*ptr))
612 {
613 exp = (exp * 10) + (*ptr - '0');
614 ptr++;
615 } /* while */
616#if defined LINUX
617 fmult = pow10(exp * sign);
618#else
619 fmult = pow(10, exp * sign);
620#endif
621 fnum *= fmult;
622 dnum *= (unsigned long)(fmult + 0.5);
623 } /* if */
624
625 /* decide how to store the number */
626 if (sc_rationaltag == 0)
627 {
628 error(70); /* rational number support was not enabled */
629 *val = 0;
630 }
631 else if (rational_digits == 0)
632 {
633 float f = (float) fnum;
634 /* floating point */
635 *val = EMBRYO_FLOAT_TO_CELL(f);
636#if !defined NDEBUG
637 /* I assume that the C/C++ compiler stores "float" values in IEEE 754
638 * format (as mandated in the ANSI standard). Test this assumption anyway.
639 */
640 {
641 float test1 = 0.0, test2 = 50.0;
642 Embryo_Cell c1 = EMBRYO_FLOAT_TO_CELL(test1);
643 Embryo_Cell c2 = EMBRYO_FLOAT_TO_CELL(test2);
644
645 if (c1 != 0x00000000L)
646 {
647 fprintf(stderr,
648 "embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
649 "point math as embryo expects. this could be bad.\n"
650 "\n"
651 "(float 0.0 != 0x00000000 bitpattern, 0x%08x instead)\n"
652 "\n"
653 "this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
654 "to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
655 , c1);
656 }
657 else if (c2 != 0x42480000L)
658 {
659 fprintf(stderr,
660 "embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
661 "point math as embryo expects. This could be bad.\n"
662 "\n"
663 "(float 50.0 != 0x42480000 bitpattern, 0x%08x instead)\n"
664 "\n"
665 "this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
666 "to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
667 , c2);
668 }
669 }
670#endif
671 }
672 else
673 {
674 /* fixed point */
675 *val = (cell) dnum;
676 } /* if */
677
678 return (int)(ptr - curptr);
679}
680
681/* number
682 *
683 * Reads in a number (binary, decimal or hexadecimal). It returns the number
684 * of characters processed or 0 if the symbol couldn't be interpreted as a
685 * number (in this case the argument "val" remains unchanged). This routine
686 * relies on the 'early dropout' implementation of the logical or (||)
687 * operator.
688 *
689 * Note: the routine doesn't check for a sign (+ or -). The - is checked
690 * for at "hier2()" (in fact, it is viewed as an operator, not as a
691 * sign) and the + is invalid (as in K&R C, and unlike ANSI C).
692 */
693static int
694number(cell * val, char *curptr)
695{
696 int i;
697 cell value;
698
699 if ((i = btoi(&value, curptr)) != 0 /* binary? */
700 || (i = htoi(&value, curptr)) != 0 /* hexadecimal? */
701 || (i = dtoi(&value, curptr)) != 0) /* decimal? */
702 {
703 *val = value;
704 return i;
705 }
706 else
707 {
708 return 0; /* else not a number */
709 } /* if */
710}
711
712static void
713chrcat(char *str, char chr)
714{
715 str = strchr(str, '\0');
716 *str++ = chr;
717 *str = '\0';
718}
719
720static int
721preproc_expr(cell * val, int *tag)
722{
723 int result;
724 int index;
725 cell code_index;
726 char *term;
727
728 /* Disable staging; it should be disabled already because
729 * expressions may not be cut off half-way between conditional
730 * compilations. Reset the staging index, but keep the code
731 * index.
732 */
733 if (stgget(&index, &code_index))
734 {
735 error(57); /* unfinished expression */
736 stgdel(0, code_index);
737 stgset(FALSE);
738 } /* if */
739 /* append a special symbol to the string, so the expression
740 * analyzer won't try to read a next line when it encounters
741 * an end-of-line
742 */
743 assert(strlen(pline) < sLINEMAX);
744 term = strchr(pline, '\0');
745 assert(term != NULL);
746 chrcat(pline, PREPROC_TERM); /* the "DEL" code (see SC.H) */
747 result = constexpr(val, tag); /* get value (or 0 on error) */
748 *term = '\0'; /* erase the token (if still present) */
749 lexclr(FALSE); /* clear any "pushed" tokens */
750 return result;
751}
752
753/* getstring
754 * Returns returns a pointer behind the closing quote or to the other
755 * character that caused the input to be ended.
756 */
757static char *
758getstring(char *dest, int max)
759{
760 assert(dest != NULL);
761 *dest = '\0';
762 while (*lptr <= ' ' && *lptr != '\0')
763 lptr++; /* skip whitespace */
764 if (*lptr != '"')
765 {
766 error(37); /* invalid string */
767 }
768 else
769 {
770 int len = 0;
771
772 lptr++; /* skip " */
773 while (*lptr != '"' && *lptr != '\0')
774 {
775 if (len < max - 1)
776 dest[len++] = *lptr;
777 lptr++;
778 } /* if */
779 dest[len] = '\0';
780 if (*lptr == '"')
781 lptr++; /* skip closing " */
782 else
783 error(37); /* invalid string */
784 } /* if */
785 return lptr;
786}
787
788enum
789{
790 CMD_NONE,
791 CMD_TERM,
792 CMD_EMPTYLINE,
793 CMD_CONDFALSE,
794 CMD_INCLUDE,
795 CMD_DEFINE,
796 CMD_IF,
797 CMD_DIRECTIVE,
798};
799
800/* command
801 *
802 * Recognizes the compiler directives. The function returns:
803 * CMD_NONE the line must be processed
804 * CMD_TERM a pending expression must be completed before processing further lines
805 * Other value: the line must be skipped, because:
806 * CMD_CONDFALSE false "#if.." code
807 * CMD_EMPTYLINE line is empty
808 * CMD_INCLUDE the line contains a #include directive
809 * CMD_DEFINE the line contains a #subst directive
810 * CMD_IF the line contains a #if/#else/#endif directive
811 * CMD_DIRECTIVE the line contains some other compiler directive
812 *
813 * Global variables: iflevel, skiplevel, elsedone (altered)
814 * lptr (altered)
815 */
816static int
817command(void)
818{
819 int tok, ret;
820 cell val;
821 char *str;
822 int index;
823 cell code_index;
824
825 while (*lptr <= ' ' && *lptr != '\0')
826 lptr += 1;
827 if (*lptr == '\0')
828 return CMD_EMPTYLINE; /* empty line */
829 if (*lptr != '#')
830 return skiplevel > 0 ? CMD_CONDFALSE : CMD_NONE; /* it is not a compiler directive */
831 /* compiler directive found */
832 indent_nowarn = TRUE; /* allow loose indentation" */
833 lexclr(FALSE); /* clear any "pushed" tokens */
834 /* on a pending expression, force to return a silent ';' token and force to
835 * re-read the line
836 */
837 if (!sc_needsemicolon && stgget(&index, &code_index))
838 {
839 lptr = term_expr;
840 return CMD_TERM;
841 } /* if */
842 tok = lex(&val, &str);
843 ret = skiplevel > 0 ? CMD_CONDFALSE : CMD_DIRECTIVE; /* preset 'ret' to CMD_DIRECTIVE (most common case) */
844 switch (tok)
845 {
846 case tpIF: /* conditional compilation */
847 ret = CMD_IF;
848 iflevel += 1;
849 if (skiplevel)
850 break; /* break out of switch */
851 preproc_expr(&val, NULL); /* get value (or 0 on error) */
852 if (!val)
853 skiplevel = iflevel;
854 check_empty(lptr);
855 break;
856 case tpELSE:
857 ret = CMD_IF;
858 if (iflevel == 0 && skiplevel == 0)
859 {
860 error(26); /* no matching #if */
861 errorset(sRESET);
862 }
863 else
864 {
865 if (elsedone == iflevel)
866 error(60); /* multiple #else directives between #if ... #endif */
867 elsedone = iflevel;
868 if (skiplevel == iflevel)
869 skiplevel = 0;
870 else if (skiplevel == 0)
871 skiplevel = iflevel;
872 } /* if */
873 check_empty(lptr);
874 break;
875#if 0 /* ??? *really* need to use a stack here */
876 case tpELSEIF:
877 ret = CMD_IF;
878 if (iflevel == 0 && skiplevel == 0)
879 {
880 error(26); /* no matching #if */
881 errorset(sRESET);
882 }
883 else if (elsedone == iflevel)
884 {
885 error(61); /* #elseif directive may not follow an #else */
886 errorset(sRESET);
887 }
888 else
889 {
890 preproc_expr(&val, NULL); /* get value (or 0 on error) */
891 if (skiplevel == 0)
892 skiplevel = iflevel; /* we weren't skipping, start skipping now */
893 else if (val)
894 skiplevel = 0; /* we were skipping, condition is valid -> stop skipping */
895 /* else: we were skipping and condition is invalid -> keep skipping */
896 check_empty(lptr);
897 } /* if */
898 break;
899#endif
900 case tpENDIF:
901 ret = CMD_IF;
902 if (iflevel == 0 && skiplevel == 0)
903 {
904 error(26);
905 errorset(sRESET);
906 }
907 else
908 {
909 if (skiplevel == iflevel)
910 skiplevel = 0;
911 if (elsedone == iflevel)
912 elsedone = 0; /* ??? actually, should build a stack of #if/#endif and keep
913 * the state whether an #else was seen per nesting level */
914 iflevel -= 1;
915 } /* if */
916 check_empty(lptr);
917 break;
918 case tINCLUDE: /* #include directive */
919 ret = CMD_INCLUDE;
920 if (skiplevel == 0)
921 doinclude();
922 break;
923 case tpFILE:
924 if (skiplevel == 0)
925 {
926 char pathname[PATH_MAX];
927
928 lptr = getstring(pathname, sizeof pathname);
929 if (pathname[0] != '\0')
930 {
931 free(inpfname);
932 inpfname = strdup(pathname);
933 if (!inpfname)
934 error(103); /* insufficient memory */
935 } /* if */
936 } /* if */
937 check_empty(lptr);
938 break;
939 case tpLINE:
940 if (skiplevel == 0)
941 {
942 if (lex(&val, &str) != tNUMBER)
943 error(8); /* invalid/non-constant expression */
944 fline = (int)val;
945
946 while (*lptr == ' ' && *lptr != '\0')
947 lptr++; /* skip whitespace */
948 if (*lptr == '"')
949 {
950 char pathname[PATH_MAX];
951
952 lptr = getstring(pathname, sizeof pathname);
953 if (pathname[0] != '\0')
954 {
955 free(inpfname);
956 inpfname = strdup(pathname);
957 if (!inpfname)
958 error(103); /* insufficient memory */
959 } /* if */
960 }
961 } /* if */
962 check_empty(lptr);
963 break;
964 case tpASSERT:
965 if (skiplevel == 0 && (sc_debug & sCHKBOUNDS) != 0)
966 {
967 preproc_expr(&val, NULL); /* get constant expression (or 0 on error) */
968 if (!val)
969 error(7); /* assertion failed */
970 check_empty(lptr);
971 } /* if */
972 break;
973 case tpPRAGMA:
974 if (skiplevel == 0)
975 {
976 if (lex(&val, &str) == tSYMBOL)
977 {
978 if (strcmp(str, "ctrlchar") == 0)
979 {
980 if (lex(&val, &str) != tNUMBER)
981 error(27); /* invalid character constant */
982 sc_ctrlchar = (char)val;
983 }
984 else if (strcmp(str, "compress") == 0)
985 {
986 cell val;
987
988 preproc_expr(&val, NULL);
989 sc_compress = (int)val; /* switch code packing on/off */
990 }
991 else if (strcmp(str, "dynamic") == 0)
992 {
993 preproc_expr(&sc_stksize, NULL);
994 }
995 else if (strcmp(str, "library") == 0)
996 {
997 char name[sNAMEMAX + 1];
998
999 while (*lptr <= ' ' && *lptr != '\0')
1000 lptr++;
1001 if (*lptr == '"')
1002 {
1003 lptr = getstring(name, sizeof name);
1004 }
1005 else
1006 {
1007 int i;
1008
1009 for (i = 0;
1010 (i < (int)(sizeof(name))) &&
1011 (alphanum(*lptr));
1012 i++, lptr++)
1013 name[i] = *lptr;
1014 name[i] = '\0';
1015 } /* if */
1016 if (name[0] == '\0')
1017 {
1018 curlibrary = NULL;
1019 }
1020 else
1021 {
1022 if (strlen(name) > sEXPMAX)
1023 error(220, name, sEXPMAX); /* exported symbol is truncated */
1024 /* add the name if it does not yet exist in the table */
1025 if (!find_constval(&libname_tab, name, 0))
1026 curlibrary =
1027 append_constval(&libname_tab, name, 0, 0);
1028 } /* if */
1029 }
1030 else if (strcmp(str, "pack") == 0)
1031 {
1032 cell val;
1033
1034 preproc_expr(&val, NULL); /* default = packed/unpacked */
1035 sc_packstr = (int)val;
1036 }
1037 else if (strcmp(str, "rational") == 0)
1038 {
1039 char name[sNAMEMAX + 1];
1040 cell digits = 0;
1041 int i;
1042
1043 /* first gather all information, start with the tag name */
1044 while ((*lptr <= ' ') && (*lptr != '\0'))
1045 lptr++;
1046 for (i = 0;
1047 (i < (int)(sizeof(name))) &&
1048 (alphanum(*lptr));
1049 i++, lptr++)
1050 name[i] = *lptr;
1051 name[i] = '\0';
1052 /* then the precision (for fixed point arithmetic) */
1053 while (*lptr <= ' ' && *lptr != '\0')
1054 lptr++;
1055 if (*lptr == '(')
1056 {
1057 preproc_expr(&digits, NULL);
1058 if (digits <= 0 || digits > 9)
1059 {
1060 error(68); /* invalid rational number precision */
1061 digits = 0;
1062 } /* if */
1063 if (*lptr == ')')
1064 lptr++;
1065 } /* if */
1066 /* add the tag (make it public) and check the values */
1067 i = sc_addtag(name);
1068 exporttag(i);
1069 if (sc_rationaltag == 0
1070 || (sc_rationaltag == i
1071 && rational_digits == (int)digits))
1072 {
1073 sc_rationaltag = i;
1074 rational_digits = (int)digits;
1075 }
1076 else
1077 {
1078 error(69); /* rational number format already set, can only be set once */
1079 } /* if */
1080 }
1081 else if (strcmp(str, "semicolon") == 0)
1082 {
1083 cell val;
1084
1085 preproc_expr(&val, NULL);
1086 sc_needsemicolon = (int)val;
1087 }
1088 else if (strcmp(str, "tabsize") == 0)
1089 {
1090 cell val;
1091
1092 preproc_expr(&val, NULL);
1093 sc_tabsize = (int)val;
1094 }
1095 else if (strcmp(str, "align") == 0)
1096 {
1097 sc_alignnext = TRUE;
1098 }
1099 else if (strcmp(str, "unused") == 0)
1100 {
1101 char name[sNAMEMAX + 1];
1102 int i, comma;
1103 symbol *sym;
1104
1105 do
1106 {
1107 /* get the name */
1108 while ((*lptr <= ' ') && (*lptr != '\0'))
1109 lptr++;
1110 for (i = 0;
1111 (i < (int)(sizeof(name))) &&
1112 (isalpha(*lptr));
1113 i++, lptr++)
1114 name[i] = *lptr;
1115 name[i] = '\0';
1116 /* get the symbol */
1117 sym = findloc(name);
1118 if (!sym)
1119 sym = findglb(name);
1120 if (sym)
1121 {
1122 sym->usage |= uREAD;
1123 if (sym->ident == iVARIABLE
1124 || sym->ident == iREFERENCE
1125 || sym->ident == iARRAY
1126 || sym->ident == iREFARRAY)
1127 sym->usage |= uWRITTEN;
1128 }
1129 else
1130 {
1131 error(17, name); /* undefined symbol */
1132 } /* if */
1133 /* see if a comma follows the name */
1134 while (*lptr <= ' ' && *lptr != '\0')
1135 lptr++;
1136 comma = (*lptr == ',');
1137 if (comma)
1138 lptr++;
1139 }
1140 while (comma);
1141 }
1142 else
1143 {
1144 error(207); /* unknown #pragma */
1145 } /* if */
1146 }
1147 else
1148 {
1149 error(207); /* unknown #pragma */
1150 } /* if */
1151 check_empty(lptr);
1152 } /* if */
1153 break;
1154 case tpENDINPUT:
1155 case tpENDSCRPT:
1156 if (skiplevel == 0)
1157 {
1158 check_empty(lptr);
1159 assert(inpf != NULL);
1160 if (inpf != inpf_org)
1161 sc_closesrc(inpf);
1162 inpf = NULL;
1163 } /* if */
1164 break;
1165#if !defined NOEMIT
1166 case tpEMIT:
1167 {
1168 /* write opcode to output file */
1169 char name[40];
1170 int i;
1171
1172 while (*lptr <= ' ' && *lptr != '\0')
1173 lptr++;
1174 for (i = 0; i < 40 && (isalpha(*lptr) || *lptr == '.'); i++, lptr++)
1175 name[i] = (char)tolower(*lptr);
1176 name[i] = '\0';
1177 stgwrite("\t");
1178 stgwrite(name);
1179 stgwrite(" ");
1180 code_idx += opcodes(1);
1181 /* write parameter (if any) */
1182 while (*lptr <= ' ' && *lptr != '\0')
1183 lptr++;
1184 if (*lptr != '\0')
1185 {
1186 symbol *sym;
1187
1188 tok = lex(&val, &str);
1189 switch (tok)
1190 {
1191 case tNUMBER:
1192 case tRATIONAL:
1193 outval(val, FALSE);
1194 code_idx += opargs(1);
1195 break;
1196 case tSYMBOL:
1197 sym = findloc(str);
1198 if (!sym)
1199 sym = findglb(str);
1200 if (!sym || (sym->ident != iFUNCTN
1201 && sym->ident != iREFFUNC
1202 && (sym->usage & uDEFINE) == 0))
1203 {
1204 error(17, str); /* undefined symbol */
1205 }
1206 else
1207 {
1208 outval(sym->addr, FALSE);
1209 /* mark symbol as "used", unknown whether for read or write */
1210 markusage(sym, uREAD | uWRITTEN);
1211 code_idx += opargs(1);
1212 } /* if */
1213 break;
1214 default:
1215 {
1216 char s2[20];
1217 extern char *sc_tokens[]; /* forward declaration */
1218
1219 if (tok < 256)
1220 sprintf(s2, "%c", (char)tok);
1221 else
1222 strcpy(s2, sc_tokens[tok - tFIRST]);
1223 error(1, sc_tokens[tSYMBOL - tFIRST], s2);
1224 break;
1225 } /* case */
1226 } /* switch */
1227 } /* if */
1228 stgwrite("\n");
1229 check_empty(lptr);
1230 break;
1231 } /* case */
1232#endif
1233#if !defined NO_DEFINE
1234 case tpDEFINE:
1235 {
1236 ret = CMD_DEFINE;
1237 if (skiplevel == 0)
1238 {
1239 char *pattern, *substitution;
1240 char *start, *end;
1241 int count, prefixlen;
1242 stringpair *def;
1243
1244 /* find the pattern to match */
1245 while (*lptr <= ' ' && *lptr != '\0')
1246 lptr++;
1247 start = lptr; /* save starting point of the match pattern */
1248 count = 0;
1249 while (*lptr > ' ' && *lptr != '\0')
1250 {
1251 litchar(&lptr, FALSE); /* litchar() advances "lptr" and handles escape characters */
1252 count++;
1253 } /* while */
1254 end = lptr;
1255 /* check pattern to match */
1256 if (!isalpha(*start) && *start != '_')
1257 {
1258 error(74); /* pattern must start with an alphabetic character */
1259 break;
1260 } /* if */
1261 /* store matched pattern */
1262 pattern = malloc(count + 1);
1263 if (!pattern)
1264 error(103); /* insufficient memory */
1265 lptr = start;
1266 count = 0;
1267 while (lptr != end)
1268 {
1269 assert(lptr < end);
1270 assert(*lptr != '\0');
1271 pattern[count++] = (char)litchar(&lptr, FALSE);
1272 } /* while */
1273 pattern[count] = '\0';
1274 /* special case, erase trailing variable, because it could match anything */
1275 if (count >= 2 && isdigit(pattern[count - 1])
1276 && pattern[count - 2] == '%')
1277 pattern[count - 2] = '\0';
1278 /* find substitution string */
1279 while (*lptr <= ' ' && *lptr != '\0')
1280 lptr++;
1281 start = lptr; /* save starting point of the match pattern */
1282 count = 0;
1283 end = NULL;
1284 while (*lptr != '\0')
1285 {
1286 /* keep position of the start of trailing whitespace */
1287 if (*lptr <= ' ')
1288 {
1289 if (!end)
1290 end = lptr;
1291 }
1292 else
1293 {
1294 end = NULL;
1295 } /* if */
1296 count++;
1297 lptr++;
1298 } /* while */
1299 if (!end)
1300 end = lptr;
1301 /* store matched substitution */
1302 substitution = malloc(count + 1); /* +1 for '\0' */
1303 if (!substitution)
1304 error(103); /* insufficient memory */
1305 lptr = start;
1306 count = 0;
1307 while (lptr != end)
1308 {
1309 assert(lptr < end);
1310 assert(*lptr != '\0');
1311 substitution[count++] = *lptr++;
1312 } /* while */
1313 substitution[count] = '\0';
1314 /* check whether the definition already exists */
1315 for (prefixlen = 0, start = pattern;
1316 isalpha(*start) || isdigit(*start) || *start == '_';
1317 prefixlen++, start++)
1318 /* nothing */ ;
1319 assert(prefixlen > 0);
1320 if ((def = find_subst(pattern, prefixlen)))
1321 {
1322 if (strcmp(def->first, pattern) != 0
1323 || strcmp(def->second, substitution) != 0)
1324 error(201, pattern); /* redefinition of macro (non-identical) */
1325 delete_subst(pattern, prefixlen);
1326 } /* if */
1327 /* add the pattern/substitution pair to the list */
1328 assert(pattern[0] != '\0');
1329 insert_subst(pattern, substitution, prefixlen);
1330 free(pattern);
1331 free(substitution);
1332 } /* if */
1333 break;
1334 } /* case */
1335 case tpUNDEF:
1336 if (skiplevel == 0)
1337 {
1338 if (lex(&val, &str) == tSYMBOL)
1339 {
1340 if (!delete_subst(str, strlen(str)))
1341 error(17, str); /* undefined symbol */
1342 }
1343 else
1344 {
1345 error(20, str); /* invalid symbol name */
1346 } /* if */
1347 check_empty(lptr);
1348 } /* if */
1349 break;
1350#endif
1351 default:
1352 error(31); /* unknown compiler directive */
1353 ret = skiplevel > 0 ? CMD_DIRECTIVE : CMD_NONE; /* line must be processed (if skiplevel==0) */
1354 } /* switch */
1355 return ret;
1356}
1357
1358#if !defined NO_DEFINE
1359static int
1360is_startstring(char *string)
1361{
1362 if (*string == '\"' || *string == '\'')
1363 return TRUE; /* "..." */
1364
1365 if (*string == '!')
1366 {
1367 string++;
1368 if (*string == '\"' || *string == '\'')
1369 return TRUE; /* !"..." */
1370 if (*string == sc_ctrlchar)
1371 {
1372 string++;
1373 if (*string == '\"' || *string == '\'')
1374 return TRUE; /* !\"..." */
1375 } /* if */
1376 }
1377 else if (*string == sc_ctrlchar)
1378 {
1379 string++;
1380 if (*string == '\"' || *string == '\'')
1381 return TRUE; /* \"..." */
1382 if (*string == '!')
1383 {
1384 string++;
1385 if (*string == '\"' || *string == '\'')
1386 return TRUE; /* \!"..." */
1387 } /* if */
1388 } /* if */
1389
1390 return FALSE;
1391}
1392
1393static char *
1394skipstring(char *string)
1395{
1396 char endquote;
1397 int rawstring = FALSE;
1398
1399 while (*string == '!' || *string == sc_ctrlchar)
1400 {
1401 rawstring = (*string == sc_ctrlchar);
1402 string++;
1403 } /* while */
1404
1405 endquote = *string;
1406 assert(endquote == '\"' || endquote == '\'');
1407 string++; /* skip open quote */
1408 while (*string != endquote && *string != '\0')
1409 litchar(&string, rawstring);
1410 return string;
1411}
1412
1413static char *
1414skippgroup(char *string)
1415{
1416 int nest = 0;
1417 char open = *string;
1418 char close;
1419
1420 switch (open)
1421 {
1422 case '(':
1423 close = ')';
1424 break;
1425 case '{':
1426 close = '}';
1427 break;
1428 case '[':
1429 close = ']';
1430 break;
1431 case '<':
1432 close = '>';
1433 break;
1434 default:
1435 assert(0);
1436 close = '\0'; /* only to avoid a compiler warning */
1437 } /* switch */
1438
1439 string++;
1440 while (*string != close || nest > 0)
1441 {
1442 if (*string == open)
1443 nest++;
1444 else if (*string == close)
1445 nest--;
1446 else if (is_startstring(string))
1447 string = skipstring(string);
1448 if (*string == '\0')
1449 break;
1450 string++;
1451 } /* while */
1452 return string;
1453}
1454
1455static char *
1456strdel(char *str, size_t len)
1457{
1458 size_t length = strlen(str);
1459
1460 if (len > length)
1461 len = length;
1462 memmove(str, str + len, length - len + 1); /* include EOS byte */
1463 return str;
1464}
1465
1466static char *
1467strins(char *dest, char *src, size_t srclen)
1468{
1469 size_t destlen = strlen(dest);
1470
1471 assert(srclen <= strlen(src));
1472 memmove(dest + srclen, dest, destlen + 1); /* include EOS byte */
1473 memcpy(dest, src, srclen);
1474 return dest;
1475}
1476
1477static int
1478substpattern(char *line, size_t buffersize, char *pattern, char *substitution)
1479{
1480 int prefixlen;
1481 char *p, *s, *e, *args[10];
1482 int match, arg, len;
1483
1484 memset(args, 0, sizeof args);
1485
1486 /* check the length of the prefix */
1487 for (prefixlen = 0, s = pattern; isalpha(*s) || isdigit(*s) || *s == '_';
1488 prefixlen++, s++)
1489 /* nothing */ ;
1490 assert(prefixlen > 0);
1491 assert(strncmp(line, pattern, prefixlen) == 0);
1492
1493 /* pattern prefix matches; match the rest of the pattern, gather
1494 * the parameters
1495 */
1496 s = line + prefixlen;
1497 p = pattern + prefixlen;
1498 match = TRUE; /* so far, pattern matches */
1499 while (match && *s != '\0' && *p != '\0')
1500 {
1501 if (*p == '%')
1502 {
1503 p++; /* skip '%' */
1504 if (isdigit(*p))
1505 {
1506 arg = *p - '0';
1507 assert(arg >= 0 && arg <= 9);
1508 p++; /* skip parameter id */
1509 assert(*p != '\0');
1510 /* match the source string up to the character after the digit
1511 * (skipping strings in the process
1512 */
1513 e = s;
1514 while (*e != *p && *e != '\0' && *e != '\n')
1515 {
1516 if (is_startstring(e)) /* skip strings */
1517 e = skipstring(e);
1518 else if (strchr("({[", *e)) /* skip parenthized groups */
1519 e = skippgroup(e);
1520 if (*e != '\0')
1521 e++; /* skip non-alphapetic character (or closing quote of
1522 * a string, or the closing paranthese of a group) */
1523 } /* while */
1524 /* store the parameter (overrule any earlier) */
1525 if (args[arg])
1526 free(args[arg]);
1527 len = (int)(e - s);
1528 args[arg] = malloc(len + 1);
1529 if (!args[arg])
1530 error(103); /* insufficient memory */
1531 strncpy(args[arg], s, len);
1532 args[arg][len] = '\0';
1533 /* character behind the pattern was matched too */
1534 if (*e == *p)
1535 {
1536 s = e + 1;
1537 }
1538 else if (*e == '\n' && *p == ';' && *(p + 1) == '\0'
1539 && !sc_needsemicolon)
1540 {
1541 s = e; /* allow a trailing ; in the pattern match to end of line */
1542 }
1543 else
1544 {
1545 assert(*e == '\0' || *e == '\n');
1546 match = FALSE;
1547 s = e;
1548 } /* if */
1549 p++;
1550 }
1551 else
1552 {
1553 match = FALSE;
1554 } /* if */
1555 }
1556 else if (*p == ';' && *(p + 1) == '\0' && !sc_needsemicolon)
1557 {
1558 /* source may be ';' or end of the line */
1559 while (*s <= ' ' && *s != '\0')
1560 s++; /* skip white space */
1561 if (*s != ';' && *s != '\0')
1562 match = FALSE;
1563 p++; /* skip the semicolon in the pattern */
1564 }
1565 else
1566 {
1567 cell ch;
1568
1569 /* skip whitespace between two non-alphanumeric characters, except
1570 * for two identical symbols
1571 */
1572 assert(p > pattern);
1573 if (!alphanum(*p) && *(p - 1) != *p)
1574 while (*s <= ' ' && *s != '\0')
1575 s++; /* skip white space */
1576 ch = litchar(&p, FALSE); /* this increments "p" */
1577 if (*s != ch)
1578 match = FALSE;
1579 else
1580 s++; /* this character matches */
1581 } /* if */
1582 } /* while */
1583
1584 if (match && *p == '\0')
1585 {
1586 /* if the last character to match is an alphanumeric character, the
1587 * current character in the source may not be alphanumeric
1588 */
1589 assert(p > pattern);
1590 if (alphanum(*(p - 1)) && alphanum(*s))
1591 match = FALSE;
1592 } /* if */
1593
1594 if (match)
1595 {
1596 /* calculate the length of the substituted string */
1597 for (e = substitution, len = 0; *e != '\0'; e++)
1598 {
1599 if (*e == '%' && isdigit(*(e + 1)))
1600 {
1601 arg = *(e + 1) - '0';
1602 assert(arg >= 0 && arg <= 9);
1603 if (args[arg])
1604 len += strlen(args[arg]);
1605 e++; /* skip %, digit is skipped later */
1606 }
1607 else
1608 {
1609 len++;
1610 } /* if */
1611 } /* for */
1612 /* check length of the string after substitution */
1613 if (strlen(line) + len - (int)(s - line) > buffersize)
1614 {
1615 error(75); /* line too long */
1616 }
1617 else
1618 {
1619 /* substitute pattern */
1620 strdel(line, (int)(s - line));
1621 for (e = substitution, s = line; *e != '\0'; e++)
1622 {
1623 if (*e == '%' && isdigit(*(e + 1)))
1624 {
1625 arg = *(e + 1) - '0';
1626 assert(arg >= 0 && arg <= 9);
1627 if (args[arg])
1628 {
1629 strins(s, args[arg], strlen(args[arg]));
1630 s += strlen(args[arg]);
1631 } /* if */
1632 e++; /* skip %, digit is skipped later */
1633 }
1634 else
1635 {
1636 strins(s, e, 1);
1637 s++;
1638 } /* if */
1639 } /* for */
1640 } /* if */
1641 } /* if */
1642
1643 for (arg = 0; arg < 10; arg++)
1644 if (args[arg])
1645 free(args[arg]);
1646
1647 return match;
1648}
1649
1650static void
1651substallpatterns(char *line, int buffersize)
1652{
1653 char *start, *end;
1654 int prefixlen;
1655 stringpair *subst;
1656
1657 start = line;
1658 while (*start != '\0')
1659 {
1660 /* find the start of a prefix (skip all non-alphabetic characters),
1661 * also skip strings
1662 */
1663 while (!isalpha(*start) && *start != '_' && *start != '\0')
1664 {
1665 /* skip strings */
1666 if (is_startstring(start))
1667 {
1668 start = skipstring(start);
1669 if (*start == '\0')
1670 break; /* abort loop on error */
1671 } /* if */
1672 start++; /* skip non-alphapetic character (or closing quote of a string) */
1673 } /* while */
1674 if (*start == '\0')
1675 break; /* abort loop on error */
1676 /* get the prefix (length), look for a matching definition */
1677 prefixlen = 0;
1678 end = start;
1679 while (isalpha(*end) || isdigit(*end) || *end == '_')
1680 {
1681 prefixlen++;
1682 end++;
1683 } /* while */
1684 assert(prefixlen > 0);
1685 subst = find_subst(start, prefixlen);
1686 if (subst)
1687 {
1688 /* properly match the pattern and substitute */
1689 if (!substpattern
1690 (start, buffersize - (start - line), subst->first,
1691 subst->second))
1692 start = end; /* match failed, skip this prefix */
1693 /* match succeeded: do not update "start", because the substitution text
1694 * may be matched by other macros
1695 */
1696 }
1697 else
1698 {
1699 start = end; /* no macro with this prefix, skip this prefix */
1700 } /* if */
1701 } /* while */
1702}
1703#endif
1704
1705/* preprocess
1706 *
1707 * Reads a line by readline() into "pline" and performs basic preprocessing:
1708 * deleting comments, skipping lines with false "#if.." code and recognizing
1709 * other compiler directives. There is an indirect recursion: lex() calls
1710 * preprocess() if a new line must be read, preprocess() calls command(),
1711 * which at his turn calls lex() to identify the token.
1712 *
1713 * Global references: lptr (altered)
1714 * pline (altered)
1715 * freading (referred to only)
1716 */
1717void
1718preprocess(void)
1719{
1720 int iscommand;
1721
1722 if (!freading)
1723 return;
1724 do
1725 {
1726 readline(pline);
1727 stripcom(pline); /* ??? no need for this when reading back from list file (in the second pass) */
1728 lptr = pline; /* set "line pointer" to start of the parsing buffer */
1729 iscommand = command();
1730 if (iscommand != CMD_NONE)
1731 errorset(sRESET); /* reset error flag ("panic mode") on empty line or directive */
1732#if !defined NO_DEFINE
1733 if (iscommand == CMD_NONE)
1734 {
1735 assert(lptr != term_expr);
1736 substallpatterns(pline, sLINEMAX);
1737 lptr = pline; /* reset "line pointer" to start of the parsing buffer */
1738 } /* if */
1739#endif
1740 }
1741 while (iscommand != CMD_NONE && iscommand != CMD_TERM && freading); /* enddo */
1742}
1743
1744static char *
1745unpackedstring(char *lptr, int rawstring)
1746{
1747 while (*lptr != '\0')
1748 {
1749 /* check for doublequotes indicating the end of the string */
1750 if (*lptr == '\"')
1751 {
1752 /* check whether there's another pair of quotes following.
1753 * If so, paste the two strings together, thus
1754 * "pants""off" becomes "pantsoff"
1755 */
1756 if (*(lptr + 1) == '\"')
1757 lptr += 2;
1758 else
1759 break;
1760 }
1761
1762 if (*lptr == '\a')
1763 { /* ignore '\a' (which was inserted at a line concatenation) */
1764 lptr++;
1765 continue;
1766 } /* if */
1767 stowlit(litchar(&lptr, rawstring)); /* litchar() alters "lptr" */
1768 } /* while */
1769 stowlit(0); /* terminate string */
1770 return lptr;
1771}
1772
1773static char *
1774packedstring(char *lptr, int rawstring)
1775{
1776 int i;
1777 ucell val, c;
1778
1779 i = sizeof(ucell) - (charbits / 8); /* start at most significant byte */
1780 val = 0;
1781 while (*lptr != '\0')
1782 {
1783 /* check for doublequotes indicating the end of the string */
1784 if (*lptr == '\"')
1785 {
1786 /* check whether there's another pair of quotes following.
1787 * If so, paste the two strings together, thus
1788 * "pants""off" becomes "pantsoff"
1789 */
1790 if (*(lptr + 1) == '\"')
1791 lptr += 2;
1792 else
1793 break;
1794 }
1795
1796 if (*lptr == '\a')
1797 { /* ignore '\a' (which was inserted at a line concatenation) */
1798 lptr++;
1799 continue;
1800 } /* if */
1801 c = litchar(&lptr, rawstring); /* litchar() alters "lptr" */
1802 if (c >= (ucell) (1 << charbits))
1803 error(43); /* character constant exceeds range */
1804 val |= (c << 8 * i);
1805 if (i == 0)
1806 {
1807 stowlit(val);
1808 val = 0;
1809 } /* if */
1810 i = (i + sizeof(ucell) - (charbits / 8)) % sizeof(ucell);
1811 } /* if */
1812 /* save last code; make sure there is at least one terminating zero character */
1813 if (i != (int)(sizeof(ucell) - (charbits / 8)))
1814 stowlit(val); /* at least one zero character in "val" */
1815 else
1816 stowlit(0); /* add full cell of zeros */
1817 return lptr;
1818}
1819
1820/* lex(lexvalue,lexsym) Lexical Analysis
1821 *
1822 * lex() first deletes leading white space, then checks for multi-character
1823 * operators, keywords (including most compiler directives), numbers,
1824 * labels, symbols and literals (literal characters are converted to a number
1825 * and are returned as such). If every check fails, the line must contain
1826 * a single-character operator. So, lex() returns this character. In the other
1827 * case (something did match), lex() returns the number of the token. All
1828 * these tokens have been assigned numbers above 255.
1829 *
1830 * Some tokens have "attributes":
1831 * tNUMBER the value of the number is return in "lexvalue".
1832 * tRATIONAL the value is in IEEE 754 encoding or in fixed point
1833 * encoding in "lexvalue".
1834 * tSYMBOL the first sNAMEMAX characters of the symbol are
1835 * stored in a buffer, a pointer to this buffer is
1836 * returned in "lexsym".
1837 * tLABEL the first sNAMEMAX characters of the label are
1838 * stored in a buffer, a pointer to this buffer is
1839 * returned in "lexsym".
1840 * tSTRING the string is stored in the literal pool, the index
1841 * in the literal pool to this string is stored in
1842 * "lexvalue".
1843 *
1844 * lex() stores all information (the token found and possibly its attribute)
1845 * in global variables. This allows a token to be examined twice. If "_pushed"
1846 * is true, this information is returned.
1847 *
1848 * Global references: lptr (altered)
1849 * fline (referred to only)
1850 * litidx (referred to only)
1851 * _lextok, _lexval, _lexstr
1852 * _pushed
1853 */
1854
1855static int _pushed;
1856static int _lextok;
1857static cell _lexval;
1858static char _lexstr[sLINEMAX + 1];
1859static int _lexnewline;
1860
1861void
1862lexinit(void)
1863{
1864 stkidx = 0; /* index for pushstk() and popstk() */
1865 iflevel = 0; /* preprocessor: nesting of "#if" */
1866 skiplevel = 0; /* preprocessor: skipping lines or compiling lines */
1867 icomment = FALSE; /* currently not in a multiline comment */
1868 _pushed = FALSE; /* no token pushed back into lex */
1869 _lexnewline = FALSE;
1870}
1871
1872char *sc_tokens[] = {
1873 "*=", "/=", "%=", "+=", "-=", "<<=", ">>>=", ">>=", "&=", "^=", "|=",
1874 "||", "&&", "==", "!=", "<=", ">=", "<<", ">>>", ">>", "++", "--",
1875 "...", "..",
1876 "assert", "break", "case", "char", "const", "continue", "default",
1877 "defined", "do", "else", "enum", "exit", "for", "forward", "goto",
1878 "if", "native", "new", "operator", "public", "return", "sizeof",
1879 "sleep", "static", "stock", "switch", "tagof", "while",
1880 "#assert", "#define", "#else", "#emit", "#endif", "#endinput",
1881 "#endscript", "#file", "#if", "#include", "#line", "#pragma", "#undef",
1882 ";", ";", "-integer value-", "-rational value-", "-identifier-",
1883 "-label-", "-string-"
1884};
1885
1886int
1887lex(cell * lexvalue, char **lexsym)
1888{
1889 int i, toolong, newline, rawstring;
1890 char **tokptr;
1891
1892 if (_pushed)
1893 {
1894 _pushed = FALSE; /* reset "_pushed" flag */
1895 *lexvalue = _lexval;
1896 *lexsym = _lexstr;
1897 return _lextok;
1898 } /* if */
1899
1900 _lextok = 0; /* preset all values */
1901 _lexval = 0;
1902 _lexstr[0] = '\0';
1903 *lexvalue = _lexval;
1904 *lexsym = _lexstr;
1905 _lexnewline = FALSE;
1906 if (!freading)
1907 return 0;
1908
1909 newline = (lptr == pline); /* does lptr point to start of line buffer */
1910 while (*lptr <= ' ')
1911 { /* delete leading white space */
1912 if (*lptr == '\0')
1913 {
1914 preprocess(); /* preprocess resets "lptr" */
1915 if (!freading)
1916 return 0;
1917 if (lptr == term_expr) /* special sequence to terminate a pending expression */
1918 return (_lextok = tENDEXPR);
1919 _lexnewline = TRUE; /* set this after preprocess(), because
1920 * preprocess() calls lex() recursively */
1921 newline = TRUE;
1922 }
1923 else
1924 {
1925 lptr += 1;
1926 } /* if */
1927 } /* while */
1928 if (newline)
1929 {
1930 stmtindent = 0;
1931 for (i = 0; i < (int)(lptr - pline); i++)
1932 if (pline[i] == '\t' && sc_tabsize > 0)
1933 stmtindent +=
1934 (int)(sc_tabsize - (stmtindent + sc_tabsize) % sc_tabsize);
1935 else
1936 stmtindent++;
1937 } /* if */
1938
1939 i = tFIRST;
1940 tokptr = sc_tokens;
1941 while (i <= tMIDDLE)
1942 { /* match multi-character operators */
1943 if (match(*tokptr, FALSE))
1944 {
1945 _lextok = i;
1946 return _lextok;
1947 } /* if */
1948 i += 1;
1949 tokptr += 1;
1950 } /* while */
1951 while (i <= tLAST)
1952 { /* match reserved words and compiler directives */
1953 if (match(*tokptr, TRUE))
1954 {
1955 _lextok = i;
1956 errorset(sRESET); /* reset error flag (clear the "panic mode") */
1957 return _lextok;
1958 } /* if */
1959 i += 1;
1960 tokptr += 1;
1961 } /* while */
1962
1963 if ((i = number(&_lexval, lptr)) != 0)
1964 { /* number */
1965 _lextok = tNUMBER;
1966 *lexvalue = _lexval;
1967 lptr += i;
1968 }
1969 else if ((i = ftoi(&_lexval, lptr)) != 0)
1970 {
1971 _lextok = tRATIONAL;
1972 *lexvalue = _lexval;
1973 lptr += i;
1974 }
1975 else if (alpha(*lptr))
1976 { /* symbol or label */
1977 /* Note: only sNAMEMAX characters are significant. The compiler
1978 * generates a warning if a symbol exceeds this length.
1979 */
1980 _lextok = tSYMBOL;
1981 i = 0;
1982 toolong = 0;
1983 while (alphanum(*lptr))
1984 {
1985 _lexstr[i] = *lptr;
1986 lptr += 1;
1987 if (i < sNAMEMAX)
1988 i += 1;
1989 else
1990 toolong = 1;
1991 } /* while */
1992 _lexstr[i] = '\0';
1993 if (toolong)
1994 error(200, _lexstr, sNAMEMAX); /* symbol too long, truncated to sNAMEMAX chars */
1995 if (_lexstr[0] == PUBLIC_CHAR && _lexstr[1] == '\0')
1996 {
1997 _lextok = PUBLIC_CHAR; /* '@' all alone is not a symbol, it is an operator */
1998 }
1999 else if (_lexstr[0] == '_' && _lexstr[1] == '\0')
2000 {
2001 _lextok = '_'; /* '_' by itself is not a symbol, it is a placeholder */
2002 } /* if */
2003 if (*lptr == ':' && sc_allowtags && _lextok != PUBLIC_CHAR)
2004 {
2005 _lextok = tLABEL; /* it wasn't a normal symbol, it was a label/tagname */
2006 lptr += 1; /* skip colon */
2007 } /* if */
2008 }
2009 else if (*lptr == '\"' || (*lptr == sc_ctrlchar && *(lptr + 1) == '\"'))
2010 { /* unpacked string literal */
2011 _lextok = tSTRING;
2012 rawstring = (*lptr == sc_ctrlchar);
2013 *lexvalue = _lexval = litidx;
2014 lptr += 1; /* skip double quote */
2015 if (rawstring)
2016 lptr += 1; /* skip "escape" character too */
2017 lptr =
2018 sc_packstr ? packedstring(lptr, rawstring) : unpackedstring(lptr,
2019 rawstring);
2020 if (*lptr == '\"')
2021 lptr += 1; /* skip final quote */
2022 else
2023 error(37); /* invalid (non-terminated) string */
2024 }
2025 else if ((*lptr == '!' && *(lptr + 1) == '\"')
2026 || (*lptr == '!' && *(lptr + 1) == sc_ctrlchar && *(lptr + 2) == '\"')
2027 || (*lptr == sc_ctrlchar && *(lptr + 1) == '!'
2028 && *(lptr + 2) == '\"'))
2029 { /* packed string literal */
2030 _lextok = tSTRING;
2031 rawstring = (*lptr == sc_ctrlchar || *(lptr + 1) == sc_ctrlchar);
2032 *lexvalue = _lexval = litidx;
2033 lptr += 2; /* skip exclamation point and double quote */
2034 if (rawstring)
2035 lptr += 1; /* skip "escape" character too */
2036 lptr =
2037 sc_packstr ? unpackedstring(lptr, rawstring) : packedstring(lptr,
2038 rawstring);
2039 if (*lptr == '\"')
2040 lptr += 1; /* skip final quote */
2041 else
2042 error(37); /* invalid (non-terminated) string */
2043 }
2044 else if (*lptr == '\'')
2045 { /* character literal */
2046 lptr += 1; /* skip quote */
2047 _lextok = tNUMBER;
2048 *lexvalue = _lexval = litchar(&lptr, FALSE);
2049 if (*lptr == '\'')
2050 lptr += 1; /* skip final quote */
2051 else
2052 error(27); /* invalid character constant (must be one character) */
2053 }
2054 else if (*lptr == ';')
2055 { /* semicolumn resets "error" flag */
2056 _lextok = ';';
2057 lptr += 1;
2058 errorset(sRESET); /* reset error flag (clear the "panic mode") */
2059 }
2060 else
2061 {
2062 _lextok = *lptr; /* if every match fails, return the character */
2063 lptr += 1; /* increase the "lptr" pointer */
2064 } /* if */
2065 return _lextok;
2066}
2067
2068/* lexpush
2069 *
2070 * Pushes a token back, so the next call to lex() will return the token
2071 * last examined, instead of a new token.
2072 *
2073 * Only one token can be pushed back.
2074 *
2075 * In fact, lex() already stores the information it finds into global
2076 * variables, so all that is to be done is set a flag that informs lex()
2077 * to read and return the information from these variables, rather than
2078 * to read in a new token from the input file.
2079 */
2080void
2081lexpush(void)
2082{
2083 assert(_pushed == FALSE);
2084 _pushed = TRUE;
2085}
2086
2087/* lexclr
2088 *
2089 * Sets the variable "_pushed" to 0 to make sure lex() will read in a new
2090 * symbol (a not continue with some old one). This is required upon return
2091 * from Assembler mode.
2092 */
2093void
2094lexclr(int clreol)
2095{
2096 _pushed = FALSE;
2097 if (clreol)
2098 {
2099 lptr = strchr(pline, '\0');
2100 assert(lptr != NULL);
2101 } /* if */
2102}
2103
2104/* matchtoken
2105 *
2106 * This routine is useful if only a simple check is needed. If the token
2107 * differs from the one expected, it is pushed back.
2108 */
2109int
2110matchtoken(int token)
2111{
2112 cell val;
2113 char *str;
2114 int tok;
2115
2116 tok = lex(&val, &str);
2117 if (tok == token || (token == tTERM && (tok == ';' || tok == tENDEXPR)))
2118 {
2119 return 1;
2120 }
2121 else if (!sc_needsemicolon && token == tTERM && (_lexnewline || !freading))
2122 {
2123 lexpush(); /* push "tok" back, we use the "hidden" newline token */
2124 return 1;
2125 }
2126 else
2127 {
2128 lexpush();
2129 return 0;
2130 } /* if */
2131}
2132
2133/* tokeninfo
2134 *
2135 * Returns additional information of a token after using "matchtoken()"
2136 * or needtoken(). It does no harm using this routine after a call to
2137 * "lex()", but lex() already returns the same information.
2138 *
2139 * The token itself is the return value. Normally, this one is already known.
2140 */
2141int
2142tokeninfo(cell * val, char **str)
2143{
2144 /* if the token was pushed back, tokeninfo() returns the token and
2145 * parameters of the *next* token, not of the *current* token.
2146 */
2147 assert(!_pushed);
2148 *val = _lexval;
2149 *str = _lexstr;
2150 return _lextok;
2151}
2152
2153/* needtoken
2154 *
2155 * This routine checks for a required token and gives an error message if
2156 * it isn't there (and returns FALSE in that case).
2157 *
2158 * Global references: _lextok;
2159 */
2160int
2161needtoken(int token)
2162{
2163 char s1[20], s2[20];
2164
2165 if (matchtoken(token))
2166 {
2167 return TRUE;
2168 }
2169 else
2170 {
2171 /* token already pushed back */
2172 assert(_pushed);
2173 if (token < 256)
2174 sprintf(s1, "%c", (char)token); /* single character token */
2175 else
2176 strcpy(s1, sc_tokens[token - tFIRST]); /* multi-character symbol */
2177 if (!freading)
2178 strcpy(s2, "-end of file-");
2179 else if (_lextok < 256)
2180 sprintf(s2, "%c", (char)_lextok);
2181 else
2182 strcpy(s2, sc_tokens[_lextok - tFIRST]);
2183 error(1, s1, s2); /* expected ..., but found ... */
2184 return FALSE;
2185 } /* if */
2186}
2187
2188/* match
2189 *
2190 * Compares a series of characters from the input file with the characters
2191 * in "st" (that contains a token). If the token on the input file matches
2192 * "st", the input file pointer "lptr" is adjusted to point to the next
2193 * token, otherwise "lptr" remains unaltered.
2194 *
2195 * If the parameter "end: is true, match() requires that the first character
2196 * behind the recognized token is non-alphanumeric.
2197 *
2198 * Global references: lptr (altered)
2199 */
2200static int
2201match(char *st, int end)
2202{
2203 int k;
2204 char *ptr;
2205
2206 k = 0;
2207 ptr = lptr;
2208 while (st[k])
2209 {
2210 if (st[k] != *ptr)
2211 return 0;
2212 k += 1;
2213 ptr += 1;
2214 } /* while */
2215 if (end)
2216 { /* symbol must terminate with non-alphanumeric char */
2217 if (alphanum(*ptr))
2218 return 0;
2219 } /* if */
2220 lptr = ptr; /* match found, skip symbol */
2221 return 1;
2222}
2223
2224/* stowlit
2225 *
2226 * Stores a value into the literal queue. The literal queue is used for
2227 * literal strings used in functions and for initializing array variables.
2228 *
2229 * Global references: litidx (altered)
2230 * litq (altered)
2231 */
2232void
2233stowlit(cell value)
2234{
2235 if (litidx >= litmax)
2236 {
2237 cell *p;
2238
2239 litmax += sDEF_LITMAX;
2240 p = (cell *) realloc(litq, litmax * sizeof(cell));
2241 if (!p)
2242 error(102, "literal table"); /* literal table overflow (fatal error) */
2243 litq = p;
2244 } /* if */
2245 assert(litidx < litmax);
2246 litq[litidx++] = value;
2247}
2248
2249/* litchar
2250 *
2251 * Return current literal character and increase the pointer to point
2252 * just behind this literal character.
2253 *
2254 * Note: standard "escape sequences" are suported, but the backslash may be
2255 * replaced by another character; the syntax '\ddd' is supported,
2256 * but ddd must be decimal!
2257 */
2258static cell
2259litchar(char **lptr, int rawmode)
2260{
2261 cell c = 0;
2262 unsigned char *cptr;
2263
2264 cptr = (unsigned char *)*lptr;
2265 if (rawmode || *cptr != sc_ctrlchar)
2266 { /* no escape character */
2267 c = *cptr;
2268 cptr += 1;
2269 }
2270 else
2271 {
2272 cptr += 1;
2273 if (*cptr == sc_ctrlchar)
2274 {
2275 c = *cptr; /* \\ == \ (the escape character itself) */
2276 cptr += 1;
2277 }
2278 else
2279 {
2280 switch (*cptr)
2281 {
2282 case 'a': /* \a == audible alarm */
2283 c = 7;
2284 cptr += 1;
2285 break;
2286 case 'b': /* \b == backspace */
2287 c = 8;
2288 cptr += 1;
2289 break;
2290 case 'e': /* \e == escape */
2291 c = 27;
2292 cptr += 1;
2293 break;
2294 case 'f': /* \f == form feed */
2295 c = 12;
2296 cptr += 1;
2297 break;
2298 case 'n': /* \n == NewLine character */
2299 c = 10;
2300 cptr += 1;
2301 break;
2302 case 'r': /* \r == carriage return */
2303 c = 13;
2304 cptr += 1;
2305 break;
2306 case 't': /* \t == horizontal TAB */
2307 c = 9;
2308 cptr += 1;
2309 break;
2310 case 'v': /* \v == vertical TAB */
2311 c = 11;
2312 cptr += 1;
2313 break;
2314 case '\'': /* \' == ' (single quote) */
2315 case '"': /* \" == " (single quote) */
2316 case '%': /* \% == % (percent) */
2317 c = *cptr;
2318 cptr += 1;
2319 break;
2320 default:
2321 if (isdigit(*cptr))
2322 { /* \ddd */
2323 c = 0;
2324 while (*cptr >= '0' && *cptr <= '9') /* decimal! */
2325 c = c * 10 + *cptr++ - '0';
2326 if (*cptr == ';')
2327 cptr++; /* swallow a trailing ';' */
2328 }
2329 else
2330 {
2331 error(27); /* invalid character constant */
2332 } /* if */
2333 } /* switch */
2334 } /* if */
2335 } /* if */
2336 *lptr = (char *)cptr;
2337 assert(c >= 0 && c < 256);
2338 return c;
2339}
2340
2341/* alpha
2342 *
2343 * Test if character "c" is alphabetic ("a".."z"), an underscore ("_")
2344 * or an "at" sign ("@"). The "@" is an extension to standard C.
2345 */
2346static int
2347alpha(char c)
2348{
2349 return (isalpha(c) || c == '_' || c == PUBLIC_CHAR);
2350}
2351
2352/* alphanum
2353 *
2354 * Test if character "c" is alphanumeric ("a".."z", "0".."9", "_" or "@")
2355 */
2356int
2357alphanum(char c)
2358{
2359 return (alpha(c) || isdigit(c));
2360}
2361
2362/* The local variable table must be searched backwards, so that the deepest
2363 * nesting of local variables is searched first. The simplest way to do
2364 * this is to insert all new items at the head of the list.
2365 * In the global list, the symbols are kept in sorted order, so that the
2366 * public functions are written in sorted order.
2367 */
2368static symbol *
2369add_symbol(symbol * root, symbol * entry, int sort)
2370{
2371 symbol *newsym;
2372
2373 if (sort)
2374 while (root->next && strcmp(entry->name, root->next->name) > 0)
2375 root = root->next;
2376
2377 if (!(newsym = (symbol *)malloc(sizeof(symbol))))
2378 {
2379 error(103);
2380 return NULL;
2381 } /* if */
2382 memcpy(newsym, entry, sizeof(symbol));
2383 newsym->next = root->next;
2384 root->next = newsym;
2385 return newsym;
2386}
2387
2388static void
2389free_symbol(symbol * sym)
2390{
2391 arginfo *arg;
2392
2393 /* free all sub-symbol allocated memory blocks, depending on the
2394 * kind of the symbol
2395 */
2396 assert(sym != NULL);
2397 if (sym->ident == iFUNCTN)
2398 {
2399 /* run through the argument list; "default array" arguments
2400 * must be freed explicitly; the tag list must also be freed */
2401 assert(sym->dim.arglist != NULL);
2402 for (arg = sym->dim.arglist; arg->ident != 0; arg++)
2403 {
2404 if (arg->ident == iREFARRAY && arg->hasdefault)
2405 free(arg->defvalue.array.data);
2406 else if (arg->ident == iVARIABLE
2407 && ((arg->hasdefault & uSIZEOF) != 0
2408 || (arg->hasdefault & uTAGOF) != 0))
2409 free(arg->defvalue.size.symname);
2410 assert(arg->tags != NULL);
2411 free(arg->tags);
2412 } /* for */
2413 free(sym->dim.arglist);
2414 } /* if */
2415 assert(sym->refer != NULL);
2416 free(sym->refer);
2417 free(sym);
2418}
2419
2420void
2421delete_symbol(symbol * root, symbol * sym)
2422{
2423 /* find the symbol and its predecessor
2424 * (this function assumes that you will never delete a symbol that is not
2425 * in the table pointed at by "root")
2426 */
2427 assert(root != sym);
2428 while (root->next != sym)
2429 {
2430 root = root->next;
2431 assert(root != NULL);
2432 } /* while */
2433
2434 /* unlink it, then free it */
2435 root->next = sym->next;
2436 free_symbol(sym);
2437}
2438
2439void
2440delete_symbols(symbol * root, int level, int delete_labels,
2441 int delete_functions)
2442{
2443 symbol *sym;
2444
2445 /* erase only the symbols with a deeper nesting level than the
2446 * specified nesting level */
2447 while (root->next)
2448 {
2449 sym = root->next;
2450 if (sym->compound < level)
2451 break;
2452 if ((delete_labels || sym->ident != iLABEL)
2453 && (delete_functions || sym->ident != iFUNCTN
2454 || (sym->usage & uNATIVE) != 0) && (delete_functions
2455 || sym->ident != iCONSTEXPR
2456 || (sym->usage & uPREDEF) ==
2457 0) && (delete_functions
2458 || (sym->ident !=
2459 iVARIABLE
2460 && sym->ident !=
2461 iARRAY)))
2462 {
2463 root->next = sym->next;
2464 free_symbol(sym);
2465 }
2466 else
2467 {
2468 /* if the function was prototyped, but not implemented in this source,
2469 * mark it as such, so that its use can be flagged
2470 */
2471 if (sym->ident == iFUNCTN && (sym->usage & uDEFINE) == 0)
2472 sym->usage |= uMISSING;
2473 if (sym->ident == iFUNCTN || sym->ident == iVARIABLE
2474 || sym->ident == iARRAY)
2475 sym->usage &= ~uDEFINE; /* clear "defined" flag */
2476 /* for user defined operators, also remove the "prototyped" flag, as
2477 * user-defined operators *must* be declared before use
2478 */
2479 if (sym->ident == iFUNCTN && !isalpha(*sym->name)
2480 && *sym->name != '_' && *sym->name != PUBLIC_CHAR)
2481 sym->usage &= ~uPROTOTYPED;
2482 root = sym; /* skip the symbol */
2483 } /* if */
2484 } /* if */
2485}
2486
2487/* The purpose of the hash is to reduce the frequency of a "name"
2488 * comparison (which is costly). There is little interest in avoiding
2489 * clusters in similar names, which is why this function is plain simple.
2490 */
2491unsigned int
2492namehash(char *name)
2493{
2494 unsigned char *ptr = (unsigned char *)name;
2495 int len = strlen(name);
2496
2497 if (len == 0)
2498 return 0L;
2499 assert(len < 256);
2500 return (len << 24Lu) + (ptr[0] << 16Lu) + (ptr[len - 1] << 8Lu) +
2501 (ptr[len >> 1Lu]);
2502}
2503
2504static symbol *
2505find_symbol(symbol * root, char *name, int fnumber)
2506{
2507 symbol *ptr = root->next;
2508 unsigned long hash = namehash(name);
2509
2510 while (ptr)
2511 {
2512 if (hash == ptr->hash && strcmp(name, ptr->name) == 0
2513 && !ptr->parent && (ptr->fnumber < 0
2514 || ptr->fnumber == fnumber))
2515 return ptr;
2516 ptr = ptr->next;
2517 } /* while */
2518 return NULL;
2519}
2520
2521static symbol *
2522find_symbol_child(symbol * root, symbol * sym)
2523{
2524 symbol *ptr = root->next;
2525
2526 while (ptr)
2527 {
2528 if (ptr->parent == sym)
2529 return ptr;
2530 ptr = ptr->next;
2531 } /* while */
2532 return NULL;
2533}
2534
2535/* Adds "bywhom" to the list of referrers of "entry". Typically,
2536 * bywhom will be the function that uses a variable or that calls
2537 * the function.
2538 */
2539int
2540refer_symbol(symbol * entry, symbol * bywhom)
2541{
2542 int count;
2543
2544 assert(bywhom != NULL); /* it makes no sense to add a "void" referrer */
2545 assert(entry != NULL);
2546 assert(entry->refer != NULL);
2547
2548 /* see if it is already there */
2549 for (count = 0; count < entry->numrefers && entry->refer[count] != bywhom;
2550 count++)
2551 /* nothing */ ;
2552 if (count < entry->numrefers)
2553 {
2554 assert(entry->refer[count] == bywhom);
2555 return TRUE;
2556 } /* if */
2557
2558 /* see if there is an empty spot in the referrer list */
2559 for (count = 0; count < entry->numrefers && entry->refer[count];
2560 count++)
2561 /* nothing */ ;
2562 assert(count <= entry->numrefers);
2563 if (count == entry->numrefers)
2564 {
2565 symbol **refer;
2566 int newsize = 2 * entry->numrefers;
2567
2568 assert(newsize > 0);
2569 /* grow the referrer list */
2570 refer = (symbol **) realloc(entry->refer, newsize * sizeof(symbol *));
2571 if (!refer)
2572 return FALSE; /* insufficient memory */
2573 /* initialize the new entries */
2574 entry->refer = refer;
2575 for (count = entry->numrefers; count < newsize; count++)
2576 entry->refer[count] = NULL;
2577 count = entry->numrefers; /* first empty spot */
2578 entry->numrefers = newsize;
2579 } /* if */
2580
2581 /* add the referrer */
2582 assert(entry->refer[count] == NULL);
2583 entry->refer[count] = bywhom;
2584 return TRUE;
2585}
2586
2587void
2588markusage(symbol * sym, int usage)
2589{
2590 sym->usage |= (char)usage;
2591 /* check if (global) reference must be added to the symbol */
2592 if ((usage & (uREAD | uWRITTEN)) != 0)
2593 {
2594 /* only do this for global symbols */
2595 if (sym->vclass == sGLOBAL)
2596 {
2597 /* "curfunc" should always be valid, since statements may not occurs
2598 * outside functions; in the case of syntax errors, however, the
2599 * compiler may arrive through this function
2600 */
2601 if (curfunc)
2602 refer_symbol(sym, curfunc);
2603 } /* if */
2604 } /* if */
2605}
2606
2607/* findglb
2608 *
2609 * Returns a pointer to the global symbol (if found) or NULL (if not found)
2610 */
2611symbol *
2612findglb(char *name)
2613{
2614 return find_symbol(&glbtab, name, fcurrent);
2615}
2616
2617/* findloc
2618 *
2619 * Returns a pointer to the local symbol (if found) or NULL (if not found).
2620 * See add_symbol() how the deepest nesting level is searched first.
2621 */
2622symbol *
2623findloc(char *name)
2624{
2625 return find_symbol(&loctab, name, -1);
2626}
2627
2628symbol *
2629findconst(char *name)
2630{
2631 symbol *sym;
2632
2633 sym = find_symbol(&loctab, name, -1); /* try local symbols first */
2634 if (!sym || sym->ident != iCONSTEXPR) /* not found, or not a constant */
2635 sym = find_symbol(&glbtab, name, fcurrent);
2636 if (!sym || sym->ident != iCONSTEXPR)
2637 return NULL;
2638 assert(sym->parent == NULL); /* constants have no hierarchy */
2639 return sym;
2640}
2641
2642symbol *
2643finddepend(symbol * parent)
2644{
2645 symbol *sym;
2646
2647 sym = find_symbol_child(&loctab, parent); /* try local symbols first */
2648 if (!sym) /* not found */
2649 sym = find_symbol_child(&glbtab, parent);
2650 return sym;
2651}
2652
2653/* addsym
2654 *
2655 * Adds a symbol to the symbol table (either global or local variables,
2656 * or global and local constants).
2657 */
2658symbol *
2659addsym(char *name, cell addr, int ident, int vclass, int tag, int usage)
2660{
2661 symbol entry, **refer;
2662
2663 /* global variables/constants/functions may only be defined once */
2664 assert(!(ident == iFUNCTN || ident == iCONSTEXPR) || vclass != sGLOBAL
2665 || findglb(name) == NULL);
2666 /* labels may only be defined once */
2667 assert(ident != iLABEL || findloc(name) == NULL);
2668
2669 /* create an empty referrer list */
2670 if (!(refer = (symbol **)malloc(sizeof(symbol *))))
2671 {
2672 error(103); /* insufficient memory */
2673 return NULL;
2674 } /* if */
2675 *refer = NULL;
2676
2677 /* first fill in the entry */
2678 strcpy(entry.name, name);
2679 entry.hash = namehash(name);
2680 entry.addr = addr;
2681 entry.vclass = (char)vclass;
2682 entry.ident = (char)ident;
2683 entry.tag = tag;
2684 entry.usage = (char)usage;
2685 entry.compound = 0; /* may be overridden later */
2686 entry.fnumber = -1; /* assume global visibility (ignored for local symbols) */
2687 entry.numrefers = 1;
2688 entry.refer = refer;
2689 entry.parent = NULL;
2690
2691 /* then insert it in the list */
2692 if (vclass == sGLOBAL)
2693 return add_symbol(&glbtab, &entry, TRUE);
2694 else
2695 return add_symbol(&loctab, &entry, FALSE);
2696}
2697
2698symbol *
2699addvariable(char *name, cell addr, int ident, int vclass, int tag,
2700 int dim[], int numdim, int idxtag[])
2701{
2702 symbol *sym, *parent, *top;
2703 int level;
2704
2705 /* global variables may only be defined once */
2706 assert(vclass != sGLOBAL || (sym = findglb(name)) == NULL
2707 || (sym->usage & uDEFINE) == 0);
2708
2709 if (ident == iARRAY || ident == iREFARRAY)
2710 {
2711 parent = NULL;
2712 sym = NULL; /* to avoid a compiler warning */
2713 for (level = 0; level < numdim; level++)
2714 {
2715 top = addsym(name, addr, ident, vclass, tag, uDEFINE);
2716 top->dim.array.length = dim[level];
2717 top->dim.array.level = (short)(numdim - level - 1);
2718 top->x.idxtag = idxtag[level];
2719 top->parent = parent;
2720 parent = top;
2721 if (level == 0)
2722 sym = top;
2723 } /* for */
2724 }
2725 else
2726 {
2727 sym = addsym(name, addr, ident, vclass, tag, uDEFINE);
2728 } /* if */
2729 return sym;
2730}
2731
2732/* getlabel
2733 *
2734 * Return next available internal label number.
2735 */
2736int
2737getlabel(void)
2738{
2739 return labnum++;
2740}
2741
2742/* itoh
2743 *
2744 * Converts a number to a hexadecimal string and returns a pointer to that
2745 * string.
2746 */
2747char *
2748itoh(ucell val)
2749{
2750 static char itohstr[15]; /* hex number is 10 characters long at most */
2751 char *ptr;
2752 int i, nibble[8]; /* a 32-bit hexadecimal cell has 8 nibbles */
2753 int max;
2754
2755#if defined(BIT16)
2756 max = 4;
2757#else
2758 max = 8;
2759#endif
2760 ptr = itohstr;
2761 for (i = 0; i < max; i += 1)
2762 {
2763 nibble[i] = (int)(val & 0x0f); /* nibble 0 is lowest nibble */
2764 val >>= 4;
2765 } /* endfor */
2766 i = max - 1;
2767 while (nibble[i] == 0 && i > 0) /* search for highest non-zero nibble */
2768 i -= 1;
2769 while (i >= 0)
2770 {
2771 if (nibble[i] >= 10)
2772 *ptr++ = (char)('a' + (nibble[i] - 10));
2773 else
2774 *ptr++ = (char)('0' + nibble[i]);
2775 i -= 1;
2776 } /* while */
2777 *ptr = '\0'; /* and a zero-terminator */
2778 return itohstr;
2779}
diff --git a/libraries/embryo/src/bin/embryo_cc_sc3.c b/libraries/embryo/src/bin/embryo_cc_sc3.c
new file mode 100644
index 0000000..99b24ed
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc3.c
@@ -0,0 +1,2438 @@
1/* Small compiler - Recursive descend expresion parser
2 *
3 * Copyright (c) ITB CompuPhase, 1997-2003
4 *
5 * This software is provided "as-is", without any express or implied warranty.
6 * In no event will the authors be held liable for any damages arising from
7 * the use of this software.
8 *
9 * Permission is granted to anyone to use this software for any purpose,
10 * including commercial applications, and to alter it and redistribute it
11 * freely, subject to the following restrictions:
12 *
13 * 1. The origin of this software must not be misrepresented; you must not
14 * claim that you wrote the original software. If you use this software in
15 * a product, an acknowledgment in the product documentation would be
16 * appreciated but is not required.
17 * 2. Altered source versions must be plainly marked as such, and must not be
18 * misrepresented as being the original software.
19 * 3. This notice may not be removed or altered from any source distribution.
20 *
21 * Version: $Id: embryo_cc_sc3.c 52451 2010-09-19 03:00:12Z raster $
22 */
23
24
25#ifdef HAVE_CONFIG_H
26# include <config.h>
27#endif
28
29#include <assert.h>
30#include <stdio.h>
31#include <limits.h> /* for PATH_MAX */
32#include <string.h>
33
34#include "embryo_cc_sc.h"
35
36static int skim(int *opstr, void (*testfunc) (int), int dropval,
37 int endval, int (*hier) (value *), value * lval);
38static void dropout(int lvalue, void (*testfunc) (int val), int exit1,
39 value * lval);
40static int plnge(int *opstr, int opoff, int (*hier) (value * lval),
41 value * lval, char *forcetag, int chkbitwise);
42static int plnge1(int (*hier) (value * lval), value * lval);
43static void plnge2(void (*oper) (void),
44 int (*hier) (value * lval),
45 value * lval1, value * lval2);
46static cell calc(cell left, void (*oper) (), cell right,
47 char *boolresult);
48static int hier13(value * lval);
49static int hier12(value * lval);
50static int hier11(value * lval);
51static int hier10(value * lval);
52static int hier9(value * lval);
53static int hier8(value * lval);
54static int hier7(value * lval);
55static int hier6(value * lval);
56static int hier5(value * lval);
57static int hier4(value * lval);
58static int hier3(value * lval);
59static int hier2(value * lval);
60static int hier1(value * lval1);
61static int primary(value * lval);
62static void clear_value(value * lval);
63static void callfunction(symbol * sym);
64static int dbltest(void (*oper) (), value * lval1, value * lval2);
65static int commutative(void (*oper) ());
66static int constant(value * lval);
67
68static char lastsymbol[sNAMEMAX + 1]; /* name of last function/variable */
69static int bitwise_opercount; /* count of bitwise operators in an expression */
70
71/* Function addresses of binary operators for signed operations */
72static void (*op1[17]) (void) =
73{
74 os_mult, os_div, os_mod, /* hier3, index 0 */
75 ob_add, ob_sub, /* hier4, index 3 */
76 ob_sal, os_sar, ou_sar, /* hier5, index 5 */
77 ob_and, /* hier6, index 8 */
78 ob_xor, /* hier7, index 9 */
79 ob_or, /* hier8, index 10 */
80 os_le, os_ge, os_lt, os_gt, /* hier9, index 11 */
81 ob_eq, ob_ne, /* hier10, index 15 */
82};
83/* These two functions are defined because the functions inc() and dec() in
84 * SC4.C have a different prototype than the other code generation functions.
85 * The arrays for user-defined functions use the function pointers for
86 * identifying what kind of operation is requested; these functions must all
87 * have the same prototype. As inc() and dec() are special cases already, it
88 * is simplest to add two "do-nothing" functions.
89 */
90static void
91user_inc(void)
92{
93}
94static void
95user_dec(void)
96{
97}
98
99/*
100 * Searches for a binary operator a list of operators. The list is stored in
101 * the array "list". The last entry in the list should be set to 0.
102 *
103 * The index of an operator in "list" (if found) is returned in "opidx". If
104 * no operator is found, nextop() returns 0.
105 */
106static int
107nextop(int *opidx, int *list)
108{
109 *opidx = 0;
110 while (*list)
111 {
112 if (matchtoken(*list))
113 {
114 return TRUE; /* found! */
115 }
116 else
117 {
118 list += 1;
119 *opidx += 1;
120 } /* if */
121 } /* while */
122 return FALSE; /* entire list scanned, nothing found */
123}
124
125int
126check_userop(void (*oper) (void), int tag1, int tag2, int numparam,
127 value * lval, int *resulttag)
128{
129 static char *binoperstr[] = { "*", "/", "%", "+", "-", "", "", "",
130 "", "", "", "<=", ">=", "<", ">", "==", "!="
131 };
132 static int binoper_savepri[] =
133 { FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
134 FALSE, FALSE, FALSE, FALSE, FALSE,
135 TRUE, TRUE, TRUE, TRUE, FALSE, FALSE
136 };
137 static char *unoperstr[] = { "!", "-", "++", "--" };
138 static void (*unopers[]) (void) =
139 {
140 lneg, neg, user_inc, user_dec};
141 char opername[4] = "", symbolname[sNAMEMAX + 1];
142 int i, swapparams, savepri, savealt;
143 int paramspassed;
144 symbol *sym;
145
146 /* since user-defined operators on untagged operands are forbidden, we have
147 * a quick exit.
148 */
149 assert(numparam == 1 || numparam == 2);
150 if (tag1 == 0 && (numparam == 1 || tag2 == 0))
151 return FALSE;
152
153 savepri = savealt = FALSE;
154 /* find the name with the operator */
155 if (numparam == 2)
156 {
157 if (!oper)
158 {
159 /* assignment operator: a special case */
160 strcpy(opername, "=");
161 if (lval
162 && (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR))
163 savealt = TRUE;
164 }
165 else
166 {
167 assert((sizeof binoperstr / sizeof binoperstr[0]) ==
168 (sizeof op1 / sizeof op1[0]));
169 for (i = 0; i < (int)(sizeof op1 / sizeof op1[0]); i++)
170 {
171 if (oper == op1[i])
172 {
173 strcpy(opername, binoperstr[i]);
174 savepri = binoper_savepri[i];
175 break;
176 } /* if */
177 } /* for */
178 } /* if */
179 }
180 else
181 {
182 assert(oper != NULL);
183 assert(numparam == 1);
184 /* try a select group of unary operators */
185 assert((sizeof unoperstr / sizeof unoperstr[0]) ==
186 (sizeof unopers / sizeof unopers[0]));
187 if (opername[0] == '\0')
188 {
189 for (i = 0; i < (int)(sizeof unopers / sizeof unopers[0]); i++)
190 {
191 if (oper == unopers[i])
192 {
193 strcpy(opername, unoperstr[i]);
194 break;
195 } /* if */
196 } /* for */
197 } /* if */
198 } /* if */
199 /* if not found, quit */
200 if (opername[0] == '\0')
201 return FALSE;
202
203 /* create a symbol name from the tags and the operator name */
204 assert(numparam == 1 || numparam == 2);
205 operator_symname(symbolname, opername, tag1, tag2, numparam, tag2);
206 swapparams = FALSE;
207 sym = findglb(symbolname);
208 if (!sym /*|| (sym->usage & uDEFINE)==0 */ )
209 { /* ??? should not check uDEFINE; first pass clears these bits */
210 /* check for commutative operators */
211 if (tag1 == tag2 || !oper || !commutative(oper))
212 return FALSE; /* not commutative, cannot swap operands */
213 /* if arrived here, the operator is commutative and the tags are different,
214 * swap tags and try again
215 */
216 assert(numparam == 2); /* commutative operator must be a binary operator */
217 operator_symname(symbolname, opername, tag2, tag1, numparam, tag1);
218 swapparams = TRUE;
219 sym = findglb(symbolname);
220 if (!sym /*|| (sym->usage & uDEFINE)==0 */ )
221 return FALSE;
222 } /* if */
223
224 /* check existence and the proper declaration of this function */
225 if ((sym->usage & uMISSING) != 0 || (sym->usage & uPROTOTYPED) == 0)
226 {
227 char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
228
229 funcdisplayname(symname, sym->name);
230 if ((sym->usage & uMISSING) != 0)
231 error(4, symname); /* function not defined */
232 if ((sym->usage & uPROTOTYPED) == 0)
233 error(71, symname); /* operator must be declared before use */
234 } /* if */
235
236 /* we don't want to use the redefined operator in the function that
237 * redefines the operator itself, otherwise the snippet below gives
238 * an unexpected recursion:
239 * fixed:operator+(fixed:a, fixed:b)
240 * return a + b
241 */
242 if (sym == curfunc)
243 return FALSE;
244
245 /* for increment and decrement operators, the symbol must first be loaded
246 * (and stored back afterwards)
247 */
248 if (oper == user_inc || oper == user_dec)
249 {
250 assert(!savepri);
251 assert(lval != NULL);
252 if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)
253 push1(); /* save current address in PRI */
254 rvalue(lval); /* get the symbol's value in PRI */
255 } /* if */
256
257 assert(!savepri || !savealt); /* either one MAY be set, but not both */
258 if (savepri)
259 {
260 /* the chained comparison operators require that the ALT register is
261 * unmodified, so we save it here; actually, we save PRI because the normal
262 * instruction sequence (without user operator) swaps PRI and ALT
263 */
264 push1(); /* right-hand operand is in PRI */
265 }
266 else if (savealt)
267 {
268 /* for the assignment operator, ALT may contain an address at which the
269 * result must be stored; this address must be preserved across the
270 * call
271 */
272 assert(lval != NULL); /* this was checked earlier */
273 assert(lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR); /* checked earlier */
274 push2();
275 } /* if */
276
277 /* push parameters, call the function */
278 paramspassed = (!oper) ? 1 : numparam;
279 switch (paramspassed)
280 {
281 case 1:
282 push1();
283 break;
284 case 2:
285 /* note that 1) a function expects that the parameters are pushed
286 * in reversed order, and 2) the left operand is in the secondary register
287 * and the right operand is in the primary register */
288 if (swapparams)
289 {
290 push2();
291 push1();
292 }
293 else
294 {
295 push1();
296 push2();
297 } /* if */
298 break;
299 default:
300 assert(0);
301 } /* switch */
302 endexpr(FALSE); /* mark the end of a sub-expression */
303 pushval((cell) paramspassed * sizeof(cell));
304 assert(sym->ident == iFUNCTN);
305 ffcall(sym, paramspassed);
306 if (sc_status != statSKIP)
307 markusage(sym, uREAD); /* do not mark as "used" when this call itself is skipped */
308 if (sym->x.lib)
309 sym->x.lib->value += 1; /* increment "usage count" of the library */
310 sideeffect = TRUE; /* assume functions carry out a side-effect */
311 assert(resulttag != NULL);
312 *resulttag = sym->tag; /* save tag of the called function */
313
314 if (savepri || savealt)
315 pop2(); /* restore the saved PRI/ALT that into ALT */
316 if (oper == user_inc || oper == user_dec)
317 {
318 assert(lval != NULL);
319 if (lval->ident == iARRAYCELL || lval->ident == iARRAYCHAR)
320 pop2(); /* restore address (in ALT) */
321 store(lval); /* store PRI in the symbol */
322 moveto1(); /* make sure PRI is restored on exit */
323 } /* if */
324 return TRUE;
325}
326
327int
328matchtag(int formaltag, int actualtag, int allowcoerce)
329{
330 if (formaltag != actualtag)
331 {
332 /* if the formal tag is zero and the actual tag is not "fixed", the actual
333 * tag is "coerced" to zero
334 */
335 if (!allowcoerce || formaltag != 0 || (actualtag & FIXEDTAG) != 0)
336 return FALSE;
337 } /* if */
338 return TRUE;
339}
340
341/*
342 * The AMX pseudo-processor has no direct support for logical (boolean)
343 * operations. These have to be done via comparing and jumping. Since we are
344 * already jumping through the code, we might as well implement an "early
345 * drop-out" evaluation (also called "short-circuit"). This conforms to
346 * standard C:
347 *
348 * expr1 || expr2 expr2 will only be evaluated if expr1 is false.
349 * expr1 && expr2 expr2 will only be evaluated if expr1 is true.
350 *
351 * expr1 || expr2 && expr3 expr2 will only be evaluated if expr1 is false
352 * and expr3 will only be evaluated if expr1 is
353 * false and expr2 is true.
354 *
355 * Code generation for the last example proceeds thus:
356 *
357 * evaluate expr1
358 * operator || found
359 * jump to "l1" if result of expr1 not equal to 0
360 * evaluate expr2
361 * -> operator && found; skip to higher level in hierarchy diagram
362 * jump to "l2" if result of expr2 equal to 0
363 * evaluate expr3
364 * jump to "l2" if result of expr3 equal to 0
365 * set expression result to 1 (true)
366 * jump to "l3"
367 * l2: set expression result to 0 (false)
368 * l3:
369 * <- drop back to previous hierarchy level
370 * jump to "l1" if result of expr2 && expr3 not equal to 0
371 * set expression result to 0 (false)
372 * jump to "l4"
373 * l1: set expression result to 1 (true)
374 * l4:
375 *
376 */
377
378/* Skim over terms adjoining || and && operators
379 * dropval The value of the expression after "dropping out". An "or" drops
380 * out when the left hand is TRUE, so dropval must be 1 on "or"
381 * expressions.
382 * endval The value of the expression when no expression drops out. In an
383 * "or" expression, this happens when both the left hand and the
384 * right hand are FALSE, so endval must be 0 for "or" expressions.
385 */
386static int
387skim(int *opstr, void (*testfunc) (int), int dropval, int endval,
388 int (*hier) (value *), value * lval)
389{
390 int lvalue, hits, droplab, endlab, opidx;
391 int allconst;
392 cell constval;
393 int index;
394 cell cidx;
395
396 stgget(&index, &cidx); /* mark position in code generator */
397 hits = FALSE; /* no logical operators "hit" yet */
398 allconst = TRUE; /* assume all values "const" */
399 constval = 0;
400 droplab = 0; /* to avoid a compiler warning */
401 for (;;)
402 {
403 lvalue = plnge1(hier, lval); /* evaluate left expression */
404
405 allconst = allconst && (lval->ident == iCONSTEXPR);
406 if (allconst)
407 {
408 if (hits)
409 {
410 /* one operator was already found */
411 if (testfunc == jmp_ne0)
412 lval->constval = lval->constval || constval;
413 else
414 lval->constval = lval->constval && constval;
415 } /* if */
416 constval = lval->constval; /* save result accumulated so far */
417 } /* if */
418
419 if (nextop(&opidx, opstr))
420 {
421 if (!hits)
422 {
423 /* this is the first operator in the list */
424 hits = TRUE;
425 droplab = getlabel();
426 } /* if */
427 dropout(lvalue, testfunc, droplab, lval);
428 }
429 else if (hits)
430 { /* no (more) identical operators */
431 dropout(lvalue, testfunc, droplab, lval); /* found at least one operator! */
432 const1(endval);
433 jumplabel(endlab = getlabel());
434 setlabel(droplab);
435 const1(dropval);
436 setlabel(endlab);
437 lval->sym = NULL;
438 lval->tag = 0;
439 if (allconst)
440 {
441 lval->ident = iCONSTEXPR;
442 lval->constval = constval;
443 stgdel(index, cidx); /* scratch generated code and calculate */
444 }
445 else
446 {
447 lval->ident = iEXPRESSION;
448 lval->constval = 0;
449 } /* if */
450 return FALSE;
451 }
452 else
453 {
454 return lvalue; /* none of the operators in "opstr" were found */
455 } /* if */
456
457 } /* while */
458}
459
460/*
461 * Reads into the primary register the variable pointed to by lval if
462 * plunging through the hierarchy levels detected an lvalue. Otherwise
463 * if a constant was detected, it is loaded. If there is no constant and
464 * no lvalue, the primary register must already contain the expression
465 * result.
466 *
467 * After that, the compare routines "jmp_ne0" or "jmp_eq0" are called, which
468 * compare the primary register against 0, and jump to the "early drop-out"
469 * label "exit1" if the condition is true.
470 */
471static void
472dropout(int lvalue, void (*testfunc) (int val), int exit1, value * lval)
473{
474 if (lvalue)
475 rvalue(lval);
476 else if (lval->ident == iCONSTEXPR)
477 const1(lval->constval);
478 (*testfunc) (exit1);
479}
480
481static void
482checkfunction(value * lval)
483{
484 symbol *sym = lval->sym;
485
486 if (!sym || (sym->ident != iFUNCTN && sym->ident != iREFFUNC))
487 return; /* no known symbol, or not a function result */
488
489 if ((sym->usage & uDEFINE) != 0)
490 {
491 /* function is defined, can now check the return value (but make an
492 * exception for directly recursive functions)
493 */
494 if (sym != curfunc && (sym->usage & uRETVALUE) == 0)
495 {
496 char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
497
498 funcdisplayname(symname, sym->name);
499 error(209, symname); /* function should return a value */
500 } /* if */
501 }
502 else
503 {
504 /* function not yet defined, set */
505 sym->usage |= uRETVALUE; /* make sure that a future implementation of
506 * the function uses "return <value>" */
507 } /* if */
508}
509
510/*
511 * Plunge to a lower level
512 */
513static int
514plnge(int *opstr, int opoff, int (*hier) (value * lval), value * lval,
515 char *forcetag, int chkbitwise)
516{
517 int lvalue, opidx;
518 int count;
519 value lval2 = { NULL, 0, 0, 0, 0, NULL };
520
521 lvalue = plnge1(hier, lval);
522 if (nextop(&opidx, opstr) == 0)
523 return lvalue; /* no operator in "opstr" found */
524 if (lvalue)
525 rvalue(lval);
526 count = 0;
527 do
528 {
529 if (chkbitwise && count++ > 0 && bitwise_opercount != 0)
530 error(212);
531 opidx += opoff; /* add offset to index returned by nextop() */
532 plnge2(op1[opidx], hier, lval, &lval2);
533 if (op1[opidx] == ob_and || op1[opidx] == ob_or)
534 bitwise_opercount++;
535 if (forcetag)
536 lval->tag = sc_addtag(forcetag);
537 }
538 while (nextop(&opidx, opstr)); /* do */
539 return FALSE; /* result of expression is not an lvalue */
540}
541
542/* plnge_rel
543 *
544 * Binary plunge to lower level; this is very simular to plnge, but
545 * it has special code generation sequences for chained operations.
546 */
547static int
548plnge_rel(int *opstr, int opoff, int (*hier) (value * lval), value * lval)
549{
550 int lvalue, opidx;
551 value lval2 = { NULL, 0, 0, 0, 0, NULL };
552 int count;
553
554 /* this function should only be called for relational operators */
555 assert(op1[opoff] == os_le);
556 lvalue = plnge1(hier, lval);
557 if (nextop(&opidx, opstr) == 0)
558 return lvalue; /* no operator in "opstr" found */
559 if (lvalue)
560 rvalue(lval);
561 count = 0;
562 lval->boolresult = TRUE;
563 do
564 {
565 /* same check as in plnge(), but "chkbitwise" is always TRUE */
566 if (count > 0 && bitwise_opercount != 0)
567 error(212);
568 if (count > 0)
569 {
570 relop_prefix();
571 *lval = lval2; /* copy right hand expression of the previous iteration */
572 } /* if */
573 opidx += opoff;
574 plnge2(op1[opidx], hier, lval, &lval2);
575 if (count++ > 0)
576 relop_suffix();
577 }
578 while (nextop(&opidx, opstr)); /* enddo */
579 lval->constval = lval->boolresult;
580 lval->tag = sc_addtag("bool"); /* force tag to be "bool" */
581 return FALSE; /* result of expression is not an lvalue */
582}
583
584/* plnge1
585 *
586 * Unary plunge to lower level
587 * Called by: skim(), plnge(), plnge2(), plnge_rel(), hier14() and hier13()
588 */
589static int
590plnge1(int (*hier) (value * lval), value * lval)
591{
592 int lvalue, index;
593 cell cidx;
594
595 stgget(&index, &cidx); /* mark position in code generator */
596 lvalue = (*hier) (lval);
597 if (lval->ident == iCONSTEXPR)
598 stgdel(index, cidx); /* load constant later */
599 return lvalue;
600}
601
602/* plnge2
603 *
604 * Binary plunge to lower level
605 * Called by: plnge(), plnge_rel(), hier14() and hier1()
606 */
607static void
608plnge2(void (*oper) (void),
609 int (*hier) (value * lval), value * lval1, value * lval2)
610{
611 int index;
612 cell cidx;
613
614 stgget(&index, &cidx); /* mark position in code generator */
615 if (lval1->ident == iCONSTEXPR)
616 { /* constant on left side; it is not yet loaded */
617 if (plnge1(hier, lval2))
618 rvalue(lval2); /* load lvalue now */
619 else if (lval2->ident == iCONSTEXPR)
620 const1(lval2->constval << dbltest(oper, lval2, lval1));
621 const2(lval1->constval << dbltest(oper, lval2, lval1));
622 /* ^ doubling of constants operating on integer addresses */
623 /* is restricted to "add" and "subtract" operators */
624 }
625 else
626 { /* non-constant on left side */
627 push1();
628 if (plnge1(hier, lval2))
629 rvalue(lval2);
630 if (lval2->ident == iCONSTEXPR)
631 { /* constant on right side */
632 if (commutative(oper))
633 { /* test for commutative operators */
634 value lvaltmp = { NULL, 0, 0, 0, 0, NULL };
635 stgdel(index, cidx); /* scratch push1() and constant fetch (then
636 * fetch the constant again */
637 const2(lval2->constval << dbltest(oper, lval1, lval2));
638 /* now, the primary register has the left operand and the secondary
639 * register the right operand; swap the "lval" variables so that lval1
640 * is associated with the secondary register and lval2 with the
641 * primary register, as is the "normal" case.
642 */
643 lvaltmp = *lval1;
644 *lval1 = *lval2;
645 *lval2 = lvaltmp;
646 }
647 else
648 {
649 const1(lval2->constval << dbltest(oper, lval1, lval2));
650 pop2(); /* pop result of left operand into secondary register */
651 } /* if */
652 }
653 else
654 { /* non-constants on both sides */
655 pop2();
656 if (dbltest(oper, lval1, lval2))
657 cell2addr(); /* double primary register */
658 if (dbltest(oper, lval2, lval1))
659 cell2addr_alt(); /* double secondary register */
660 } /* if */
661 } /* if */
662 if (oper)
663 {
664 /* If used in an expression, a function should return a value.
665 * If the function has been defined, we can check this. If the
666 * function was not defined, we can set this requirement (so that
667 * a future function definition can check this bit.
668 */
669 checkfunction(lval1);
670 checkfunction(lval2);
671 if (lval1->ident == iARRAY || lval1->ident == iREFARRAY)
672 {
673 char *ptr =
674 (lval1->sym) ? lval1->sym->name : "-unknown-";
675 error(33, ptr); /* array must be indexed */
676 }
677 else if (lval2->ident == iARRAY || lval2->ident == iREFARRAY)
678 {
679 char *ptr =
680 (lval2->sym) ? lval2->sym->name : "-unknown-";
681 error(33, ptr); /* array must be indexed */
682 } /* if */
683 /* ??? ^^^ should do same kind of error checking with functions */
684
685 /* check whether an "operator" function is defined for the tag names
686 * (a constant expression cannot be optimized in that case)
687 */
688 if (check_userop(oper, lval1->tag, lval2->tag, 2, NULL, &lval1->tag))
689 {
690 lval1->ident = iEXPRESSION;
691 lval1->constval = 0;
692 }
693 else if (lval1->ident == iCONSTEXPR && lval2->ident == iCONSTEXPR)
694 {
695 /* only constant expression if both constant */
696 stgdel(index, cidx); /* scratch generated code and calculate */
697 if (!matchtag(lval1->tag, lval2->tag, FALSE))
698 error(213); /* tagname mismatch */
699 lval1->constval =
700 calc(lval1->constval, oper, lval2->constval,
701 &lval1->boolresult);
702 }
703 else
704 {
705 if (!matchtag(lval1->tag, lval2->tag, FALSE))
706 error(213); /* tagname mismatch */
707 (*oper) (); /* do the (signed) operation */
708 lval1->ident = iEXPRESSION;
709 } /* if */
710 } /* if */
711}
712
713static cell
714truemodulus(cell a, cell b)
715{
716 return (a % b + b) % b;
717}
718
719static cell
720calc(cell left, void (*oper) (), cell right, char *boolresult)
721{
722 if (oper == ob_or)
723 return (left | right);
724 else if (oper == ob_xor)
725 return (left ^ right);
726 else if (oper == ob_and)
727 return (left & right);
728 else if (oper == ob_eq)
729 return (left == right);
730 else if (oper == ob_ne)
731 return (left != right);
732 else if (oper == os_le)
733 return *boolresult &= (char)(left <= right), right;
734 else if (oper == os_ge)
735 return *boolresult &= (char)(left >= right), right;
736 else if (oper == os_lt)
737 return *boolresult &= (char)(left < right), right;
738 else if (oper == os_gt)
739 return *boolresult &= (char)(left > right), right;
740 else if (oper == os_sar)
741 return (left >> (int)right);
742 else if (oper == ou_sar)
743 return ((ucell) left >> (ucell) right);
744 else if (oper == ob_sal)
745 return ((ucell) left << (int)right);
746 else if (oper == ob_add)
747 return (left + right);
748 else if (oper == ob_sub)
749 return (left - right);
750 else if (oper == os_mult)
751 return (left * right);
752 else if (oper == os_div)
753 return (left - truemodulus(left, right)) / right;
754 else if (oper == os_mod)
755 return truemodulus(left, right);
756 else
757 error(29); /* invalid expression, assumed 0 (this should never occur) */
758 return 0;
759}
760
761int
762expression(int *constant, cell * val, int *tag, int chkfuncresult)
763{
764 value lval = { NULL, 0, 0, 0, 0, NULL };
765
766 if (hier14(&lval))
767 rvalue(&lval);
768 if (lval.ident == iCONSTEXPR)
769 { /* constant expression */
770 *constant = TRUE;
771 *val = lval.constval;
772 }
773 else
774 {
775 *constant = FALSE;
776 *val = 0;
777 } /* if */
778 if (tag)
779 *tag = lval.tag;
780 if (chkfuncresult)
781 checkfunction(&lval);
782 return lval.ident;
783}
784
785static cell
786array_totalsize(symbol * sym)
787{
788 cell length;
789
790 assert(sym != NULL);
791 assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
792 length = sym->dim.array.length;
793 if (sym->dim.array.level > 0)
794 {
795 cell sublength = array_totalsize(finddepend(sym));
796
797 if (sublength > 0)
798 length = length + length * sublength;
799 else
800 length = 0;
801 } /* if */
802 return length;
803}
804
805static cell
806array_levelsize(symbol * sym, int level)
807{
808 assert(sym != NULL);
809 assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
810 assert(level <= sym->dim.array.level);
811 while (level-- > 0)
812 {
813 sym = finddepend(sym);
814 assert(sym != NULL);
815 } /* if */
816 return sym->dim.array.length;
817}
818
819/* hier14
820 *
821 * Lowest hierarchy level (except for the , operator).
822 *
823 * Global references: intest (referred to only)
824 */
825int
826hier14(value * lval1)
827{
828 int lvalue;
829 value lval2 = { NULL, 0, 0, 0, 0, NULL };
830 value lval3 = { NULL, 0, 0, 0, 0, NULL };
831 void (*oper) (void);
832 int tok, level, i;
833 cell val;
834 char *st;
835 int bwcount;
836 cell arrayidx1[sDIMEN_MAX], arrayidx2[sDIMEN_MAX]; /* last used array indices */
837 cell *org_arrayidx;
838
839 bwcount = bitwise_opercount;
840 bitwise_opercount = 0;
841 for (i = 0; i < sDIMEN_MAX; i++)
842 arrayidx1[i] = arrayidx2[i] = 0;
843 org_arrayidx = lval1->arrayidx; /* save current pointer, to reset later */
844 if (!lval1->arrayidx)
845 lval1->arrayidx = arrayidx1;
846 lvalue = plnge1(hier13, lval1);
847 if (lval1->ident != iARRAYCELL && lval1->ident != iARRAYCHAR)
848 lval1->arrayidx = NULL;
849 if (lval1->ident == iCONSTEXPR) /* load constant here */
850 const1(lval1->constval);
851 tok = lex(&val, &st);
852 switch (tok)
853 {
854 case taOR:
855 oper = ob_or;
856 break;
857 case taXOR:
858 oper = ob_xor;
859 break;
860 case taAND:
861 oper = ob_and;
862 break;
863 case taADD:
864 oper = ob_add;
865 break;
866 case taSUB:
867 oper = ob_sub;
868 break;
869 case taMULT:
870 oper = os_mult;
871 break;
872 case taDIV:
873 oper = os_div;
874 break;
875 case taMOD:
876 oper = os_mod;
877 break;
878 case taSHRU:
879 oper = ou_sar;
880 break;
881 case taSHR:
882 oper = os_sar;
883 break;
884 case taSHL:
885 oper = ob_sal;
886 break;
887 case '=': /* simple assignment */
888 oper = NULL;
889 if (intest)
890 error(211); /* possibly unintended assignment */
891 break;
892 default:
893 lexpush();
894 bitwise_opercount = bwcount;
895 lval1->arrayidx = org_arrayidx; /* restore array index pointer */
896 return lvalue;
897 } /* switch */
898
899 /* if we get here, it was an assignment; first check a few special cases
900 * and then the general */
901 if (lval1->ident == iARRAYCHAR)
902 {
903 /* special case, assignment to packed character in a cell is permitted */
904 lvalue = TRUE;
905 }
906 else if (lval1->ident == iARRAY || lval1->ident == iREFARRAY)
907 {
908 /* array assignment is permitted too (with restrictions) */
909 if (oper)
910 return error(23); /* array assignment must be simple assigment */
911 assert(lval1->sym != NULL);
912 if (array_totalsize(lval1->sym) == 0)
913 return error(46, lval1->sym->name); /* unknown array size */
914 lvalue = TRUE;
915 } /* if */
916
917 /* operand on left side of assignment must be lvalue */
918 if (!lvalue)
919 return error(22); /* must be lvalue */
920 /* may not change "constant" parameters */
921 assert(lval1->sym != NULL);
922 if ((lval1->sym->usage & uCONST) != 0)
923 return error(22); /* assignment to const argument */
924 lval3 = *lval1; /* save symbol to enable storage of expresion result */
925 lval1->arrayidx = org_arrayidx; /* restore array index pointer */
926 if (lval1->ident == iARRAYCELL || lval1->ident == iARRAYCHAR
927 || lval1->ident == iARRAY || lval1->ident == iREFARRAY)
928 {
929 /* if indirect fetch: save PRI (cell address) */
930 if (oper)
931 {
932 push1();
933 rvalue(lval1);
934 } /* if */
935 lval2.arrayidx = arrayidx2;
936 plnge2(oper, hier14, lval1, &lval2);
937 if (lval2.ident != iARRAYCELL && lval2.ident != iARRAYCHAR)
938 lval2.arrayidx = NULL;
939 if (oper)
940 pop2();
941 if (!oper && lval3.arrayidx && lval2.arrayidx
942 && lval3.ident == lval2.ident && lval3.sym == lval2.sym)
943 {
944 int same = TRUE;
945
946 assert(lval3.arrayidx == arrayidx1);
947 assert(lval2.arrayidx == arrayidx2);
948 for (i = 0; i < sDIMEN_MAX; i++)
949 same = same && (lval3.arrayidx[i] == lval2.arrayidx[i]);
950 if (same)
951 error(226, lval3.sym->name); /* self-assignment */
952 } /* if */
953 }
954 else
955 {
956 if (oper)
957 {
958 rvalue(lval1);
959 plnge2(oper, hier14, lval1, &lval2);
960 }
961 else
962 {
963 /* if direct fetch and simple assignment: no "push"
964 * and "pop" needed -> call hier14() directly, */
965 if (hier14(&lval2))
966 rvalue(&lval2); /* instead of plnge2(). */
967 checkfunction(&lval2);
968 /* check whether lval2 and lval3 (old lval1) refer to the same variable */
969 if (lval2.ident == iVARIABLE && lval3.ident == lval2.ident
970 && lval3.sym == lval2.sym)
971 {
972 assert(lval3.sym != NULL);
973 error(226, lval3.sym->name); /* self-assignment */
974 } /* if */
975 } /* if */
976 } /* if */
977 if (lval3.ident == iARRAY || lval3.ident == iREFARRAY)
978 {
979 /* left operand is an array, right operand should be an array variable
980 * of the same size and the same dimension, an array literal (of the
981 * same size) or a literal string.
982 */
983 int exactmatch = TRUE;
984
985 if (lval2.ident != iARRAY && lval2.ident != iREFARRAY)
986 error(33, lval3.sym->name); /* array must be indexed */
987 if (lval2.sym)
988 {
989 val = lval2.sym->dim.array.length; /* array variable */
990 level = lval2.sym->dim.array.level;
991 }
992 else
993 {
994 val = lval2.constval; /* literal array */
995 level = 0;
996 /* If val is negative, it means that lval2 is a
997 * literal string. The string array size may be
998 * smaller than the destination array.
999 */
1000 if (val < 0)
1001 {
1002 val = -val;
1003 exactmatch = FALSE;
1004 } /* if */
1005 } /* if */
1006 if (lval3.sym->dim.array.level != level)
1007 return error(48); /* array dimensions must match */
1008 else if (lval3.sym->dim.array.length < val
1009 || (exactmatch && lval3.sym->dim.array.length > val))
1010 return error(47); /* array sizes must match */
1011 if (level > 0)
1012 {
1013 /* check the sizes of all sublevels too */
1014 symbol *sym1 = lval3.sym;
1015 symbol *sym2 = lval2.sym;
1016 int i;
1017
1018 assert(sym1 != NULL && sym2 != NULL);
1019 /* ^^^ sym2 must be valid, because only variables can be
1020 * multi-dimensional (there are no multi-dimensional arrays),
1021 * sym1 must be valid because it must be an lvalue
1022 */
1023 assert(exactmatch);
1024 for (i = 0; i < level; i++)
1025 {
1026 sym1 = finddepend(sym1);
1027 sym2 = finddepend(sym2);
1028 assert(sym1 != NULL && sym2 != NULL);
1029 /* ^^^ both arrays have the same dimensions (this was checked
1030 * earlier) so the dependend should always be found
1031 */
1032 if (sym1->dim.array.length != sym2->dim.array.length)
1033 error(47); /* array sizes must match */
1034 } /* for */
1035 /* get the total size in cells of the multi-dimensional array */
1036 val = array_totalsize(lval3.sym);
1037 assert(val > 0); /* already checked */
1038 } /* if */
1039 }
1040 else
1041 {
1042 /* left operand is not an array, right operand should then not be either */
1043 if (lval2.ident == iARRAY || lval2.ident == iREFARRAY)
1044 error(6); /* must be assigned to an array */
1045 } /* if */
1046 if (lval3.ident == iARRAY || lval3.ident == iREFARRAY)
1047 {
1048 memcopy(val * sizeof(cell));
1049 }
1050 else
1051 {
1052 check_userop(NULL, lval2.tag, lval3.tag, 2, &lval3, &lval2.tag);
1053 store(&lval3); /* now, store the expression result */
1054 } /* if */
1055 if (!oper && !matchtag(lval3.tag, lval2.tag, TRUE))
1056 error(213); /* tagname mismatch (if "oper", warning already given in plunge2()) */
1057 if (lval3.sym)
1058 markusage(lval3.sym, uWRITTEN);
1059 sideeffect = TRUE;
1060 bitwise_opercount = bwcount;
1061 return FALSE; /* expression result is never an lvalue */
1062}
1063
1064static int
1065hier13(value * lval)
1066{
1067 int lvalue, flab1, flab2;
1068 value lval2 = { NULL, 0, 0, 0, 0, NULL };
1069 int array1, array2;
1070
1071 lvalue = plnge1(hier12, lval);
1072 if (matchtoken('?'))
1073 {
1074 flab1 = getlabel();
1075 flab2 = getlabel();
1076 if (lvalue)
1077 {
1078 rvalue(lval);
1079 }
1080 else if (lval->ident == iCONSTEXPR)
1081 {
1082 const1(lval->constval);
1083 error(lval->constval ? 206 : 205); /* redundant test */
1084 } /* if */
1085 jmp_eq0(flab1); /* go to second expression if primary register==0 */
1086 if (hier14(lval))
1087 rvalue(lval);
1088 jumplabel(flab2);
1089 setlabel(flab1);
1090 needtoken(':');
1091 if (hier14(&lval2))
1092 rvalue(&lval2);
1093 array1 = (lval->ident == iARRAY || lval->ident == iREFARRAY);
1094 array2 = (lval2.ident == iARRAY || lval2.ident == iREFARRAY);
1095 if (array1 && !array2)
1096 {
1097 char *ptr =
1098 (lval->sym->name) ? lval->sym->name : "-unknown-";
1099 error(33, ptr); /* array must be indexed */
1100 }
1101 else if (!array1 && array2)
1102 {
1103 char *ptr =
1104 (lval2.sym->name) ? lval2.sym->name : "-unknown-";
1105 error(33, ptr); /* array must be indexed */
1106 } /* if */
1107 /* ??? if both are arrays, should check dimensions */
1108 if (!matchtag(lval->tag, lval2.tag, FALSE))
1109 error(213); /* tagname mismatch ('true' and 'false' expressions) */
1110 setlabel(flab2);
1111 if (lval->ident == iARRAY)
1112 lval->ident = iREFARRAY; /* iARRAY becomes iREFARRAY */
1113 else if (lval->ident != iREFARRAY)
1114 lval->ident = iEXPRESSION; /* iREFARRAY stays iREFARRAY, rest becomes iEXPRESSION */
1115 return FALSE; /* conditional expression is no lvalue */
1116 }
1117 else
1118 {
1119 return lvalue;
1120 } /* endif */
1121}
1122
1123/* the order of the operators in these lists is important and must cohere */
1124/* with the order of the operators in the array "op1" */
1125static int list3[] = { '*', '/', '%', 0 };
1126static int list4[] = { '+', '-', 0 };
1127static int list5[] = { tSHL, tSHR, tSHRU, 0 };
1128static int list6[] = { '&', 0 };
1129static int list7[] = { '^', 0 };
1130static int list8[] = { '|', 0 };
1131static int list9[] = { tlLE, tlGE, '<', '>', 0 };
1132static int list10[] = { tlEQ, tlNE, 0 };
1133static int list11[] = { tlAND, 0 };
1134static int list12[] = { tlOR, 0 };
1135
1136static int
1137hier12(value * lval)
1138{
1139 return skim(list12, jmp_ne0, 1, 0, hier11, lval);
1140}
1141
1142static int
1143hier11(value * lval)
1144{
1145 return skim(list11, jmp_eq0, 0, 1, hier10, lval);
1146}
1147
1148static int
1149hier10(value * lval)
1150{ /* ==, != */
1151 return plnge(list10, 15, hier9, lval, "bool", TRUE);
1152} /* ^ this variable is the starting index in the op1[]
1153 * array of the operators of this hierarchy level */
1154
1155static int
1156hier9(value * lval)
1157{ /* <=, >=, <, > */
1158 return plnge_rel(list9, 11, hier8, lval);
1159}
1160
1161static int
1162hier8(value * lval)
1163{ /* | */
1164 return plnge(list8, 10, hier7, lval, NULL, FALSE);
1165}
1166
1167static int
1168hier7(value * lval)
1169{ /* ^ */
1170 return plnge(list7, 9, hier6, lval, NULL, FALSE);
1171}
1172
1173static int
1174hier6(value * lval)
1175{ /* & */
1176 return plnge(list6, 8, hier5, lval, NULL, FALSE);
1177}
1178
1179static int
1180hier5(value * lval)
1181{ /* <<, >>, >>> */
1182 return plnge(list5, 5, hier4, lval, NULL, FALSE);
1183}
1184
1185static int
1186hier4(value * lval)
1187{ /* +, - */
1188 return plnge(list4, 3, hier3, lval, NULL, FALSE);
1189}
1190
1191static int
1192hier3(value * lval)
1193{ /* *, /, % */
1194 return plnge(list3, 0, hier2, lval, NULL, FALSE);
1195}
1196
1197static int
1198hier2(value * lval)
1199{
1200 int lvalue, tok;
1201 int tag, paranthese;
1202 cell val;
1203 char *st;
1204 symbol *sym;
1205 int saveresult;
1206
1207 tok = lex(&val, &st);
1208 switch (tok)
1209 {
1210 case tINC: /* ++lval */
1211 if (!hier2(lval))
1212 return error(22); /* must be lvalue */
1213 assert(lval->sym != NULL);
1214 if ((lval->sym->usage & uCONST) != 0)
1215 return error(22); /* assignment to const argument */
1216 if (!check_userop(user_inc, lval->tag, 0, 1, lval, &lval->tag))
1217 inc(lval); /* increase variable first */
1218 rvalue(lval); /* and read the result into PRI */
1219 sideeffect = TRUE;
1220 return FALSE; /* result is no longer lvalue */
1221 case tDEC: /* --lval */
1222 if (!hier2(lval))
1223 return error(22); /* must be lvalue */
1224 assert(lval->sym != NULL);
1225 if ((lval->sym->usage & uCONST) != 0)
1226 return error(22); /* assignment to const argument */
1227 if (!check_userop(user_dec, lval->tag, 0, 1, lval, &lval->tag))
1228 dec(lval); /* decrease variable first */
1229 rvalue(lval); /* and read the result into PRI */
1230 sideeffect = TRUE;
1231 return FALSE; /* result is no longer lvalue */
1232 case '~': /* ~ (one's complement) */
1233 if (hier2(lval))
1234 rvalue(lval);
1235 invert(); /* bitwise NOT */
1236 lval->constval = ~lval->constval;
1237 return FALSE;
1238 case '!': /* ! (logical negate) */
1239 if (hier2(lval))
1240 rvalue(lval);
1241 if (check_userop(lneg, lval->tag, 0, 1, NULL, &lval->tag))
1242 {
1243 lval->ident = iEXPRESSION;
1244 lval->constval = 0;
1245 }
1246 else
1247 {
1248 lneg(); /* 0 -> 1, !0 -> 0 */
1249 lval->constval = !lval->constval;
1250 lval->tag = sc_addtag("bool");
1251 } /* if */
1252 return FALSE;
1253 case '-': /* unary - (two's complement) */
1254 if (hier2(lval))
1255 rvalue(lval);
1256 /* make a special check for a constant expression with the tag of a
1257 * rational number, so that we can simple swap the sign of that constant.
1258 */
1259 if (lval->ident == iCONSTEXPR && lval->tag == sc_rationaltag
1260 && sc_rationaltag != 0)
1261 {
1262 if (rational_digits == 0)
1263 {
1264 float *f = (float *)&lval->constval;
1265
1266 *f = -*f; /* this modifies lval->constval */
1267 }
1268 else
1269 {
1270 /* the negation of a fixed point number is just an integer negation */
1271 lval->constval = -lval->constval;
1272 } /* if */
1273 }
1274 else if (check_userop(neg, lval->tag, 0, 1, NULL, &lval->tag))
1275 {
1276 lval->ident = iEXPRESSION;
1277 lval->constval = 0;
1278 }
1279 else
1280 {
1281 neg(); /* arithmic negation */
1282 lval->constval = -lval->constval;
1283 } /* if */
1284 return FALSE;
1285 case tLABEL: /* tagname override */
1286 tag = sc_addtag(st);
1287 lvalue = hier2(lval);
1288 lval->tag = tag;
1289 return lvalue;
1290 case tDEFINED:
1291 paranthese = 0;
1292 while (matchtoken('('))
1293 paranthese++;
1294 tok = lex(&val, &st);
1295 if (tok != tSYMBOL)
1296 return error(20, st); /* illegal symbol name */
1297 sym = findloc(st);
1298 if (!sym)
1299 sym = findglb(st);
1300 if (sym && sym->ident != iFUNCTN && sym->ident != iREFFUNC
1301 && (sym->usage & uDEFINE) == 0)
1302 sym = NULL; /* symbol is not a function, it is in the table, but not "defined" */
1303 val = !!sym;
1304 if (!val && find_subst(st, strlen(st)))
1305 val = 1;
1306 clear_value(lval);
1307 lval->ident = iCONSTEXPR;
1308 lval->constval = val;
1309 const1(lval->constval);
1310 while (paranthese--)
1311 needtoken(')');
1312 return FALSE;
1313 case tSIZEOF:
1314 paranthese = 0;
1315 while (matchtoken('('))
1316 paranthese++;
1317 tok = lex(&val, &st);
1318 if (tok != tSYMBOL)
1319 return error(20, st); /* illegal symbol name */
1320 sym = findloc(st);
1321 if (!sym)
1322 sym = findglb(st);
1323 if (!sym)
1324 return error(17, st); /* undefined symbol */
1325 if (sym->ident == iCONSTEXPR)
1326 error(39); /* constant symbol has no size */
1327 else if (sym->ident == iFUNCTN || sym->ident == iREFFUNC)
1328 error(72); /* "function" symbol has no size */
1329 else if ((sym->usage & uDEFINE) == 0)
1330 return error(17, st); /* undefined symbol (symbol is in the table, but it is "used" only) */
1331 clear_value(lval);
1332 lval->ident = iCONSTEXPR;
1333 lval->constval = 1; /* preset */
1334 if (sym->ident == iARRAY || sym->ident == iREFARRAY)
1335 {
1336 int level;
1337
1338 for (level = 0; matchtoken('['); level++)
1339 needtoken(']');
1340 if (level > sym->dim.array.level)
1341 error(28); /* invalid subscript */
1342 else
1343 lval->constval = array_levelsize(sym, level);
1344 if (lval->constval == 0 && !strchr(lptr, PREPROC_TERM))
1345 error(224, st); /* indeterminate array size in "sizeof" expression */
1346 } /* if */
1347 const1(lval->constval);
1348 while (paranthese--)
1349 needtoken(')');
1350 return FALSE;
1351 case tTAGOF:
1352 paranthese = 0;
1353 while (matchtoken('('))
1354 paranthese++;
1355 tok = lex(&val, &st);
1356 if (tok != tSYMBOL && tok != tLABEL)
1357 return error(20, st); /* illegal symbol name */
1358 if (tok == tLABEL)
1359 {
1360 tag = sc_addtag(st);
1361 }
1362 else
1363 {
1364 sym = findloc(st);
1365 if (!sym)
1366 sym = findglb(st);
1367 if (!sym)
1368 return error(17, st); /* undefined symbol */
1369 if ((sym->usage & uDEFINE) == 0)
1370 return error(17, st); /* undefined symbol (symbol is in the table, but it is "used" only) */
1371 tag = sym->tag;
1372 } /* if */
1373 exporttag(tag);
1374 clear_value(lval);
1375 lval->ident = iCONSTEXPR;
1376 lval->constval = tag;
1377 const1(lval->constval);
1378 while (paranthese--)
1379 needtoken(')');
1380 return FALSE;
1381 default:
1382 lexpush();
1383 lvalue = hier1(lval);
1384 /* check for postfix operators */
1385 if (matchtoken(';'))
1386 {
1387 /* Found a ';', do not look further for postfix operators */
1388 lexpush(); /* push ';' back after successful match */
1389 return lvalue;
1390 }
1391 else if (matchtoken(tTERM))
1392 {
1393 /* Found a newline that ends a statement (this is the case when
1394 * semicolons are optional). Note that an explicit semicolon was
1395 * handled above. This case is similar, except that the token must
1396 * not be pushed back.
1397 */
1398 return lvalue;
1399 }
1400 else
1401 {
1402 tok = lex(&val, &st);
1403 switch (tok)
1404 {
1405 case tINC: /* lval++ */
1406 if (!lvalue)
1407 return error(22); /* must be lvalue */
1408 assert(lval->sym != NULL);
1409 if ((lval->sym->usage & uCONST) != 0)
1410 return error(22); /* assignment to const argument */
1411 /* on incrementing array cells, the address in PRI must be saved for
1412 * incremening the value, whereas the current value must be in PRI
1413 * on exit.
1414 */
1415 saveresult = (lval->ident == iARRAYCELL
1416 || lval->ident == iARRAYCHAR);
1417 if (saveresult)
1418 push1(); /* save address in PRI */
1419 rvalue(lval); /* read current value into PRI */
1420 if (saveresult)
1421 swap1(); /* save PRI on the stack, restore address in PRI */
1422 if (!check_userop
1423 (user_inc, lval->tag, 0, 1, lval, &lval->tag))
1424 inc(lval); /* increase variable afterwards */
1425 if (saveresult)
1426 pop1(); /* restore PRI (result of rvalue()) */
1427 sideeffect = TRUE;
1428 return FALSE; /* result is no longer lvalue */
1429 case tDEC: /* lval-- */
1430 if (!lvalue)
1431 return error(22); /* must be lvalue */
1432 assert(lval->sym != NULL);
1433 if ((lval->sym->usage & uCONST) != 0)
1434 return error(22); /* assignment to const argument */
1435 saveresult = (lval->ident == iARRAYCELL
1436 || lval->ident == iARRAYCHAR);
1437 if (saveresult)
1438 push1(); /* save address in PRI */
1439 rvalue(lval); /* read current value into PRI */
1440 if (saveresult)
1441 swap1(); /* save PRI on the stack, restore address in PRI */
1442 if (!check_userop
1443 (user_dec, lval->tag, 0, 1, lval, &lval->tag))
1444 dec(lval); /* decrease variable afterwards */
1445 if (saveresult)
1446 pop1(); /* restore PRI (result of rvalue()) */
1447 sideeffect = TRUE;
1448 return FALSE;
1449 case tCHAR: /* char (compute required # of cells */
1450 if (lval->ident == iCONSTEXPR)
1451 {
1452 lval->constval *= charbits / 8; /* from char to bytes */
1453 lval->constval =
1454 (lval->constval + sizeof(cell) - 1) / sizeof(cell);
1455 }
1456 else
1457 {
1458 if (lvalue)
1459 rvalue(lval); /* fetch value if not already in PRI */
1460 char2addr(); /* from characters to bytes */
1461 addconst(sizeof(cell) - 1); /* make sure the value is rounded up */
1462 addr2cell(); /* truncate to number of cells */
1463 } /* if */
1464 return FALSE;
1465 default:
1466 lexpush();
1467 return lvalue;
1468 } /* switch */
1469 } /* if */
1470 } /* switch */
1471}
1472
1473/* hier1
1474 *
1475 * The highest hierarchy level: it looks for pointer and array indices
1476 * and function calls.
1477 * Generates code to fetch a pointer value if it is indexed and code to
1478 * add to the pointer value or the array address (the address is already
1479 * read at primary()). It also generates code to fetch a function address
1480 * if that hasn't already been done at primary() (check lval[4]) and calls
1481 * callfunction() to call the function.
1482 */
1483static int
1484hier1(value * lval1)
1485{
1486 int lvalue, index, tok, symtok;
1487 cell val, cidx;
1488 value lval2 = { NULL, 0, 0, 0, 0, NULL };
1489 char *st;
1490 char close;
1491 symbol *sym;
1492
1493 lvalue = primary(lval1);
1494 symtok = tokeninfo(&val, &st); /* get token read by primary() */
1495 restart:
1496 sym = lval1->sym;
1497 if (matchtoken('[') || matchtoken('{') || matchtoken('('))
1498 {
1499 tok = tokeninfo(&val, &st); /* get token read by matchtoken() */
1500 if (!sym && symtok != tSYMBOL)
1501 {
1502 /* we do not have a valid symbol and we appear not to have read a valid
1503 * symbol name (so it is unlikely that we would have read a name of an
1504 * undefined symbol) */
1505 error(29); /* expression error, assumed 0 */
1506 lexpush(); /* analyse '(', '{' or '[' again later */
1507 return FALSE;
1508 } /* if */
1509 if (tok == '[' || tok == '{')
1510 { /* subscript */
1511 close = (char)((tok == '[') ? ']' : '}');
1512 if (!sym)
1513 { /* sym==NULL if lval is a constant or a literal */
1514 error(28); /* cannot subscript */
1515 needtoken(close);
1516 return FALSE;
1517 }
1518 else if (sym->ident != iARRAY && sym->ident != iREFARRAY)
1519 {
1520 error(28); /* cannot subscript, variable is not an array */
1521 needtoken(close);
1522 return FALSE;
1523 }
1524 else if (sym->dim.array.level > 0 && close != ']')
1525 {
1526 error(51); /* invalid subscript, must use [ ] */
1527 needtoken(close);
1528 return FALSE;
1529 } /* if */
1530 stgget(&index, &cidx); /* mark position in code generator */
1531 push1(); /* save base address of the array */
1532 if (hier14(&lval2)) /* create expression for the array index */
1533 rvalue(&lval2);
1534 if (lval2.ident == iARRAY || lval2.ident == iREFARRAY)
1535 error(33, lval2.sym->name); /* array must be indexed */
1536 needtoken(close);
1537 if (!matchtag(sym->x.idxtag, lval2.tag, TRUE))
1538 error(213);
1539 if (lval2.ident == iCONSTEXPR)
1540 { /* constant expression */
1541 stgdel(index, cidx); /* scratch generated code */
1542 if (lval1->arrayidx)
1543 { /* keep constant index, for checking */
1544 assert(sym->dim.array.level >= 0
1545 && sym->dim.array.level < sDIMEN_MAX);
1546 lval1->arrayidx[sym->dim.array.level] = lval2.constval;
1547 } /* if */
1548 if (close == ']')
1549 {
1550 /* normal array index */
1551 if (lval2.constval < 0 || (sym->dim.array.length != 0
1552 && sym->dim.array.length <= lval2.constval))
1553 error(32, sym->name); /* array index out of bounds */
1554 if (lval2.constval != 0)
1555 {
1556 /* don't add offsets for zero subscripts */
1557#if defined(BIT16)
1558 const2(lval2.constval << 1);
1559#else
1560 const2(lval2.constval << 2);
1561#endif
1562 ob_add();
1563 } /* if */
1564 }
1565 else
1566 {
1567 /* character index */
1568 if (lval2.constval < 0 || (sym->dim.array.length != 0
1569 && sym->dim.array.length * ((8 * sizeof(cell)) /
1570 charbits) <=
1571 (ucell) lval2.constval))
1572 error(32, sym->name); /* array index out of bounds */
1573 if (lval2.constval != 0)
1574 {
1575 /* don't add offsets for zero subscripts */
1576 if (charbits == 16)
1577 const2(lval2.constval << 1); /* 16-bit character */
1578 else
1579 const2(lval2.constval); /* 8-bit character */
1580 ob_add();
1581 } /* if */
1582 charalign(); /* align character index into array */
1583 } /* if */
1584 }
1585 else
1586 {
1587 /* array index is not constant */
1588 lval1->arrayidx = NULL; /* reset, so won't be checked */
1589 if (close == ']')
1590 {
1591 if (sym->dim.array.length != 0)
1592 ffbounds(sym->dim.array.length - 1); /* run time check for array bounds */
1593 cell2addr(); /* normal array index */
1594 }
1595 else
1596 {
1597 if (sym->dim.array.length != 0)
1598 ffbounds(sym->dim.array.length * (32 / charbits) - 1);
1599 char2addr(); /* character array index */
1600 } /* if */
1601 pop2();
1602 ob_add(); /* base address was popped into secondary register */
1603 if (close != ']')
1604 charalign(); /* align character index into array */
1605 } /* if */
1606 /* the indexed item may be another array (multi-dimensional arrays) */
1607 assert(lval1->sym == sym && sym != NULL); /* should still be set */
1608 if (sym->dim.array.level > 0)
1609 {
1610 assert(close == ']'); /* checked earlier */
1611 /* read the offset to the subarray and add it to the current address */
1612 lval1->ident = iARRAYCELL;
1613 push1(); /* the optimizer makes this to a MOVE.alt */
1614 rvalue(lval1);
1615 pop2();
1616 ob_add();
1617 /* adjust the "value" structure and find the referenced array */
1618 lval1->ident = iREFARRAY;
1619 lval1->sym = finddepend(sym);
1620 assert(lval1->sym != NULL);
1621 assert(lval1->sym->dim.array.level ==
1622 sym->dim.array.level - 1);
1623 /* try to parse subsequent array indices */
1624 lvalue = FALSE; /* for now, a iREFARRAY is no lvalue */
1625 goto restart;
1626 } /* if */
1627 assert(sym->dim.array.level == 0);
1628 /* set type to fetch... INDIRECTLY */
1629 lval1->ident = (char)((close == ']') ? iARRAYCELL : iARRAYCHAR);
1630 lval1->tag = sym->tag;
1631 /* a cell in an array is an lvalue, a character in an array is not
1632 * always a *valid* lvalue */
1633 return TRUE;
1634 }
1635 else
1636 { /* tok=='(' -> function(...) */
1637 if (!sym
1638 || (sym->ident != iFUNCTN && sym->ident != iREFFUNC))
1639 {
1640 if (!sym && sc_status == statFIRST)
1641 {
1642 /* could be a "use before declaration"; in that case, create a stub
1643 * function so that the usage can be marked.
1644 */
1645 sym = fetchfunc(lastsymbol, 0);
1646 if (sym)
1647 markusage(sym, uREAD);
1648 } /* if */
1649 return error(12); /* invalid function call */
1650 }
1651 else if ((sym->usage & uMISSING) != 0)
1652 {
1653 char symname[2 * sNAMEMAX + 16]; /* allow space for user defined operators */
1654
1655 funcdisplayname(symname, sym->name);
1656 error(4, symname); /* function not defined */
1657 } /* if */
1658 callfunction(sym);
1659 lval1->ident = iEXPRESSION;
1660 lval1->constval = 0;
1661 lval1->tag = sym->tag;
1662 return FALSE; /* result of function call is no lvalue */
1663 } /* if */
1664 } /* if */
1665 if (sym && lval1->ident == iFUNCTN)
1666 {
1667 assert(sym->ident == iFUNCTN);
1668 address(sym);
1669 lval1->sym = NULL;
1670 lval1->ident = iREFFUNC;
1671 /* ??? however... function pointers (or function references are not (yet) allowed */
1672 error(29); /* expression error, assumed 0 */
1673 return FALSE;
1674 } /* if */
1675 return lvalue;
1676}
1677
1678/* primary
1679 *
1680 * Returns 1 if the operand is an lvalue (everything except arrays, functions
1681 * constants and -of course- errors).
1682 * Generates code to fetch the address of arrays. Code for constants is
1683 * already generated by constant().
1684 * This routine first clears the entire lval array (all fields are set to 0).
1685 *
1686 * Global references: intest (may be altered, but restored upon termination)
1687 */
1688static int
1689primary(value * lval)
1690{
1691 char *st;
1692 int lvalue, tok;
1693 cell val;
1694 symbol *sym;
1695
1696 if (matchtoken('('))
1697 { /* sub-expression - (expression,...) */
1698 pushstk((stkitem) intest);
1699 pushstk((stkitem) sc_allowtags);
1700
1701 intest = 0; /* no longer in "test" expression */
1702 sc_allowtags = TRUE; /* allow tagnames to be used in parenthised expressions */
1703 do
1704 lvalue = hier14(lval);
1705 while (matchtoken(','));
1706 needtoken(')');
1707 lexclr(FALSE); /* clear lex() push-back, it should have been
1708 * cleared already by needtoken() */
1709 sc_allowtags = (int)(long)popstk();
1710 intest = (int)(long)popstk();
1711 return lvalue;
1712 } /* if */
1713
1714 clear_value(lval); /* clear lval */
1715 tok = lex(&val, &st);
1716 if (tok == tSYMBOL)
1717 {
1718 /* lastsymbol is char[sNAMEMAX+1], lex() should have truncated any symbol
1719 * to sNAMEMAX significant characters */
1720 assert(strlen(st) < sizeof lastsymbol);
1721 strcpy(lastsymbol, st);
1722 } /* if */
1723 if (tok == tSYMBOL && !findconst(st))
1724 {
1725 /* first look for a local variable */
1726 if ((sym = findloc(st)))
1727 {
1728 if (sym->ident == iLABEL)
1729 {
1730 error(29); /* expression error, assumed 0 */
1731 const1(0); /* load 0 */
1732 return FALSE; /* return 0 for labels (expression error) */
1733 } /* if */
1734 lval->sym = sym;
1735 lval->ident = sym->ident;
1736 lval->tag = sym->tag;
1737 if (sym->ident == iARRAY || sym->ident == iREFARRAY)
1738 {
1739 address(sym); /* get starting address in primary register */
1740 return FALSE; /* return 0 for array (not lvalue) */
1741 }
1742 else
1743 {
1744 return TRUE; /* return 1 if lvalue (not label or array) */
1745 } /* if */
1746 } /* if */
1747 /* now try a global variable */
1748 if ((sym = findglb(st)))
1749 {
1750 if (sym->ident == iFUNCTN || sym->ident == iREFFUNC)
1751 {
1752 /* if the function is only in the table because it was inserted as a
1753 * stub in the first pass (i.e. it was "used" but never declared or
1754 * implemented, issue an error
1755 */
1756 if ((sym->usage & uPROTOTYPED) == 0)
1757 error(17, st);
1758 }
1759 else
1760 {
1761 if ((sym->usage & uDEFINE) == 0)
1762 error(17, st);
1763 lval->sym = sym;
1764 lval->ident = sym->ident;
1765 lval->tag = sym->tag;
1766 if (sym->ident == iARRAY || sym->ident == iREFARRAY)
1767 {
1768 address(sym); /* get starting address in primary register */
1769 return FALSE; /* return 0 for array (not lvalue) */
1770 }
1771 else
1772 {
1773 return TRUE; /* return 1 if lvalue (not function or array) */
1774 } /* if */
1775 } /* if */
1776 }
1777 else
1778 {
1779 return error(17, st); /* undefined symbol */
1780 } /* endif */
1781 assert(sym != NULL);
1782 assert(sym->ident == iFUNCTN || sym->ident != iREFFUNC);
1783 lval->sym = sym;
1784 lval->ident = sym->ident;
1785 lval->tag = sym->tag;
1786 return FALSE; /* return 0 for function (not an lvalue) */
1787 } /* if */
1788 lexpush(); /* push the token, it is analyzed by constant() */
1789 if (constant(lval) == 0)
1790 {
1791 error(29); /* expression error, assumed 0 */
1792 const1(0); /* load 0 */
1793 } /* if */
1794 return FALSE; /* return 0 for constants (or errors) */
1795}
1796
1797static void
1798clear_value(value * lval)
1799{
1800 lval->sym = NULL;
1801 lval->constval = 0L;
1802 lval->tag = 0;
1803 lval->ident = 0;
1804 lval->boolresult = FALSE;
1805 /* do not clear lval->arrayidx, it is preset in hier14() */
1806}
1807
1808static void
1809setdefarray(cell * string, cell size, cell array_sz, cell * dataaddr,
1810 int fconst)
1811{
1812 /* The routine must copy the default array data onto the heap, as to avoid
1813 * that a function can change the default value. An optimization is that
1814 * the default array data is "dumped" into the data segment only once (on the
1815 * first use).
1816 */
1817 assert(string != NULL);
1818 assert(size > 0);
1819 /* check whether to dump the default array */
1820 assert(dataaddr != NULL);
1821 if (sc_status == statWRITE && *dataaddr < 0)
1822 {
1823 int i;
1824
1825 *dataaddr = (litidx + glb_declared) * sizeof(cell);
1826 for (i = 0; i < size; i++)
1827 stowlit(*string++);
1828 } /* if */
1829
1830 /* if the function is known not to modify the array (meaning that it also
1831 * does not modify the default value), directly pass the address of the
1832 * array in the data segment.
1833 */
1834 if (fconst)
1835 {
1836 const1(*dataaddr);
1837 }
1838 else
1839 {
1840 /* Generate the code:
1841 * CONST.pri dataaddr ;address of the default array data
1842 * HEAP array_sz*sizeof(cell) ;heap address in ALT
1843 * MOVS size*sizeof(cell) ;copy data from PRI to ALT
1844 * MOVE.PRI ;PRI = address on the heap
1845 */
1846 const1(*dataaddr);
1847 /* "array_sz" is the size of the argument (the value between the brackets
1848 * in the declaration), "size" is the size of the default array data.
1849 */
1850 assert(array_sz >= size);
1851 modheap((int)array_sz * sizeof(cell));
1852 /* ??? should perhaps fill with zeros first */
1853 memcopy(size * sizeof(cell));
1854 moveto1();
1855 } /* if */
1856}
1857
1858static int
1859findnamedarg(arginfo * arg, char *name)
1860{
1861 int i;
1862
1863 for (i = 0; arg[i].ident != 0 && arg[i].ident != iVARARGS; i++)
1864 if (strcmp(arg[i].name, name) == 0)
1865 return i;
1866 return -1;
1867}
1868
1869static int
1870checktag(int tags[], int numtags, int exprtag)
1871{
1872 int i;
1873
1874 assert(tags != 0);
1875 assert(numtags > 0);
1876 for (i = 0; i < numtags; i++)
1877 if (matchtag(tags[i], exprtag, TRUE))
1878 return TRUE; /* matching tag */
1879 return FALSE; /* no tag matched */
1880}
1881
1882enum
1883{
1884 ARG_UNHANDLED,
1885 ARG_IGNORED,
1886 ARG_DONE,
1887};
1888
1889/* callfunction
1890 *
1891 * Generates code to call a function. This routine handles default arguments
1892 * and positional as well as named parameters.
1893 */
1894static void
1895callfunction(symbol * sym)
1896{
1897 int close, lvalue;
1898 int argpos; /* index in the output stream (argpos==nargs if positional parameters) */
1899 int argidx = 0; /* index in "arginfo" list */
1900 int nargs = 0; /* number of arguments */
1901 int heapalloc = 0;
1902 int namedparams = FALSE;
1903 value lval = { NULL, 0, 0, 0, 0, NULL };
1904 arginfo *arg;
1905 char arglist[sMAXARGS];
1906 constvalue arrayszlst = { NULL, "", 0, 0 }; /* array size list starts empty */
1907 cell lexval;
1908 char *lexstr;
1909
1910 assert(sym != NULL);
1911 arg = sym->dim.arglist;
1912 assert(arg != NULL);
1913 stgmark(sSTARTREORDER);
1914 for (argpos = 0; argpos < sMAXARGS; argpos++)
1915 arglist[argpos] = ARG_UNHANDLED;
1916 if (!matchtoken(')'))
1917 {
1918 do
1919 {
1920 if (matchtoken('.'))
1921 {
1922 namedparams = TRUE;
1923 if (needtoken(tSYMBOL))
1924 tokeninfo(&lexval, &lexstr);
1925 else
1926 lexstr = "";
1927 argpos = findnamedarg(arg, lexstr);
1928 if (argpos < 0)
1929 {
1930 error(17, lexstr); /* undefined symbol */
1931 break; /* exit loop, argpos is invalid */
1932 } /* if */
1933 needtoken('=');
1934 argidx = argpos;
1935 }
1936 else
1937 {
1938 if (namedparams)
1939 error(44); /* positional parameters must precede named parameters */
1940 argpos = nargs;
1941 } /* if */
1942 stgmark((char)(sEXPRSTART + argpos)); /* mark beginning of new expression in stage */
1943 if (arglist[argpos] != ARG_UNHANDLED)
1944 error(58); /* argument already set */
1945 if (matchtoken('_'))
1946 {
1947 arglist[argpos] = ARG_IGNORED; /* flag argument as "present, but ignored" */
1948 if (arg[argidx].ident == 0 || arg[argidx].ident == iVARARGS)
1949 {
1950 error(202); /* argument count mismatch */
1951 }
1952 else if (!arg[argidx].hasdefault)
1953 {
1954 error(34, nargs + 1); /* argument has no default value */
1955 } /* if */
1956 if (arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS)
1957 argidx++;
1958 /* The rest of the code to handle default values is at the bottom
1959 * of this routine where default values for unspecified parameters
1960 * are (also) handled. Note that above, the argument is flagged as
1961 * ARG_IGNORED.
1962 */
1963 }
1964 else
1965 {
1966 arglist[argpos] = ARG_DONE; /* flag argument as "present" */
1967 lvalue = hier14(&lval);
1968 switch (arg[argidx].ident)
1969 {
1970 case 0:
1971 error(202); /* argument count mismatch */
1972 break;
1973 case iVARARGS:
1974 /* always pass by reference */
1975 if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)
1976 {
1977 assert(lval.sym != NULL);
1978 if ((lval.sym->usage & uCONST) != 0
1979 && (arg[argidx].usage & uCONST) == 0)
1980 {
1981 /* treat a "const" variable passed to a function with a non-const
1982 * "variable argument list" as a constant here */
1983 assert(lvalue);
1984 rvalue(&lval); /* get value in PRI */
1985 setheap_pri(); /* address of the value on the heap in PRI */
1986 heapalloc++;
1987 }
1988 else if (lvalue)
1989 {
1990 address(lval.sym);
1991 }
1992 else
1993 {
1994 setheap_pri(); /* address of the value on the heap in PRI */
1995 heapalloc++;
1996 } /* if */
1997 }
1998 else if (lval.ident == iCONSTEXPR
1999 || lval.ident == iEXPRESSION
2000 || lval.ident == iARRAYCHAR)
2001 {
2002 /* fetch value if needed */
2003 if (lval.ident == iARRAYCHAR)
2004 rvalue(&lval);
2005 /* allocate a cell on the heap and store the
2006 * value (already in PRI) there */
2007 setheap_pri(); /* address of the value on the heap in PRI */
2008 heapalloc++;
2009 } /* if */
2010 /* ??? handle const array passed by reference */
2011 /* otherwise, the address is already in PRI */
2012 if (lval.sym)
2013 markusage(lval.sym, uWRITTEN);
2014/*
2015 * Dont need this warning - its varargs. there is no way of knowing the
2016 * required tag/type...
2017 *
2018 if (!checktag(arg[argidx].tags,arg[argidx].numtags,lval.tag))
2019 error(213);
2020 */
2021 break;
2022 case iVARIABLE:
2023 if (lval.ident == iLABEL || lval.ident == iFUNCTN
2024 || lval.ident == iREFFUNC || lval.ident == iARRAY
2025 || lval.ident == iREFARRAY)
2026 error(35, argidx + 1); /* argument type mismatch */
2027 if (lvalue)
2028 rvalue(&lval); /* get value (direct or indirect) */
2029 /* otherwise, the expression result is already in PRI */
2030 assert(arg[argidx].numtags > 0);
2031 check_userop(NULL, lval.tag, arg[argidx].tags[0], 2,
2032 NULL, &lval.tag);
2033 if (!checktag
2034 (arg[argidx].tags, arg[argidx].numtags, lval.tag))
2035 error(213);
2036 argidx++; /* argument done */
2037 break;
2038 case iREFERENCE:
2039 if (!lvalue || lval.ident == iARRAYCHAR)
2040 error(35, argidx + 1); /* argument type mismatch */
2041 if (lval.sym && (lval.sym->usage & uCONST) != 0
2042 && (arg[argidx].usage & uCONST) == 0)
2043 error(35, argidx + 1); /* argument type mismatch */
2044 if (lval.ident == iVARIABLE || lval.ident == iREFERENCE)
2045 {
2046 if (lvalue)
2047 {
2048 assert(lval.sym != NULL);
2049 address(lval.sym);
2050 }
2051 else
2052 {
2053 setheap_pri(); /* address of the value on the heap in PRI */
2054 heapalloc++;
2055 } /* if */
2056 } /* if */
2057 /* otherwise, the address is already in PRI */
2058 if (!checktag
2059 (arg[argidx].tags, arg[argidx].numtags, lval.tag))
2060 error(213);
2061 argidx++; /* argument done */
2062 if (lval.sym)
2063 markusage(lval.sym, uWRITTEN);
2064 break;
2065 case iREFARRAY:
2066 if (lval.ident != iARRAY && lval.ident != iREFARRAY
2067 && lval.ident != iARRAYCELL)
2068 {
2069 error(35, argidx + 1); /* argument type mismatch */
2070 break;
2071 } /* if */
2072 if (lval.sym && (lval.sym->usage & uCONST) != 0
2073 && (arg[argidx].usage & uCONST) == 0)
2074 error(35, argidx + 1); /* argument type mismatch */
2075 /* Verify that the dimensions match with those in arg[argidx].
2076 * A literal array always has a single dimension.
2077 * An iARRAYCELL parameter is also assumed to have a single dimension.
2078 */
2079 if (!lval.sym || lval.ident == iARRAYCELL)
2080 {
2081 if (arg[argidx].numdim != 1)
2082 {
2083 error(48); /* array dimensions must match */
2084 }
2085 else if (arg[argidx].dim[0] != 0)
2086 {
2087 assert(arg[argidx].dim[0] > 0);
2088 if (lval.ident == iARRAYCELL)
2089 {
2090 error(47); /* array sizes must match */
2091 }
2092 else
2093 {
2094 assert(lval.constval != 0); /* literal array must have a size */
2095 /* A literal array must have exactly the same size as the
2096 * function argument; a literal string may be smaller than
2097 * the function argument.
2098 */
2099 if ((lval.constval > 0
2100 && arg[argidx].dim[0] != lval.constval)
2101 || (lval.constval < 0
2102 && arg[argidx].dim[0] <
2103 -lval.constval))
2104 error(47); /* array sizes must match */
2105 } /* if */
2106 } /* if */
2107 if (lval.ident != iARRAYCELL)
2108 {
2109 /* save array size, for default values with uSIZEOF flag */
2110 cell array_sz = lval.constval;
2111
2112 assert(array_sz != 0); /* literal array must have a size */
2113 if (array_sz < 0)
2114 array_sz = -array_sz;
2115 append_constval(&arrayszlst, arg[argidx].name,
2116 array_sz, 0);
2117 } /* if */
2118 }
2119 else
2120 {
2121 symbol *sym = lval.sym;
2122 short level = 0;
2123
2124 assert(sym != NULL);
2125 if (sym->dim.array.level + 1 != arg[argidx].numdim)
2126 error(48); /* array dimensions must match */
2127 /* the lengths for all dimensions must match, unless the dimension
2128 * length was defined at zero (which means "undefined")
2129 */
2130 while (sym->dim.array.level > 0)
2131 {
2132 assert(level < sDIMEN_MAX);
2133 if (arg[argidx].dim[level] != 0
2134 && sym->dim.array.length !=
2135 arg[argidx].dim[level])
2136 error(47); /* array sizes must match */
2137 append_constval(&arrayszlst, arg[argidx].name,
2138 sym->dim.array.length, level);
2139 sym = finddepend(sym);
2140 assert(sym != NULL);
2141 level++;
2142 } /* if */
2143 /* the last dimension is checked too, again, unless it is zero */
2144 assert(level < sDIMEN_MAX);
2145 assert(sym != NULL);
2146 if (arg[argidx].dim[level] != 0
2147 && sym->dim.array.length !=
2148 arg[argidx].dim[level])
2149 error(47); /* array sizes must match */
2150 append_constval(&arrayszlst, arg[argidx].name,
2151 sym->dim.array.length, level);
2152 } /* if */
2153 /* address already in PRI */
2154 if (!checktag
2155 (arg[argidx].tags, arg[argidx].numtags, lval.tag))
2156 error(213);
2157 // ??? set uWRITTEN?
2158 argidx++; /* argument done */
2159 break;
2160 } /* switch */
2161 push1(); /* store the function argument on the stack */
2162 endexpr(FALSE); /* mark the end of a sub-expression */
2163 } /* if */
2164 assert(arglist[argpos] != ARG_UNHANDLED);
2165 nargs++;
2166 close = matchtoken(')');
2167 if (!close) /* if not paranthese... */
2168 if (!needtoken(',')) /* ...should be comma... */
2169 break; /* ...but abort loop if neither */
2170 }
2171 while (!close && freading && !matchtoken(tENDEXPR)); /* do */
2172 } /* if */
2173 /* check remaining function arguments (they may have default values) */
2174 for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;
2175 argidx++)
2176 {
2177 if (arglist[argidx] == ARG_DONE)
2178 continue; /* already seen and handled this argument */
2179 /* in this first stage, we also skip the arguments with uSIZEOF and uTAGOF;
2180 * these are handled last
2181 */
2182 if ((arg[argidx].hasdefault & uSIZEOF) != 0
2183 || (arg[argidx].hasdefault & uTAGOF) != 0)
2184 {
2185 assert(arg[argidx].ident == iVARIABLE);
2186 continue;
2187 } /* if */
2188 stgmark((char)(sEXPRSTART + argidx)); /* mark beginning of new expression in stage */
2189 if (arg[argidx].hasdefault)
2190 {
2191 if (arg[argidx].ident == iREFARRAY)
2192 {
2193 short level;
2194
2195 setdefarray(arg[argidx].defvalue.array.data,
2196 arg[argidx].defvalue.array.size,
2197 arg[argidx].defvalue.array.arraysize,
2198 &arg[argidx].defvalue.array.addr,
2199 (arg[argidx].usage & uCONST) != 0);
2200 if ((arg[argidx].usage & uCONST) == 0)
2201 heapalloc += arg[argidx].defvalue.array.arraysize;
2202 /* keep the lengths of all dimensions of a multi-dimensional default array */
2203 assert(arg[argidx].numdim > 0);
2204 if (arg[argidx].numdim == 1)
2205 {
2206 append_constval(&arrayszlst, arg[argidx].name,
2207 arg[argidx].defvalue.array.arraysize, 0);
2208 }
2209 else
2210 {
2211 for (level = 0; level < arg[argidx].numdim; level++)
2212 {
2213 assert(level < sDIMEN_MAX);
2214 append_constval(&arrayszlst, arg[argidx].name,
2215 arg[argidx].dim[level], level);
2216 } /* for */
2217 } /* if */
2218 }
2219 else if (arg[argidx].ident == iREFERENCE)
2220 {
2221 setheap(arg[argidx].defvalue.val);
2222 /* address of the value on the heap in PRI */
2223 heapalloc++;
2224 }
2225 else
2226 {
2227 int dummytag = arg[argidx].tags[0];
2228
2229 const1(arg[argidx].defvalue.val);
2230 assert(arg[argidx].numtags > 0);
2231 check_userop(NULL, arg[argidx].defvalue_tag,
2232 arg[argidx].tags[0], 2, NULL, &dummytag);
2233 assert(dummytag == arg[argidx].tags[0]);
2234 } /* if */
2235 push1(); /* store the function argument on the stack */
2236 endexpr(FALSE); /* mark the end of a sub-expression */
2237 }
2238 else
2239 {
2240 error(202, argidx); /* argument count mismatch */
2241 } /* if */
2242 if (arglist[argidx] == ARG_UNHANDLED)
2243 nargs++;
2244 arglist[argidx] = ARG_DONE;
2245 } /* for */
2246 /* now a second loop to catch the arguments with default values that are
2247 * the "sizeof" or "tagof" of other arguments
2248 */
2249 for (argidx = 0; arg[argidx].ident != 0 && arg[argidx].ident != iVARARGS;
2250 argidx++)
2251 {
2252 constvalue *asz;
2253 cell array_sz;
2254
2255 if (arglist[argidx] == ARG_DONE)
2256 continue; /* already seen and handled this argument */
2257 stgmark((char)(sEXPRSTART + argidx)); /* mark beginning of new expression in stage */
2258 assert(arg[argidx].ident == iVARIABLE); /* if "sizeof", must be single cell */
2259 /* if unseen, must be "sizeof" or "tagof" */
2260 assert((arg[argidx].hasdefault & uSIZEOF) != 0
2261 || (arg[argidx].hasdefault & uTAGOF) != 0);
2262 if ((arg[argidx].hasdefault & uSIZEOF) != 0)
2263 {
2264 /* find the argument; if it isn't found, the argument's default value
2265 * was a "sizeof" of a non-array (a warning for this was already given
2266 * when declaring the function)
2267 */
2268 asz = find_constval(&arrayszlst, arg[argidx].defvalue.size.symname,
2269 arg[argidx].defvalue.size.level);
2270 if (asz)
2271 {
2272 array_sz = asz->value;
2273 if (array_sz == 0)
2274 error(224, arg[argidx].name); /* indeterminate array size in "sizeof" expression */
2275 }
2276 else
2277 {
2278 array_sz = 1;
2279 } /* if */
2280 }
2281 else
2282 {
2283 symbol *sym;
2284
2285 assert((arg[argidx].hasdefault & uTAGOF) != 0);
2286 sym = findloc(arg[argidx].defvalue.size.symname);
2287 if (!sym)
2288 sym = findglb(arg[argidx].defvalue.size.symname);
2289 array_sz = (sym) ? sym->tag : 0;
2290 exporttag(array_sz);
2291 } /* if */
2292 const1(array_sz);
2293 push1(); /* store the function argument on the stack */
2294 endexpr(FALSE);
2295 if (arglist[argidx] == ARG_UNHANDLED)
2296 nargs++;
2297 arglist[argidx] = ARG_DONE;
2298 } /* for */
2299 stgmark(sENDREORDER); /* mark end of reversed evaluation */
2300 pushval((cell) nargs * sizeof(cell));
2301 ffcall(sym, nargs);
2302 if (sc_status != statSKIP)
2303 markusage(sym, uREAD); /* do not mark as "used" when this call itself is skipped */
2304 if (sym->x.lib)
2305 sym->x.lib->value += 1; /* increment "usage count" of the library */
2306 modheap(-heapalloc * sizeof(cell));
2307 sideeffect = TRUE; /* assume functions carry out a side-effect */
2308 delete_consttable(&arrayszlst); /* clear list of array sizes */
2309}
2310
2311/* dbltest
2312 *
2313 * Returns a non-zero value if lval1 an array and lval2 is not an array and
2314 * the operation is addition or subtraction.
2315 *
2316 * Returns the "shift" count (1 for 16-bit, 2 for 32-bit) to align a cell
2317 * to an array offset.
2318 */
2319static int
2320dbltest(void (*oper) (), value * lval1, value * lval2)
2321{
2322 if ((oper != ob_add) && (oper != ob_sub))
2323 return 0;
2324 if (lval1->ident != iARRAY)
2325 return 0;
2326 if (lval2->ident == iARRAY)
2327 return 0;
2328 return sizeof(cell) / 2; /* 1 for 16-bit, 2 for 32-bit */
2329}
2330
2331/* commutative
2332 *
2333 * Test whether an operator is commutative, i.e. x oper y == y oper x.
2334 * Commutative operators are: + (addition)
2335 * * (multiplication)
2336 * == (equality)
2337 * != (inequality)
2338 * & (bitwise and)
2339 * ^ (bitwise xor)
2340 * | (bitwise or)
2341 *
2342 * If in an expression, code for the left operand has been generated and
2343 * the right operand is a constant and the operator is commutative, the
2344 * precautionary "push" of the primary register is scrapped and the constant
2345 * is read into the secondary register immediately.
2346 */
2347static int
2348commutative(void (*oper) ())
2349{
2350 return oper == ob_add || oper == os_mult
2351 || oper == ob_eq || oper == ob_ne
2352 || oper == ob_and || oper == ob_xor || oper == ob_or;
2353}
2354
2355/* constant
2356 *
2357 * Generates code to fetch a number, a literal character (which is returned
2358 * by lex() as a number as well) or a literal string (lex() stores the
2359 * strings in the literal queue). If the operand was a number, it is stored
2360 * in lval->constval.
2361 *
2362 * The function returns 1 if the token was a constant or a string, 0
2363 * otherwise.
2364 */
2365static int
2366constant(value * lval)
2367{
2368 int tok, index, constant;
2369 cell val, item, cidx;
2370 char *st;
2371 symbol *sym;
2372
2373 tok = lex(&val, &st);
2374 if (tok == tSYMBOL && (sym = findconst(st)))
2375 {
2376 lval->constval = sym->addr;
2377 const1(lval->constval);
2378 lval->ident = iCONSTEXPR;
2379 lval->tag = sym->tag;
2380 markusage(sym, uREAD);
2381 }
2382 else if (tok == tNUMBER)
2383 {
2384 lval->constval = val;
2385 const1(lval->constval);
2386 lval->ident = iCONSTEXPR;
2387 }
2388 else if (tok == tRATIONAL)
2389 {
2390 lval->constval = val;
2391 const1(lval->constval);
2392 lval->ident = iCONSTEXPR;
2393 lval->tag = sc_rationaltag;
2394 }
2395 else if (tok == tSTRING)
2396 {
2397 /* lex() stores starting index of string in the literal table in 'val' */
2398 const1((val + glb_declared) * sizeof(cell));
2399 lval->ident = iARRAY; /* pretend this is a global array */
2400 lval->constval = val - litidx; /* constval == the negative value of the
2401 * size of the literal array; using a negative
2402 * value distinguishes between literal arrays
2403 * and literal strings (this was done for
2404 * array assignment). */
2405 }
2406 else if (tok == '{')
2407 {
2408 int tag, lasttag = -1;
2409
2410 val = litidx;
2411 do
2412 {
2413 /* cannot call constexpr() here, because "staging" is already turned
2414 * on at this point */
2415 assert(staging);
2416 stgget(&index, &cidx); /* mark position in code generator */
2417 expression(&constant, &item, &tag, FALSE);
2418 stgdel(index, cidx); /* scratch generated code */
2419 if (constant == 0)
2420 error(8); /* must be constant expression */
2421 if (lasttag < 0)
2422 lasttag = tag;
2423 else if (!matchtag(lasttag, tag, FALSE))
2424 error(213); /* tagname mismatch */
2425 stowlit(item); /* store expression result in literal table */
2426 }
2427 while (matchtoken(','));
2428 needtoken('}');
2429 const1((val + glb_declared) * sizeof(cell));
2430 lval->ident = iARRAY; /* pretend this is a global array */
2431 lval->constval = litidx - val; /* constval == the size of the literal array */
2432 }
2433 else
2434 {
2435 return FALSE; /* no, it cannot be interpreted as a constant */
2436 } /* if */
2437 return TRUE; /* yes, it was a constant value */
2438}
diff --git a/libraries/embryo/src/bin/embryo_cc_sc4.c b/libraries/embryo/src/bin/embryo_cc_sc4.c
new file mode 100644
index 0000000..0dedbfb
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc4.c
@@ -0,0 +1,1308 @@
1/* Small compiler - code generation (unoptimized "assembler" code)
2 *
3 * Copyright (c) ITB CompuPhase, 1997-2003
4 *
5 * This software is provided "as-is", without any express or implied warranty.
6 * In no event will the authors be held liable for any damages arising from
7 * the use of this software.
8 *
9 * Permission is granted to anyone to use this software for any purpose,
10 * including commercial applications, and to alter it and redistribute it
11 * freely, subject to the following restrictions:
12 *
13 * 1. The origin of this software must not be misrepresented; you must not
14 * claim that you wrote the original software. If you use this software in
15 * a product, an acknowledgment in the product documentation would be
16 * appreciated but is not required.
17 * 2. Altered source versions must be plainly marked as such, and must not be
18 * misrepresented as being the original software.
19 * 3. This notice may not be removed or altered from any source distribution.
20 *
21 * Version: $Id: embryo_cc_sc4.c 52451 2010-09-19 03:00:12Z raster $
22 */
23
24
25#ifdef HAVE_CONFIG_H
26# include <config.h>
27#endif
28
29#include <assert.h>
30#include <ctype.h>
31#include <stdio.h>
32#include <limits.h> /* for PATH_MAX */
33#include <string.h>
34
35#include "embryo_cc_sc.h"
36
37/* When a subroutine returns to address 0, the AMX must halt. In earlier
38 * releases, the RET and RETN opcodes checked for the special case 0 address.
39 * Today, the compiler simply generates a HALT instruction at address 0. So
40 * a subroutine can savely return to 0, and then encounter a HALT.
41 */
42void
43writeleader(void)
44{
45 assert(code_idx == 0);
46 stgwrite(";program exit point\n");
47 stgwrite("\thalt 0\n");
48 /* calculate code length */
49 code_idx += opcodes(1) + opargs(1);
50}
51
52/* writetrailer
53 * Not much left of this once important function.
54 *
55 * Global references: sc_stksize (referred to only)
56 * sc_dataalign (referred to only)
57 * code_idx (altered)
58 * glb_declared (altered)
59 */
60void
61writetrailer(void)
62{
63 assert(sc_dataalign % opcodes(1) == 0); /* alignment must be a multiple of
64 * the opcode size */
65 assert(sc_dataalign != 0);
66
67 /* pad code to align data segment */
68 if ((code_idx % sc_dataalign) != 0)
69 {
70 begcseg();
71 while ((code_idx % sc_dataalign) != 0)
72 nooperation();
73 } /* if */
74
75 /* pad data segment to align the stack and the heap */
76 assert(litidx == 0); /* literal queue should have been emptied */
77 assert(sc_dataalign % sizeof(cell) == 0);
78 if (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
79 {
80 begdseg();
81 defstorage();
82 while (((glb_declared * sizeof(cell)) % sc_dataalign) != 0)
83 {
84 stgwrite("0 ");
85 glb_declared++;
86 } /* while */
87 } /* if */
88
89 stgwrite("\nSTKSIZE "); /* write stack size (align stack top) */
90 outval(sc_stksize - (sc_stksize % sc_dataalign), TRUE);
91}
92
93/*
94 * Start (or restart) the CODE segment.
95 *
96 * In fact, the code and data segment specifiers are purely informational;
97 * the "DUMP" instruction itself already specifies that the following values
98 * should go to the data segment. All otherinstructions go to the code
99 * segment.
100 *
101 * Global references: curseg
102 */
103void
104begcseg(void)
105{
106 if (curseg != sIN_CSEG)
107 {
108 stgwrite("\n");
109 stgwrite("CODE\t; ");
110 outval(code_idx, TRUE);
111 curseg = sIN_CSEG;
112 } /* endif */
113}
114
115/*
116 * Start (or restart) the DATA segment.
117 *
118 * Global references: curseg
119 */
120void
121begdseg(void)
122{
123 if (curseg != sIN_DSEG)
124 {
125 stgwrite("\n");
126 stgwrite("DATA\t; ");
127 outval(glb_declared - litidx, TRUE);
128 curseg = sIN_DSEG;
129 } /* if */
130}
131
132void
133setactivefile(int fnumber)
134{
135 stgwrite("curfile ");
136 outval(fnumber, TRUE);
137}
138
139cell
140nameincells(char *name)
141{
142 cell clen =
143 (strlen(name) + sizeof(cell)) & ~(sizeof(cell) - 1);
144 return clen;
145}
146
147void
148setfile(char *name, int fileno)
149{
150 if ((sc_debug & sSYMBOLIC) != 0)
151 {
152 begcseg();
153 stgwrite("file ");
154 outval(fileno, FALSE);
155 stgwrite(" ");
156 stgwrite(name);
157 stgwrite("\n");
158 /* calculate code length */
159 code_idx += opcodes(1) + opargs(2) + nameincells(name);
160 } /* if */
161}
162
163void
164setline(int line, int fileno)
165{
166 if ((sc_debug & (sSYMBOLIC | sCHKBOUNDS)) != 0)
167 {
168 stgwrite("line ");
169 outval(line, FALSE);
170 stgwrite(" ");
171 outval(fileno, FALSE);
172 stgwrite("\t; ");
173 outval(code_idx, TRUE);
174 code_idx += opcodes(1) + opargs(2);
175 } /* if */
176}
177
178/* setlabel
179 *
180 * Post a code label (specified as a number), on a new line.
181 */
182void
183setlabel(int number)
184{
185 assert(number >= 0);
186 stgwrite("l.");
187 stgwrite((char *)itoh(number));
188 /* To assist verification of the assembled code, put the address of the
189 * label as a comment. However, labels that occur inside an expression
190 * may move (through optimization or through re-ordering). So write the
191 * address only if it is known to accurate.
192 */
193 if (!staging)
194 {
195 stgwrite("\t\t; ");
196 outval(code_idx, FALSE);
197 } /* if */
198 stgwrite("\n");
199}
200
201/* Write a token that signifies the end of an expression, or the end of a
202 * function parameter. This allows several simple optimizations by the peephole
203 * optimizer.
204 */
205void
206endexpr(int fullexpr)
207{
208 if (fullexpr)
209 stgwrite("\t;$exp\n");
210 else
211 stgwrite("\t;$par\n");
212}
213
214/* startfunc - declare a CODE entry point (function start)
215 *
216 * Global references: funcstatus (referred to only)
217 */
218void
219startfunc(char *fname __UNUSED__)
220{
221 stgwrite("\tproc");
222 stgwrite("\n");
223 code_idx += opcodes(1);
224}
225
226/* endfunc
227 *
228 * Declare a CODE ending point (function end)
229 */
230void
231endfunc(void)
232{
233 stgwrite("\n"); /* skip a line */
234}
235
236/* alignframe
237 *
238 * Aligns the frame (and the stack) of the current function to a multiple
239 * of the specified byte count. Two caveats: the alignment ("numbytes") should
240 * be a power of 2, and this alignment must be done right after the frame
241 * is set up (before the first variable is declared)
242 */
243void
244alignframe(int numbytes)
245{
246#if !defined NDEBUG
247 /* "numbytes" should be a power of 2 for this code to work */
248 int i, count = 0;
249
250 for (i = 0; i < (int)(sizeof(numbytes) * 8); i++)
251 if (numbytes & (1 << i))
252 count++;
253 assert(count == 1);
254#endif
255
256 stgwrite("\tlctrl 4\n"); /* get STK in PRI */
257 stgwrite("\tconst.alt "); /* get ~(numbytes-1) in ALT */
258 outval(~(numbytes - 1), TRUE);
259 stgwrite("\tand\n"); /* PRI = STK "and" ~(numbytes-1) */
260 stgwrite("\tsctrl 4\n"); /* set the new value of STK ... */
261 stgwrite("\tsctrl 5\n"); /* ... and FRM */
262 code_idx += opcodes(5) + opargs(4);
263}
264
265/* Define a variable or function
266 */
267void
268defsymbol(char *name, int ident, int vclass, cell offset, int tag)
269{
270 if ((sc_debug & sSYMBOLIC) != 0)
271 {
272 begcseg(); /* symbol definition in code segment */
273 stgwrite("symbol ");
274
275 stgwrite(name);
276 stgwrite(" ");
277
278 outval(offset, FALSE);
279 stgwrite(" ");
280
281 outval(vclass, FALSE);
282 stgwrite(" ");
283
284 outval(ident, TRUE);
285
286 code_idx += opcodes(1) + opargs(3) + nameincells(name); /* class and ident encoded in "flags" */
287
288 /* also write the optional tag */
289 if (tag != 0)
290 {
291 assert((tag & TAGMASK) != 0);
292 stgwrite("symtag ");
293 outval(tag & TAGMASK, TRUE);
294 code_idx += opcodes(1) + opargs(1);
295 } /* if */
296 } /* if */
297}
298
299void
300symbolrange(int level, cell size)
301{
302 if ((sc_debug & sSYMBOLIC) != 0)
303 {
304 begcseg(); /* symbol definition in code segment */
305 stgwrite("srange ");
306 outval(level, FALSE);
307 stgwrite(" ");
308 outval(size, TRUE);
309 code_idx += opcodes(1) + opargs(2);
310 } /* if */
311}
312
313/* rvalue
314 *
315 * Generate code to get the value of a symbol into "primary".
316 */
317void
318rvalue(value * lval)
319{
320 symbol *sym;
321
322 sym = lval->sym;
323 if (lval->ident == iARRAYCELL)
324 {
325 /* indirect fetch, address already in PRI */
326 stgwrite("\tload.i\n");
327 code_idx += opcodes(1);
328 }
329 else if (lval->ident == iARRAYCHAR)
330 {
331 /* indirect fetch of a character from a pack, address already in PRI */
332 stgwrite("\tlodb.i ");
333 outval(charbits / 8, TRUE); /* read one or two bytes */
334 code_idx += opcodes(1) + opargs(1);
335 }
336 else if (lval->ident == iREFERENCE)
337 {
338 /* indirect fetch, but address not yet in PRI */
339 assert(sym != NULL);
340 assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
341 if (sym->vclass == sLOCAL)
342 stgwrite("\tlref.s.pri ");
343 else
344 stgwrite("\tlref.pri ");
345 outval(sym->addr, TRUE);
346 markusage(sym, uREAD);
347 code_idx += opcodes(1) + opargs(1);
348 }
349 else
350 {
351 /* direct or stack relative fetch */
352 assert(sym != NULL);
353 if (sym->vclass == sLOCAL)
354 stgwrite("\tload.s.pri ");
355 else
356 stgwrite("\tload.pri ");
357 outval(sym->addr, TRUE);
358 markusage(sym, uREAD);
359 code_idx += opcodes(1) + opargs(1);
360 } /* if */
361}
362
363/*
364 * Get the address of a symbol into the primary register (used for arrays,
365 * and for passing arguments by reference).
366 */
367void
368address(symbol * sym)
369{
370 assert(sym != NULL);
371 /* the symbol can be a local array, a global array, or an array
372 * that is passed by reference.
373 */
374 if (sym->ident == iREFARRAY || sym->ident == iREFERENCE)
375 {
376 /* reference to a variable or to an array; currently this is
377 * always a local variable */
378 stgwrite("\tload.s.pri ");
379 }
380 else
381 {
382 /* a local array or local variable */
383 if (sym->vclass == sLOCAL)
384 stgwrite("\taddr.pri ");
385 else
386 stgwrite("\tconst.pri ");
387 } /* if */
388 outval(sym->addr, TRUE);
389 markusage(sym, uREAD);
390 code_idx += opcodes(1) + opargs(1);
391}
392
393/* store
394 *
395 * Saves the contents of "primary" into a memory cell, either directly
396 * or indirectly (at the address given in the alternate register).
397 */
398void
399store(value * lval)
400{
401 symbol *sym;
402
403 sym = lval->sym;
404 if (lval->ident == iARRAYCELL)
405 {
406 /* store at address in ALT */
407 stgwrite("\tstor.i\n");
408 code_idx += opcodes(1);
409 }
410 else if (lval->ident == iARRAYCHAR)
411 {
412 /* store at address in ALT */
413 stgwrite("\tstrb.i ");
414 outval(charbits / 8, TRUE); /* write one or two bytes */
415 code_idx += opcodes(1) + opargs(1);
416 }
417 else if (lval->ident == iREFERENCE)
418 {
419 assert(sym != NULL);
420 if (sym->vclass == sLOCAL)
421 stgwrite("\tsref.s.pri ");
422 else
423 stgwrite("\tsref.pri ");
424 outval(sym->addr, TRUE);
425 code_idx += opcodes(1) + opargs(1);
426 }
427 else
428 {
429 assert(sym != NULL);
430 markusage(sym, uWRITTEN);
431 if (sym->vclass == sLOCAL)
432 stgwrite("\tstor.s.pri ");
433 else
434 stgwrite("\tstor.pri ");
435 outval(sym->addr, TRUE);
436 code_idx += opcodes(1) + opargs(1);
437 } /* if */
438}
439
440/* source must in PRI, destination address in ALT. The "size"
441 * parameter is in bytes, not cells.
442 */
443void
444memcopy(cell size)
445{
446 stgwrite("\tmovs ");
447 outval(size, TRUE);
448
449 code_idx += opcodes(1) + opargs(1);
450}
451
452/* Address of the source must already have been loaded in PRI
453 * "size" is the size in bytes (not cells).
454 */
455void
456copyarray(symbol * sym, cell size)
457{
458 assert(sym != NULL);
459 /* the symbol can be a local array, a global array, or an array
460 * that is passed by reference.
461 */
462 if (sym->ident == iREFARRAY)
463 {
464 /* reference to an array; currently this is always a local variable */
465 assert(sym->vclass == sLOCAL); /* symbol must be stack relative */
466 stgwrite("\tload.s.alt ");
467 }
468 else
469 {
470 /* a local or global array */
471 if (sym->vclass == sLOCAL)
472 stgwrite("\taddr.alt ");
473 else
474 stgwrite("\tconst.alt ");
475 } /* if */
476 outval(sym->addr, TRUE);
477 markusage(sym, uWRITTEN);
478
479 code_idx += opcodes(1) + opargs(1);
480 memcopy(size);
481}
482
483void
484fillarray(symbol * sym, cell size, cell val)
485{
486 const1(val); /* load val in PRI */
487
488 assert(sym != NULL);
489 /* the symbol can be a local array, a global array, or an array
490 * that is passed by reference.
491 */
492 if (sym->ident == iREFARRAY)
493 {
494 /* reference to an array; currently this is always a local variable */
495 assert(sym->vclass == sLOCAL); /* symbol must be stack relative */
496 stgwrite("\tload.s.alt ");
497 }
498 else
499 {
500 /* a local or global array */
501 if (sym->vclass == sLOCAL)
502 stgwrite("\taddr.alt ");
503 else
504 stgwrite("\tconst.alt ");
505 } /* if */
506 outval(sym->addr, TRUE);
507 markusage(sym, uWRITTEN);
508
509 stgwrite("\tfill ");
510 outval(size, TRUE);
511
512 code_idx += opcodes(2) + opargs(2);
513}
514
515/*
516 * Instruction to get an immediate value into the primary register
517 */
518void
519const1(cell val)
520{
521 if (val == 0)
522 {
523 stgwrite("\tzero.pri\n");
524 code_idx += opcodes(1);
525 }
526 else
527 {
528 stgwrite("\tconst.pri ");
529 outval(val, TRUE);
530 code_idx += opcodes(1) + opargs(1);
531 } /* if */
532}
533
534/*
535 * Instruction to get an immediate value into the secondary register
536 */
537void
538const2(cell val)
539{
540 if (val == 0)
541 {
542 stgwrite("\tzero.alt\n");
543 code_idx += opcodes(1);
544 }
545 else
546 {
547 stgwrite("\tconst.alt ");
548 outval(val, TRUE);
549 code_idx += opcodes(1) + opargs(1);
550 } /* if */
551}
552
553/* Copy value in secondary register to the primary register */
554void
555moveto1(void)
556{
557 stgwrite("\tmove.pri\n");
558 code_idx += opcodes(1) + opargs(0);
559}
560
561/*
562 * Push primary register onto the stack
563 */
564void
565push1(void)
566{
567 stgwrite("\tpush.pri\n");
568 code_idx += opcodes(1);
569}
570
571/*
572 * Push alternate register onto the stack
573 */
574void
575push2(void)
576{
577 stgwrite("\tpush.alt\n");
578 code_idx += opcodes(1);
579}
580
581/*
582 * Push a constant value onto the stack
583 */
584void
585pushval(cell val)
586{
587 stgwrite("\tpush.c ");
588 outval(val, TRUE);
589 code_idx += opcodes(1) + opargs(1);
590}
591
592/*
593 * pop stack to the primary register
594 */
595void
596pop1(void)
597{
598 stgwrite("\tpop.pri\n");
599 code_idx += opcodes(1);
600}
601
602/*
603 * pop stack to the secondary register
604 */
605void
606pop2(void)
607{
608 stgwrite("\tpop.alt\n");
609 code_idx += opcodes(1);
610}
611
612/*
613 * swap the top-of-stack with the value in primary register
614 */
615void
616swap1(void)
617{
618 stgwrite("\tswap.pri\n");
619 code_idx += opcodes(1);
620}
621
622/* Switch statements
623 * The "switch" statement generates a "case" table using the "CASE" opcode.
624 * The case table contains a list of records, each record holds a comparison
625 * value and a label to branch to on a match. The very first record is an
626 * exception: it holds the size of the table (excluding the first record) and
627 * the label to branch to when none of the values in the case table match.
628 * The case table is sorted on the comparison value. This allows more advanced
629 * abstract machines to sift the case table with a binary search.
630 */
631void
632ffswitch(int label)
633{
634 stgwrite("\tswitch ");
635 outval(label, TRUE); /* the label is the address of the case table */
636 code_idx += opcodes(1) + opargs(1);
637}
638
639void
640ffcase(cell val, char *labelname, int newtable)
641{
642 if (newtable)
643 {
644 stgwrite("\tcasetbl\n");
645 code_idx += opcodes(1);
646 } /* if */
647 stgwrite("\tcase ");
648 outval(val, FALSE);
649 stgwrite(" ");
650 stgwrite(labelname);
651 stgwrite("\n");
652 code_idx += opcodes(0) + opargs(2);
653}
654
655/*
656 * Call specified function
657 */
658void
659ffcall(symbol * sym, int numargs)
660{
661 assert(sym != NULL);
662 assert(sym->ident == iFUNCTN);
663 if ((sym->usage & uNATIVE) != 0)
664 {
665 /* reserve a SYSREQ id if called for the first time */
666 if (sc_status == statWRITE && (sym->usage & uREAD) == 0
667 && sym->addr >= 0)
668 sym->addr = ntv_funcid++;
669 stgwrite("\tsysreq.c ");
670 outval(sym->addr, FALSE);
671 stgwrite("\n\tstack ");
672 outval((numargs + 1) * sizeof(cell), TRUE);
673 code_idx += opcodes(2) + opargs(2);
674 }
675 else
676 {
677 /* normal function */
678 stgwrite("\tcall ");
679 stgwrite(sym->name);
680 stgwrite("\n");
681 code_idx += opcodes(1) + opargs(1);
682 } /* if */
683}
684
685/* Return from function
686 *
687 * Global references: funcstatus (referred to only)
688 */
689void
690ffret(void)
691{
692 stgwrite("\tretn\n");
693 code_idx += opcodes(1);
694}
695
696void
697ffabort(int reason)
698{
699 stgwrite("\thalt ");
700 outval(reason, TRUE);
701 code_idx += opcodes(1) + opargs(1);
702}
703
704void
705ffbounds(cell size)
706{
707 if ((sc_debug & sCHKBOUNDS) != 0)
708 {
709 stgwrite("\tbounds ");
710 outval(size, TRUE);
711 code_idx += opcodes(1) + opargs(1);
712 } /* if */
713}
714
715/*
716 * Jump to local label number (the number is converted to a name)
717 */
718void
719jumplabel(int number)
720{
721 stgwrite("\tjump ");
722 outval(number, TRUE);
723 code_idx += opcodes(1) + opargs(1);
724}
725
726/*
727 * Define storage (global and static variables)
728 */
729void
730defstorage(void)
731{
732 stgwrite("dump ");
733}
734
735/*
736 * Inclrement/decrement stack pointer. Note that this routine does
737 * nothing if the delta is zero.
738 */
739void
740modstk(int delta)
741{
742 if (delta)
743 {
744 stgwrite("\tstack ");
745 outval(delta, TRUE);
746 code_idx += opcodes(1) + opargs(1);
747 } /* if */
748}
749
750/* set the stack to a hard offset from the frame */
751void
752setstk(cell val)
753{
754 stgwrite("\tlctrl 5\n"); /* get FRM */
755 assert(val <= 0); /* STK should always become <= FRM */
756 if (val < 0)
757 {
758 stgwrite("\tadd.c ");
759 outval(val, TRUE); /* add (negative) offset */
760 code_idx += opcodes(1) + opargs(1);
761 // ??? write zeros in the space between STK and the val in PRI (the new stk)
762 // get val of STK in ALT
763 // zero PRI
764 // need new FILL opcode that takes a variable size
765 } /* if */
766 stgwrite("\tsctrl 4\n"); /* store in STK */
767 code_idx += opcodes(2) + opargs(2);
768}
769
770void
771modheap(int delta)
772{
773 if (delta)
774 {
775 stgwrite("\theap ");
776 outval(delta, TRUE);
777 code_idx += opcodes(1) + opargs(1);
778 } /* if */
779}
780
781void
782setheap_pri(void)
783{
784 stgwrite("\theap "); /* ALT = HEA++ */
785 outval(sizeof(cell), TRUE);
786 stgwrite("\tstor.i\n"); /* store PRI (default value) at address ALT */
787 stgwrite("\tmove.pri\n"); /* move ALT to PRI: PRI contains the address */
788 code_idx += opcodes(3) + opargs(1);
789}
790
791void
792setheap(cell val)
793{
794 stgwrite("\tconst.pri "); /* load default val in PRI */
795 outval(val, TRUE);
796 code_idx += opcodes(1) + opargs(1);
797 setheap_pri();
798}
799
800/*
801 * Convert a cell number to a "byte" address; i.e. double or quadruple
802 * the primary register.
803 */
804void
805cell2addr(void)
806{
807#if defined(BIT16)
808 stgwrite("\tshl.c.pri 1\n");
809#else
810 stgwrite("\tshl.c.pri 2\n");
811#endif
812 code_idx += opcodes(1) + opargs(1);
813}
814
815/*
816 * Double or quadruple the alternate register.
817 */
818void
819cell2addr_alt(void)
820{
821#if defined(BIT16)
822 stgwrite("\tshl.c.alt 1\n");
823#else
824 stgwrite("\tshl.c.alt 2\n");
825#endif
826 code_idx += opcodes(1) + opargs(1);
827}
828
829/*
830 * Convert "distance of addresses" to "number of cells" in between.
831 * Or convert a number of packed characters to the number of cells (with
832 * truncation).
833 */
834void
835addr2cell(void)
836{
837#if defined(BIT16)
838 stgwrite("\tshr.c.pri 1\n");
839#else
840 stgwrite("\tshr.c.pri 2\n");
841#endif
842 code_idx += opcodes(1) + opargs(1);
843}
844
845/* Convert from character index to byte address. This routine does
846 * nothing if a character has the size of a byte.
847 */
848void
849char2addr(void)
850{
851 if (charbits == 16)
852 {
853 stgwrite("\tshl.c.pri 1\n");
854 code_idx += opcodes(1) + opargs(1);
855 } /* if */
856}
857
858/* Align PRI (which should hold a character index) to an address.
859 * The first character in a "pack" occupies the highest bits of
860 * the cell. This is at the lower memory address on Big Endian
861 * computers and on the higher address on Little Endian computers.
862 * The ALIGN.pri/alt instructions must solve this machine dependence;
863 * that is, on Big Endian computers, ALIGN.pri/alt shuold do nothing
864 * and on Little Endian computers they should toggle the address.
865 */
866void
867charalign(void)
868{
869 stgwrite("\talign.pri ");
870 outval(charbits / 8, TRUE);
871 code_idx += opcodes(1) + opargs(1);
872}
873
874/*
875 * Add a constant to the primary register.
876 */
877void
878addconst(cell val)
879{
880 if (val != 0)
881 {
882 stgwrite("\tadd.c ");
883 outval(val, TRUE);
884 code_idx += opcodes(1) + opargs(1);
885 } /* if */
886}
887
888/*
889 * signed multiply of primary and secundairy registers (result in primary)
890 */
891void
892os_mult(void)
893{
894 stgwrite("\tsmul\n");
895 code_idx += opcodes(1);
896}
897
898/*
899 * signed divide of alternate register by primary register (quotient in
900 * primary; remainder in alternate)
901 */
902void
903os_div(void)
904{
905 stgwrite("\tsdiv.alt\n");
906 code_idx += opcodes(1);
907}
908
909/*
910 * modulus of (alternate % primary), result in primary (signed)
911 */
912void
913os_mod(void)
914{
915 stgwrite("\tsdiv.alt\n");
916 stgwrite("\tmove.pri\n"); /* move ALT to PRI */
917 code_idx += opcodes(2);
918}
919
920/*
921 * Add primary and alternate registers (result in primary).
922 */
923void
924ob_add(void)
925{
926 stgwrite("\tadd\n");
927 code_idx += opcodes(1);
928}
929
930/*
931 * subtract primary register from alternate register (result in primary)
932 */
933void
934ob_sub(void)
935{
936 stgwrite("\tsub.alt\n");
937 code_idx += opcodes(1);
938}
939
940/*
941 * arithmic shift left alternate register the number of bits
942 * given in the primary register (result in primary).
943 * There is no need for a "logical shift left" routine, since
944 * logical shift left is identical to arithmic shift left.
945 */
946void
947ob_sal(void)
948{
949 stgwrite("\txchg\n");
950 stgwrite("\tshl\n");
951 code_idx += opcodes(2);
952}
953
954/*
955 * arithmic shift right alternate register the number of bits
956 * given in the primary register (result in primary).
957 */
958void
959os_sar(void)
960{
961 stgwrite("\txchg\n");
962 stgwrite("\tsshr\n");
963 code_idx += opcodes(2);
964}
965
966/*
967 * logical (unsigned) shift right of the alternate register by the
968 * number of bits given in the primary register (result in primary).
969 */
970void
971ou_sar(void)
972{
973 stgwrite("\txchg\n");
974 stgwrite("\tshr\n");
975 code_idx += opcodes(2);
976}
977
978/*
979 * inclusive "or" of primary and secondary registers (result in primary)
980 */
981void
982ob_or(void)
983{
984 stgwrite("\tor\n");
985 code_idx += opcodes(1);
986}
987
988/*
989 * "exclusive or" of primary and alternate registers (result in primary)
990 */
991void
992ob_xor(void)
993{
994 stgwrite("\txor\n");
995 code_idx += opcodes(1);
996}
997
998/*
999 * "and" of primary and secundairy registers (result in primary)
1000 */
1001void
1002ob_and(void)
1003{
1004 stgwrite("\tand\n");
1005 code_idx += opcodes(1);
1006}
1007
1008/*
1009 * test ALT==PRI; result in primary register (1 or 0).
1010 */
1011void
1012ob_eq(void)
1013{
1014 stgwrite("\teq\n");
1015 code_idx += opcodes(1);
1016}
1017
1018/*
1019 * test ALT!=PRI
1020 */
1021void
1022ob_ne(void)
1023{
1024 stgwrite("\tneq\n");
1025 code_idx += opcodes(1);
1026}
1027
1028/* The abstract machine defines the relational instructions so that PRI is
1029 * on the left side and ALT on the right side of the operator. For example,
1030 * SLESS sets PRI to either 1 or 0 depending on whether the expression
1031 * "PRI < ALT" is true.
1032 *
1033 * The compiler generates comparisons with ALT on the left side of the
1034 * relational operator and PRI on the right side. The XCHG instruction
1035 * prefixing the relational operators resets this. We leave it to the
1036 * peephole optimizer to choose more compact instructions where possible.
1037 */
1038
1039/* Relational operator prefix for chained relational expressions. The
1040 * "suffix" code restores the stack.
1041 * For chained relational operators, the goal is to keep the comparison
1042 * result "so far" in PRI and the value of the most recent operand in
1043 * ALT, ready for a next comparison.
1044 * The "prefix" instruction pushed the comparison result (PRI) onto the
1045 * stack and moves the value of ALT into PRI. If there is a next comparison,
1046 * PRI can now serve as the "left" operand of the relational operator.
1047 */
1048void
1049relop_prefix(void)
1050{
1051 stgwrite("\tpush.pri\n");
1052 stgwrite("\tmove.pri\n");
1053 code_idx += opcodes(2);
1054}
1055
1056void
1057relop_suffix(void)
1058{
1059 stgwrite("\tswap.alt\n");
1060 stgwrite("\tand\n");
1061 stgwrite("\tpop.alt\n");
1062 code_idx += opcodes(3);
1063}
1064
1065/*
1066 * test ALT<PRI (signed)
1067 */
1068void
1069os_lt(void)
1070{
1071 stgwrite("\txchg\n");
1072 stgwrite("\tsless\n");
1073 code_idx += opcodes(2);
1074}
1075
1076/*
1077 * test ALT<=PRI (signed)
1078 */
1079void
1080os_le(void)
1081{
1082 stgwrite("\txchg\n");
1083 stgwrite("\tsleq\n");
1084 code_idx += opcodes(2);
1085}
1086
1087/*
1088 * test ALT>PRI (signed)
1089 */
1090void
1091os_gt(void)
1092{
1093 stgwrite("\txchg\n");
1094 stgwrite("\tsgrtr\n");
1095 code_idx += opcodes(2);
1096}
1097
1098/*
1099 * test ALT>=PRI (signed)
1100 */
1101void
1102os_ge(void)
1103{
1104 stgwrite("\txchg\n");
1105 stgwrite("\tsgeq\n");
1106 code_idx += opcodes(2);
1107}
1108
1109/*
1110 * logical negation of primary register
1111 */
1112void
1113lneg(void)
1114{
1115 stgwrite("\tnot\n");
1116 code_idx += opcodes(1);
1117}
1118
1119/*
1120 * two's complement primary register
1121 */
1122void
1123neg(void)
1124{
1125 stgwrite("\tneg\n");
1126 code_idx += opcodes(1);
1127}
1128
1129/*
1130 * one's complement of primary register
1131 */
1132void
1133invert(void)
1134{
1135 stgwrite("\tinvert\n");
1136 code_idx += opcodes(1);
1137}
1138
1139/*
1140 * nop
1141 */
1142void
1143nooperation(void)
1144{
1145 stgwrite("\tnop\n");
1146 code_idx += opcodes(1);
1147}
1148
1149/* increment symbol
1150 */
1151void
1152inc(value * lval)
1153{
1154 symbol *sym;
1155
1156 sym = lval->sym;
1157 if (lval->ident == iARRAYCELL)
1158 {
1159 /* indirect increment, address already in PRI */
1160 stgwrite("\tinc.i\n");
1161 code_idx += opcodes(1);
1162 }
1163 else if (lval->ident == iARRAYCHAR)
1164 {
1165 /* indirect increment of single character, address already in PRI */
1166 stgwrite("\tpush.pri\n");
1167 stgwrite("\tpush.alt\n");
1168 stgwrite("\tmove.alt\n"); /* copy address */
1169 stgwrite("\tlodb.i "); /* read from PRI into PRI */
1170 outval(charbits / 8, TRUE); /* read one or two bytes */
1171 stgwrite("\tinc.pri\n");
1172 stgwrite("\tstrb.i "); /* write PRI to ALT */
1173 outval(charbits / 8, TRUE); /* write one or two bytes */
1174 stgwrite("\tpop.alt\n");
1175 stgwrite("\tpop.pri\n");
1176 code_idx += opcodes(8) + opargs(2);
1177 }
1178 else if (lval->ident == iREFERENCE)
1179 {
1180 assert(sym != NULL);
1181 stgwrite("\tpush.pri\n");
1182 /* load dereferenced value */
1183 assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
1184 if (sym->vclass == sLOCAL)
1185 stgwrite("\tlref.s.pri ");
1186 else
1187 stgwrite("\tlref.pri ");
1188 outval(sym->addr, TRUE);
1189 /* increment */
1190 stgwrite("\tinc.pri\n");
1191 /* store dereferenced value */
1192 if (sym->vclass == sLOCAL)
1193 stgwrite("\tsref.s.pri ");
1194 else
1195 stgwrite("\tsref.pri ");
1196 outval(sym->addr, TRUE);
1197 stgwrite("\tpop.pri\n");
1198 code_idx += opcodes(5) + opargs(2);
1199 }
1200 else
1201 {
1202 /* local or global variable */
1203 assert(sym != NULL);
1204 if (sym->vclass == sLOCAL)
1205 stgwrite("\tinc.s ");
1206 else
1207 stgwrite("\tinc ");
1208 outval(sym->addr, TRUE);
1209 code_idx += opcodes(1) + opargs(1);
1210 } /* if */
1211}
1212
1213/* decrement symbol
1214 *
1215 * in case of an integer pointer, the symbol must be incremented by 2.
1216 */
1217void
1218dec(value * lval)
1219{
1220 symbol *sym;
1221
1222 sym = lval->sym;
1223 if (lval->ident == iARRAYCELL)
1224 {
1225 /* indirect decrement, address already in PRI */
1226 stgwrite("\tdec.i\n");
1227 code_idx += opcodes(1);
1228 }
1229 else if (lval->ident == iARRAYCHAR)
1230 {
1231 /* indirect decrement of single character, address already in PRI */
1232 stgwrite("\tpush.pri\n");
1233 stgwrite("\tpush.alt\n");
1234 stgwrite("\tmove.alt\n"); /* copy address */
1235 stgwrite("\tlodb.i "); /* read from PRI into PRI */
1236 outval(charbits / 8, TRUE); /* read one or two bytes */
1237 stgwrite("\tdec.pri\n");
1238 stgwrite("\tstrb.i "); /* write PRI to ALT */
1239 outval(charbits / 8, TRUE); /* write one or two bytes */
1240 stgwrite("\tpop.alt\n");
1241 stgwrite("\tpop.pri\n");
1242 code_idx += opcodes(8) + opargs(2);
1243 }
1244 else if (lval->ident == iREFERENCE)
1245 {
1246 assert(sym != NULL);
1247 stgwrite("\tpush.pri\n");
1248 /* load dereferenced value */
1249 assert(sym->vclass == sLOCAL); /* global references don't exist in Small */
1250 if (sym->vclass == sLOCAL)
1251 stgwrite("\tlref.s.pri ");
1252 else
1253 stgwrite("\tlref.pri ");
1254 outval(sym->addr, TRUE);
1255 /* decrement */
1256 stgwrite("\tdec.pri\n");
1257 /* store dereferenced value */
1258 if (sym->vclass == sLOCAL)
1259 stgwrite("\tsref.s.pri ");
1260 else
1261 stgwrite("\tsref.pri ");
1262 outval(sym->addr, TRUE);
1263 stgwrite("\tpop.pri\n");
1264 code_idx += opcodes(5) + opargs(2);
1265 }
1266 else
1267 {
1268 /* local or global variable */
1269 assert(sym != NULL);
1270 if (sym->vclass == sLOCAL)
1271 stgwrite("\tdec.s ");
1272 else
1273 stgwrite("\tdec ");
1274 outval(sym->addr, TRUE);
1275 code_idx += opcodes(1) + opargs(1);
1276 } /* if */
1277}
1278
1279/*
1280 * Jumps to "label" if PRI != 0
1281 */
1282void
1283jmp_ne0(int number)
1284{
1285 stgwrite("\tjnz ");
1286 outval(number, TRUE);
1287 code_idx += opcodes(1) + opargs(1);
1288}
1289
1290/*
1291 * Jumps to "label" if PRI == 0
1292 */
1293void
1294jmp_eq0(int number)
1295{
1296 stgwrite("\tjzer ");
1297 outval(number, TRUE);
1298 code_idx += opcodes(1) + opargs(1);
1299}
1300
1301/* write a value in hexadecimal; optionally adds a newline */
1302void
1303outval(cell val, int newline)
1304{
1305 stgwrite(itoh(val));
1306 if (newline)
1307 stgwrite("\n");
1308}
diff --git a/libraries/embryo/src/bin/embryo_cc_sc5.c b/libraries/embryo/src/bin/embryo_cc_sc5.c
new file mode 100644
index 0000000..57b1744
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc5.c
@@ -0,0 +1,154 @@
1/* Small compiler - Error message system
2 * In fact a very simple system, using only 'panic mode'.
3 *
4 * Copyright (c) ITB CompuPhase, 1997-2003
5 *
6 * This software is provided "as-is", without any express or implied warranty.
7 * In no event will the authors be held liable for any damages arising from
8 * the use of this software.
9 *
10 * Permission is granted to anyone to use this software for any purpose,
11 * including commercial applications, and to alter it and redistribute it
12 * freely, subject to the following restrictions:
13 *
14 * 1. The origin of this software must not be misrepresented; you must not
15 * claim that you wrote the original software. If you use this software in
16 * a product, an acknowledgment in the product documentation would be
17 * appreciated but is not required.
18 * 2. Altered source versions must be plainly marked as such, and must not be
19 * misrepresented as being the original software.
20 * 3. This notice may not be removed or altered from any source distribution.
21 *
22 * Version: $Id: embryo_cc_sc5.c 61433 2011-07-16 23:19:02Z caro $
23 */
24
25
26#ifdef HAVE_CONFIG_H
27# include <config.h>
28#endif
29
30#include <stdio.h>
31#include <stdlib.h>
32#include <stdarg.h>
33#include <string.h>
34
35#ifdef HAVE_UNISTD_H
36# include <unistd.h>
37#endif
38
39#include "embryo_cc_sc.h"
40#include "embryo_cc_sc5.scp"
41
42static int errflag;
43static int errstart; /* line number at which the instruction started */
44
45/* error
46 *
47 * Outputs an error message (note: msg is passed optionally).
48 * If an error is found, the variable "errflag" is set and subsequent
49 * errors are ignored until lex() finds a semicolumn or a keyword
50 * (lex() resets "errflag" in that case).
51 *
52 * Global references: inpfname (referred to only)
53 * fline (referred to only)
54 * fcurrent (referred to only)
55 * errflag (altered)
56 */
57int
58error(int number, ...)
59{
60 static int lastline, lastfile, errorcount;
61 char *msg;
62 va_list argptr;
63 char string[1024];
64 int start;
65
66 /* errflag is reset on each semicolon.
67 * In a two-pass compiler, an error should not be reported twice. Therefore
68 * the error reporting is enabled only in the second pass (and only when
69 * actually producing output). Fatal errors may never be ignored.
70 */
71 if (((errflag) || (sc_status != statWRITE)) &&
72 ((number < 100) || (number >= 200)))
73 return 0;
74
75 if (number < 100)
76 {
77 msg = errmsg[number - 1];
78 errflag = TRUE; /* set errflag (skip rest of erroneous expression) */
79 errnum++;
80 }
81 else if (number < 200)
82 {
83 msg = fatalmsg[number - 100];
84 errnum++; /* a fatal error also counts as an error */
85 }
86 else
87 {
88 msg = warnmsg[number - 200];
89 warnnum++;
90 }
91
92 strexpand(string, (unsigned char *)msg, sizeof string, SCPACK_TABLE);
93
94 va_start(argptr, number);
95
96 start = (errstart == fline) ? -1 : errstart;
97
98 if (sc_error(number, string, inpfname, start, fline, argptr))
99 {
100 sc_closeasm(outf);
101 outf = NULL;
102 longjmp(errbuf, 3);
103 }
104
105 va_end(argptr);
106
107 if (((number >= 100) && (number < 200)) || (errnum > 250))
108 {
109 va_start(argptr, number);
110 sc_error(0, "\nCompilation aborted.", NULL, 0, 0, argptr);
111 va_end(argptr);
112
113 if (outf)
114 {
115 sc_closeasm(outf);
116 outf = NULL;
117 } /* if */
118 longjmp(errbuf, 2); /* fatal error, quit */
119 } /* if */
120
121 /* check whether we are seeing many errors on the same line */
122 if (((errstart < 0) && (lastline != fline)) ||
123 (lastline < errstart) || (lastline > fline) || (fcurrent != lastfile))
124 errorcount = 0;
125 lastline = fline;
126 lastfile = fcurrent;
127 if (number < 200)
128 errorcount++;
129 if (errorcount >= 3)
130 error(107); /* too many error/warning messages on one line */
131 return 0;
132}
133
134void
135errorset(int code)
136{
137 switch (code)
138 {
139 case sRESET:
140 errflag = FALSE; /* start reporting errors */
141 break;
142 case sFORCESET:
143 errflag = TRUE; /* stop reporting errors */
144 break;
145 case sEXPRMARK:
146 errstart = fline; /* save start line number */
147 break;
148 case sEXPRRELEASE:
149 errstart = -1; /* forget start line number */
150 break;
151 default:
152 break;
153 }
154}
diff --git a/libraries/embryo/src/bin/embryo_cc_sc5.scp b/libraries/embryo/src/bin/embryo_cc_sc5.scp
new file mode 100644
index 0000000..af3f352
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc5.scp
@@ -0,0 +1,317 @@
1/* Small compiler - Error message strings (plain and compressed formats)
2 *
3 * Copyright (c) ITB CompuPhase, 2000-2003
4 *
5 * This software is provided "as-is", without any express or implied warranty.
6 * In no event will the authors be held liable for any damages arising from
7 * the use of this software.
8 *
9 * Permission is granted to anyone to use this software for any purpose,
10 * including commercial applications, and to alter it and redistribute it
11 * freely, subject to the following restrictions:
12 *
13 * 1. The origin of this software must not be misrepresented; you must not
14 * claim that you wrote the original software. If you use this software in
15 * a product, an acknowledgment in the product documentation would be
16 * appreciated but is not required.
17 * 2. Altered source versions must be plainly marked as such, and must not be
18 * misrepresented as being the original software.
19 * 3. This notice may not be removed or altered from any source distribution.
20 *
21 * Version: $Id: embryo_cc_sc5.scp 35497 2008-08-17 07:44:18Z raster $
22 */
23
24int strexpand(char *dest, unsigned char *source, int maxlen,
25 unsigned char pairtable[128][2]);
26
27#define SCPACK_TABLE errstr_table
28/*-*SCPACK start of pair table, do not change or remove this line */
29unsigned char errstr_table[][2] = {
30 {101, 32}, {116, 32}, {111, 110}, {105, 110}, {97, 114}, {100, 32}, {105,
31 130},
32 {101, 114}, {101, 110}, {115, 32}, {97, 108}, {97, 116}, {117, 110}, {115,
33 34},
34 {37, 141}, {34, 142},
35 {109, 136}, {121, 32}, {97, 110}, {114, 101}, {99, 116}, {134, 32}, {110,
36 111},
37 {101, 133}, {118, 138}, {115, 105}, {98, 108}, {111, 114}, {115, 116},
38 {41, 10}, {109, 98}, {100, 101},
39 {117, 115}, {150, 129}, {102, 140}, {117, 144}, {162, 148}, {103, 163}, {132,
40 165},
41 {114, 97}, {105, 133}, {152, 168}, {99, 104}, {32, 143}, {97, 32}, {131,
42 169},
43 {97, 115}, {164, 149},
44 {111, 108}, {101, 120}, {97, 154}, {135, 32}, {132, 167}, {111, 102}, {105,
45 116},
46 {166, 129}, {101, 100}, {98, 128}, {178, 128}, {160, 129}, {105, 137},
47 {180, 145}, {121, 158}, {190, 176},
48 {109, 187}, {115, 191}, {118, 132}, {101, 10}, {115, 10}, {112, 147}, {155,
49 32},
50 {181, 32}, {159, 102}, {194, 105}, {99, 130}, {103, 32}, {201, 186}, {116,
51 111},
52 {34, 32}, {109, 97},
53 {153, 122}, {171, 10}, {104, 97}, {100, 105}, {108, 111}, {111, 112}, {200,
54 131},
55 {139, 134}, {213, 135}, {101, 137}, {202, 156}, {143, 157}, {138, 32},
56 {192, 185}, {58, 209}, {105, 99},
57 {112, 111}, {115, 115}, {110, 117}, {115, 117}, {146, 129}, {226, 158}, {229,
58 179},
59 {177, 197}, {231, 225}, {132, 97}, {98, 101}, {99, 111}, {216, 139}, {109,
60 139},
61 {116, 10}, {99, 146},
62 {44, 32}, {237, 170}, {131, 203}, {116, 104}, {117, 108}, {152, 117}, {108,
63 128},
64 {118, 128}, {101, 144}, {233, 148}, {174, 153}, {110, 32}, {131, 32},
65 {146, 32}, {239, 161}
66};
67/*-*SCPACK end of pair table, do not change or remove this line */
68
69static char *errmsg[] = {
70#ifdef SCPACK
71/*001*/ "expected token: \"%s\", but found \"%s\"\n",
72/*002*/ "only a single statement (or expression) can follow each \"case\"\n",
73/*003*/ "declaration of a local variable must appear in a compound block\n",
74/*004*/ "function \"%s\" is not implemented\n",
75/*005*/ "function may not have arguments\n",
76/*006*/ "must be assigned to an array\n",
77/*007*/ "assertion failed\n",
78/*008*/ "must be a constant expression; assumed zero\n",
79/*009*/ "invalid array size (negative or zero)\n",
80/*010*/ "invalid function or declaration\n",
81/*011*/ "invalid outside functions\n",
82/*012*/ "invalid function call, not a valid address\n",
83/*013*/ "no entry point (no public functions)\n",
84/*014*/ "invalid statement; not in switch\n",
85/*015*/ "\"default\" case must be the last case in switch statement\n",
86/*016*/ "multiple defaults in \"switch\"\n",
87/*017*/ "undefined symbol \"%s\"\n",
88/*018*/ "initialization data exceeds declared size\n",
89/*019*/ "not a label: \"%s\"\n",
90/*020*/ "invalid symbol name \"%s\"\n",
91/*021*/ "symbol already defined: \"%s\"\n",
92/*022*/ "must be lvalue (non-constant)\n",
93/*023*/ "array assignment must be simple assignment\n",
94/*024*/ "\"break\" or \"continue\" is out of context\n",
95/*025*/ "function heading differs from prototype\n",
96/*026*/ "no matching \"#if...\"\n",
97/*027*/ "invalid character constant\n",
98/*028*/ "invalid subscript (not an array or too many subscripts)\n",
99/*029*/ "invalid expression, assumed zero\n",
100/*030*/ "compound statement not closed at the end of file\n",
101/*031*/ "unknown directive\n",
102/*032*/ "array index out of bounds (variable \"%s\")\n",
103/*033*/ "array must be indexed (variable \"%s\")\n",
104/*034*/ "argument does not have a default value (argument %d)\n",
105/*035*/ "argument type mismatch (argument %d)\n",
106/*036*/ "empty statement\n",
107/*037*/ "invalid string (possibly non-terminated string)\n",
108/*038*/ "extra characters on line\n",
109/*039*/ "constant symbol has no size\n",
110/*040*/ "duplicate \"case\" label (value %d)\n",
111/*041*/ "invalid ellipsis, array size is not known\n",
112/*042*/ "invalid combination of class specifiers\n",
113/*043*/ "character constant exceeds range for packed string\n",
114/*044*/ "positional parameters must precede all named parameters\n",
115/*045*/ "too many function arguments\n",
116/*046*/ "unknown array size (variable \"%s\")\n",
117/*047*/ "array sizes must match\n",
118/*048*/ "array dimensions must match\n",
119/*049*/ "invalid line continuation\n",
120/*050*/ "invalid range\n",
121/*051*/ "invalid subscript, use \"[ ]\" operators on major dimensions\n",
122/*052*/ "only the last dimension may be variable length\n",
123/*053*/ "exceeding maximum number of dimensions\n",
124/*054*/ "unmatched closing brace\n",
125/*055*/ "start of function body without function header\n",
126/*056*/
127 "arrays, local variables and function arguments cannot be public (variable \"%s\")\n",
128/*057*/ "unfinished expression before compiler directive\n",
129/*058*/ "duplicate argument; same argument is passed twice\n",
130/*059*/ "function argument may not have a default value (variable \"%s\")\n",
131/*060*/ "multiple \"#else\" directives between \"#if ... #endif\"\n",
132/*061*/ "operator cannot be redefined\n",
133/*062*/ "number of operands does not fit the operator\n",
134/*063*/ "function result tag of operator \"%s\" must be \"%s\"\n",
135/*064*/ "cannot change predefined operators\n",
136/*065*/ "function argument may only have a single tag (argument %d)\n",
137/*066*/
138 "function argument may not be a reference argument or an array (argument \"%s\")\n",
139/*067*/
140 "variable cannot be both a reference and an array (variable \"%s\")\n",
141/*068*/ "invalid rational number precision in #pragma\n",
142/*069*/ "rational number format already defined\n",
143/*070*/ "rational number support was not enabled\n",
144/*071*/
145 "user-defined operator must be declared before use (function \"%s\")\n",
146/*072*/ "\"sizeof\" operator is invalid on \"function\" symbols\n",
147/*073*/ "function argument must be an array (argument \"%s\")\n",
148/*074*/ "#define pattern must start with an alphabetic character\n",
149/*075*/ "input line too long (after substitutions)\n"
150#else
151 "\261pe\224\227\315k\210:\253\360bu\201fo\214\205\217\012",
152 "\202l\221\254s\203g\366\234\213\370\201(\306\350\206) \357 f\260\324w ea\252 \042c\256e\042\012",
153 "\237cl\204\213\225\307\254\324c\334\314\300appe\204 \374\254\353m\340\214\205\232ock\012",
154 "\257\217 \274\241impl\370t\270\012",
155 "\257\317\221\241\322\367\246t\304",
156 "\335\372gn\227\315 \375\264y\012",
157 "\256s\207t\225fail\270\012",
158 "\335\254\332\344\350\206; \256\343m\227z\207o\012",
159 "\255\275\320\200(neg\213i\367\306z\207o\235",
160 "\255\257\306\237cl\204\327\012",
161 "\255out\231d\200\244\206\304",
162 "\255\257c\212l\360\241\254\251add\223s\304",
163 "\226 \210tr\221\340\203\201(\226 pu\232\337 \244\206s\235",
164 "\255\234\213\370t; \241\374sw\266\252\012",
165 "\042\310a\364t\316c\256\200\335\363\200l\256\201c\256\200\374sw\266\252 \234\213\370\356",
166 "m\364tip\366\310a\364t\211\374\042sw\266\252\042\012",
167 "\214\326\227\301\321",
168 "\203\266i\212iz\213\225d\213\254\261ce\270\211\237cl\204\227\320\303",
169 "\241\254la\352l\336",
170 "\255\301 nam\200\217\012",
171 "\301 \212\223ad\221\326\270\336",
172 "\335l\365\200(n\202-\332\222t\235",
173 "\275\372gn\220\201\335\231mp\366\372gn\220\356",
174 "\042b\223ak\316\306\042\312t\203ue\316\274ou\201\307\312t\261\356",
175 "\257head\362\323ff\207\211from pro\315typ\303",
176 "\226 \361\362\042#if...\042\012",
177 "\255\252\371\263\332\222\356",
178 "\255\343bscrip\201(\241\375\275\306\315o m\222\221\343bscripts\235",
179 "\255\350\206\360\256\343m\227z\207o\012",
180 "\353m\340\214\205\234\213\370\201\241c\324s\227a\201\363\200\210\205\307fil\303",
181 "\214k\226w\373\323\223\224iv\303",
182 "\275\203\237x ou\201\307bo\214d\211(\314\333",
183 "\275\335\203\237x\227(\314\333",
184 "\267do\331\241\322\367\254\310a\364\201\365\200(\267%d\235",
185 "\267typ\200mis\361 (\267%d\235",
186 "empt\221\234\213\370\356",
187 "\255\234r\362(\340s\231\232\221n\202-t\207m\203\213\227\234r\203g\235",
188 "\261t\247 \252\371\207\211\202 l\203\303",
189 "\332\344\301 \322\211\226 \320\303",
190 "dupl\337\213\200\042c\256e\316la\352l (\365\200%d\235",
191 "\255ellip\231s\360\275\320\200\274\241k\226wn\012",
192 "\255\353\236\203\213\225\307cl\256\211specifi\207\304",
193 "\252\371\263\332\344\261ce\270\211r\222g\200f\306pack\227\234r\203g\012",
194 "\340\231t\206\334p\351met\207\211\300\305c\270\200\212l nam\227p\351met\207\304",
195 "\315o m\222\221\257\246t\304",
196 "\214k\226w\373\275\320\200(\314\333",
197 "\275\320\331\300\361\012",
198 "\275\323\220s\206\211\300\361\012",
199 "\255l\203\200\312t\203u\327\012",
200 "\255r\222g\303",
201 "\255\343bscript\360\240\200\042[ ]\316\354\233\211\202 \317j\306\323\220s\206\304",
202 "\202l\221\363\200l\256\201\323\220s\225\317\221\271\314l\210g\363\012",
203 "\261ce\270\362\317ximum \346\307\323\220s\206\304",
204 "\214\361\227c\324s\362b\247c\303",
205 "\234\204\201\307\257bod\221w\266hou\201\257head\207\012",
206 "\264ys\360\324c\334\311\262\331\222\205\257\246t\211\376\271pu\232\337 (\314\333",
207 "\214f\203ish\227\350\225\352f\233\200\353mpil\263\323\223\224iv\303",
208 "dupl\337\213\200\246t; sam\200\267\274p\256s\227tw\337\303",
209 "\257\267\317\221\241\322\367\254\310a\364\201\365\200(\314\333",
210 "m\364tip\366\042#else\316\323\223\224iv\331\352twe\210 \042#if ... #\210\323f\042\012",
211 "\354\306\376\271\223\326\270\012",
212 "\346\307\330\222d\211do\331\241fi\201\363\200\354\233\012",
213 "\257\223\343l\201ta\313\307\354\233\253 \335\217\012",
214 "\376\252\222g\200\305\326\227\354\233\304",
215 "\257\267\317\221\202l\221\322\367\254s\203g\366ta\313(\267%d\235",
216 "\257\267\317\221\241\271\254\223f\207\210c\200\267\306\375\275(\267\333",
217 "\314\376\271bo\363 \254\223f\207\210c\200\222\205\375\275(\314\333",
218 "\255r\327\334\346\305cis\225\374#p\247g\317\012",
219 "r\327\334\346f\233\317\201\212\223ad\221\326\270\012",
220 "r\327\334\346\343pp\233\201wa\211\241\210\262\270\012",
221 "\240\207-\326\227\354\306\335\237cl\204\227\352f\233\200\240\200(\257\333",
222 "\042\320e\265\316\354\306\274\255\202 \042\244\206\316\301\304",
223 "\257\267\335\375\275(\267\333",
224 "#\326\200p\213t\207\373\300\234\204\201w\266h \375\212p\322\352t\337 \252\371\207\012",
225 "\203pu\201l\203\200\315o l\202\313(aft\263\343b\234\266ut\206s\235"
226#endif
227};
228
229static char *fatalmsg[] = {
230#ifdef SCPACK
231/*100*/ "cannot read from file: \"%s\"\n",
232/*101*/ "cannot write to file: \"%s\"\n",
233/*102*/ "table overflow: \"%s\"\n",
234 /* table can be: loop table
235 * literal table
236 * staging buffer
237 * parser stack (recursive include?)
238 * option table (response file)
239 * peephole optimizer table
240 */
241/*103*/ "insufficient memory\n",
242/*104*/ "invalid assembler instruction \"%s\"\n",
243/*105*/ "numeric overflow, exceeding capacity\n",
244/*106*/ "compaction buffer overflow\n",
245/*107*/ "too many error messages on one line\n"
246#else
247 "\376\223a\205from file\336",
248 "\376wr\266\200\315 file\336",
249 "t\272ov\207f\324w\336",
250 "\203\343ff\337i\210\201mem\233y\012",
251 "\255\256sem\232\263\203\234ru\224\225\217\012",
252 "\342m\207\337 ov\207f\324w\360\261ce\270\362capac\266y\012",
253 "\353mpa\224\225buff\263ov\207f\324w\012",
254 "\315o m\222\221\207r\306me\341ag\331\202 \202\200l\203\303"
255#endif
256};
257
258static char *warnmsg[] = {
259#ifdef SCPACK
260/*200*/ "symbol \"%s\" is truncated to %d characters\n",
261/*201*/ "redefinition of constant/macro (symbol \"%s\")\n",
262/*202*/ "number of arguments does not match definition\n",
263/*203*/ "symbol is never used: \"%s\"\n",
264/*204*/ "symbol is assigned a value that is never used: \"%s\"\n",
265/*205*/ "redundant code: constant expression is zero\n",
266/*206*/ "redundant test: constant expression is non-zero\n",
267/*207*/ "unknown #pragma\n",
268/*208*/ "function uses both \"return;\" and \"return <value>;\"\n",
269/*209*/ "function \"%s\" should return a value\n",
270/*210*/ "possible use of symbol before initialization: \"%s\"\n",
271/*211*/ "possibly unintended assignment\n",
272/*212*/ "possibly unintended bitwise operation\n",
273/*213*/ "tag mismatch\n",
274/*214*/ "possibly a \"const\" array argument was intended: \"%s\"\n",
275/*215*/ "expression has no effect\n",
276/*216*/ "nested comment\n",
277/*217*/ "loose indentation\n",
278/*218*/ "old style prototypes used with optional semicolumns\n",
279/*219*/ "local variable \"%s\" shadows a variable at a preceding level\n",
280/*220*/ "exported or native symbol \"%s\" is truncated to %d characters\n",
281/*221*/ "label name \"%s\" shadows tag name\n",
282/*222*/ "number of digits exceeds rational number precision\n",
283/*223*/ "redundant \"sizeof\": argument size is always 1 (symbol \"%s\")\n",
284/*224*/
285 "indeterminate array size in \"sizeof\" expression (symbol \"%s\")\n",
286/*225*/ "unreachable code\n",
287/*226*/ "a variable is assigned to itself (symbol \"%s\")\n"
288#else
289 "\301\253 \274tr\214c\213\227\315 %\205\252\371\207\304",
290 "\223\326\266\225\307\332\222t/\317cro (\301\253\235",
291 "\346\307\246t\211do\331\241\361 \326\266\206\012",
292 "\301 \274nev\263\240\270\336",
293 "\301 \274\372gn\227\254\365\200t\322\201\274nev\263\240\270\336",
294 "\223d\214d\344\353\237: \332\344\350\225\274z\207o\012",
295 "\223d\214d\344te\234: \332\344\350\225\274n\202-z\207o\012",
296 "\214k\226w\373#p\247g\317\012",
297 "\257\240\331bo\363 \042\223turn;\316\222\205\042\223tur\373<\365e>;\042\012",
298 "\257\217 sho\364\205\223tur\373\254\365\303",
299 "\340s\231\232\200\240\200\307\301 \352f\233\200\203\266i\212iz\327\336",
300 "\340s\231\232\221\214\203t\210d\227\372gn\220\356",
301 "\340s\231\232\221\214\203t\210d\227b\266wis\200\330\327\012",
302 "ta\313mis\361\012",
303 "\340s\231\232\221\254\042\332\316\275\267wa\211\203t\210\237d\336",
304 "\350\225\322\211\226 effe\224\012",
305 "ne\234\227\353m\220\356",
306 "\324os\200\203d\210t\327\012",
307 "\260\205\234y\366pro\315typ\331\240\227w\266h \325t\206\334sem\337\260umn\304",
308 "\324c\334\314\217 s\322dow\211\254\314a\201\254\305c\270\362level\012",
309 "\261p\233t\227\306n\213i\367\301\253 \274tr\214c\213\227\315 %\205\252\371\207\304",
310 "la\352l nam\200\217 s\322dow\211ta\313nam\303",
311 "\346\307\323g\266\211\261ce\270\211r\327\334\346\305cis\206\012",
312 "\223d\214d\344\042\320e\265\042: \267\320\200\274\212way\2111 (\301\253\235",
313 "\203\237t\207m\203\213\200\275\320\200\374\042\320e\265\316\350\225(\301\253\235",
314 "\214\223a\252\272\353\237\012",
315 "\254\314\274\372gn\227\315 \266self (\301\253\235"
316#endif
317};
diff --git a/libraries/embryo/src/bin/embryo_cc_sc6.c b/libraries/embryo/src/bin/embryo_cc_sc6.c
new file mode 100644
index 0000000..7ec6098
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc6.c
@@ -0,0 +1,1077 @@
1/* Small compiler - Binary code generation (the "assembler")
2 *
3 * Copyright (c) ITB CompuPhase, 1997-2003
4 *
5 * This software is provided "as-is", without any express or implied warranty.
6 * In no event will the authors be held liable for any damages arising from
7 * the use of this software.
8 *
9 * Permission is granted to anyone to use this software for any purpose,
10 * including commercial applications, and to alter it and redistribute it
11 * freely, subject to the following restrictions:
12 *
13 * 1. The origin of this software must not be misrepresented; you must not
14 * claim that you wrote the original software. If you use this software in
15 * a product, an acknowledgment in the product documentation would be
16 * appreciated but is not required.
17 * 2. Altered source versions must be plainly marked as such, and must not be
18 * misrepresented as being the original software.
19 * 3. This notice may not be removed or altered from any source distribution.
20 *
21 * Version: $Id: embryo_cc_sc6.c 52451 2010-09-19 03:00:12Z raster $
22 */
23
24
25#ifdef HAVE_CONFIG_H
26# include <config.h>
27#endif
28
29#include <assert.h>
30#include <stdio.h>
31#include <stdlib.h> /* for macro max() */
32#include <string.h>
33#include <ctype.h>
34#include "embryo_cc_sc.h"
35
36typedef cell(*OPCODE_PROC) (FILE * fbin, char *params, cell opcode);
37
38typedef struct
39{
40 cell opcode;
41 char *name;
42 int segment; /* sIN_CSEG=parse in cseg, sIN_DSEG=parse in dseg */
43 OPCODE_PROC func;
44} OPCODE;
45
46static cell codeindex; /* similar to "code_idx" */
47static cell *lbltab; /* label table */
48static int writeerror;
49static int bytes_in, bytes_out;
50
51/* apparently, strtol() does not work correctly on very large (unsigned)
52 * hexadecimal values */
53static ucell
54hex2long(char *s, char **n)
55{
56 unsigned long result = 0L;
57 int negate = FALSE;
58 int digit;
59
60 /* ignore leading whitespace */
61 while (*s == ' ' || *s == '\t')
62 s++;
63
64 /* allow a negation sign to create the two's complement of numbers */
65 if (*s == '-')
66 {
67 negate = TRUE;
68 s++;
69 } /* if */
70
71 assert((*s >= '0' && *s <= '9') || (*s >= 'a' && *s <= 'f')
72 || (*s >= 'a' && *s <= 'f'));
73 for (;;)
74 {
75 if (*s >= '0' && *s <= '9')
76 digit = *s - '0';
77 else if (*s >= 'a' && *s <= 'f')
78 digit = *s - 'a' + 10;
79 else if (*s >= 'A' && *s <= 'F')
80 digit = *s - 'A' + 10;
81 else
82 break; /* probably whitespace */
83 result = (result << 4) | digit;
84 s++;
85 } /* for */
86 if (n)
87 *n = s;
88 if (negate)
89 result = (~result) + 1; /* take two's complement of the result */
90 return (ucell) result;
91}
92
93#ifdef WORDS_BIGENDIAN
94static short *
95align16(short *v)
96{
97 unsigned char *s = (unsigned char *)v;
98 unsigned char t;
99
100 /* swap two bytes */
101 t = s[0];
102 s[0] = s[1];
103 s[1] = t;
104 return v;
105}
106
107static long *
108align32(long *v)
109{
110 unsigned char *s = (unsigned char *)v;
111 unsigned char t;
112
113 /* swap outer two bytes */
114 t = s[0];
115 s[0] = s[3];
116 s[3] = t;
117 /* swap inner two bytes */
118 t = s[1];
119 s[1] = s[2];
120 s[2] = t;
121 return v;
122}
123#if defined BIT16
124#define aligncell(v) align16(v)
125#else
126#define aligncell(v) align32(v)
127#endif
128#else
129#define align16(v) (v)
130#define align32(v) (v)
131#define aligncell(v) (v)
132#endif
133
134static char *
135skipwhitespace(char *str)
136{
137 while (isspace(*str))
138 str++;
139 return str;
140}
141
142static char *
143stripcomment(char *str)
144{
145 char *ptr = strchr(str, ';');
146
147 if (ptr)
148 {
149 *ptr++ = '\n'; /* terminate the line, but leave the '\n' */
150 *ptr = '\0';
151 } /* if */
152 return str;
153}
154
155static void
156write_encoded(FILE * fbin, ucell * c, int num)
157{
158 assert(sizeof(cell) <= 4); /* code must be adjusted for larger cells */
159 assert(fbin != NULL);
160 while (num-- > 0)
161 {
162 if (sc_compress)
163 {
164 ucell p = (ucell) * c;
165 unsigned char t[5]; /* a 32-bit cell is encoded in max. 5 bytes (3 bytes for a 16-bit cell) */
166 unsigned char code;
167 int index;
168
169 for (index = 0; index < 5; index++)
170 {
171 t[index] = (unsigned char)(p & 0x7f); /* store 7 bits */
172 p >>= 7;
173 } /* for */
174 /* skip leading zeros */
175 while (index > 1 && t[index - 1] == 0
176 && (t[index - 2] & 0x40) == 0)
177 index--;
178 /* skip leading -1s *//* ??? for BIT16, check for index==3 && t[index-1]==0x03 */
179 if (index == 5 && t[index - 1] == 0x0f
180 && (t[index - 2] & 0x40) != 0)
181 index--;
182 while (index > 1 && t[index - 1] == 0x7f
183 && (t[index - 2] & 0x40) != 0)
184 index--;
185 /* write high byte first, write continuation bits */
186 assert(index > 0);
187 while (index-- > 0)
188 {
189 code =
190 (unsigned char)((index == 0) ? t[index]
191 : (t[index] | 0x80));
192 writeerror |= !sc_writebin(fbin, &code, 1);
193 bytes_out++;
194 } /* while */
195 bytes_in += sizeof *c;
196 assert(AMX_EXPANDMARGIN > 2);
197 if (bytes_out - bytes_in >= AMX_EXPANDMARGIN - 2)
198 error(106); /* compression buffer overflow */
199 }
200 else
201 {
202 assert((sc_lengthbin(fbin) % sizeof(cell)) == 0);
203 writeerror |= !sc_writebin(fbin, aligncell(c), sizeof *c);
204 } /* if */
205 c++;
206 } /* while */
207}
208
209#if defined __BORLANDC__ || defined __WATCOMC__
210#pragma argsused
211#endif
212
213static cell
214noop(FILE * fbin __UNUSED__, char *params __UNUSED__, cell opcode __UNUSED__)
215{
216 return 0;
217}
218
219#if defined __BORLANDC__ || defined __WATCOMC__
220#pragma argsused
221#endif
222
223static cell
224parm0(FILE * fbin, char *params __UNUSED__, cell opcode)
225{
226 if (fbin)
227 write_encoded(fbin, (ucell *) & opcode, 1);
228 return opcodes(1);
229}
230
231static cell
232parm1(FILE * fbin, char *params, cell opcode)
233{
234 ucell p = hex2long(params, NULL);
235
236 if (fbin)
237 {
238 write_encoded(fbin, (ucell *) & opcode, 1);
239 write_encoded(fbin, &p, 1);
240 } /* if */
241 return opcodes(1) + opargs(1);
242}
243
244static cell
245parm2(FILE * fbin, char *params, cell opcode)
246{
247 ucell p[2];
248
249 p[0] = hex2long(params, &params);
250 p[1] = hex2long(params, NULL);
251 if (fbin)
252 {
253 write_encoded(fbin, (ucell *) & opcode, 1);
254 write_encoded(fbin, p, 2);
255 } /* if */
256 return opcodes(1) + opargs(2);
257}
258
259#if defined __BORLANDC__ || defined __WATCOMC__
260#pragma argsused
261#endif
262
263static cell
264do_dump(FILE * fbin, char *params, cell opcode __UNUSED__)
265{
266 ucell p;
267 int num = 0;
268
269 while (*params != '\0')
270 {
271 p = hex2long(params, &params);
272 if (fbin)
273 write_encoded(fbin, &p, 1);
274 num++;
275 while (isspace(*params))
276 params++;
277 } /* while */
278 return num * sizeof(cell);
279}
280
281static cell
282do_call(FILE * fbin, char *params, cell opcode)
283{
284 char name[sNAMEMAX + 1];
285 int i;
286 symbol *sym;
287 ucell p;
288
289 for (i = 0; !isspace(*params); i++, params++)
290 {
291 assert(*params != '\0');
292 assert(i < sNAMEMAX);
293 name[i] = *params;
294 } /* for */
295 name[i] = '\0';
296
297 /* look up the function address; note that the correct file number must
298 * already have been set (in order for static globals to be found).
299 */
300 sym = findglb(name);
301 assert(sym != NULL);
302 assert(sym->ident == iFUNCTN || sym->ident == iREFFUNC);
303 assert(sym->vclass == sGLOBAL);
304
305 p = sym->addr;
306 if (fbin)
307 {
308 write_encoded(fbin, (ucell *) & opcode, 1);
309 write_encoded(fbin, &p, 1);
310 } /* if */
311 return opcodes(1) + opargs(1);
312}
313
314static cell
315do_jump(FILE * fbin, char *params, cell opcode)
316{
317 int i;
318 ucell p;
319
320 i = (int)hex2long(params, NULL);
321 assert(i >= 0 && i < labnum);
322
323 if (fbin)
324 {
325 assert(lbltab != NULL);
326 p = lbltab[i];
327 write_encoded(fbin, (ucell *) & opcode, 1);
328 write_encoded(fbin, &p, 1);
329 } /* if */
330 return opcodes(1) + opargs(1);
331}
332
333static cell
334do_file(FILE * fbin, char *params, cell opcode)
335{
336 ucell p, clen;
337 int len;
338
339 p = hex2long(params, &params);
340
341 /* remove leading and trailing white space from the filename */
342 while (isspace(*params))
343 params++;
344 len = strlen(params);
345 while (len > 0 && isspace(params[len - 1]))
346 len--;
347 params[len++] = '\0'; /* zero-terminate */
348 while (len % sizeof(cell) != 0)
349 params[len++] = '\0'; /* pad with zeros up to full cell */
350 assert(len > 0 && len < 256);
351 clen = len + sizeof(cell); /* add size of file ordinal */
352
353 if (fbin)
354 {
355 write_encoded(fbin, (ucell *) & opcode, 1);
356 write_encoded(fbin, &clen, 1);
357 write_encoded(fbin, &p, 1);
358 write_encoded(fbin, (ucell *) params, len / sizeof(cell));
359 } /* if */
360 return opcodes(1) + opargs(1) + clen; /* other argument is in clen */
361}
362
363static cell
364do_symbol(FILE * fbin, char *params, cell opcode)
365{
366 char *endptr;
367 ucell offset, clen, flags;
368 int len;
369 unsigned char mclass, type;
370
371 for (endptr = params; !isspace(*endptr) && endptr != '\0'; endptr++)
372 /* nothing */ ;
373 assert(*endptr == ' ');
374
375 len = (int)(endptr - params);
376 assert(len > 0 && len < sNAMEMAX);
377 /* first get the other parameters from the line */
378 offset = hex2long(endptr, &endptr);
379 mclass = (unsigned char)hex2long(endptr, &endptr);
380 type = (unsigned char)hex2long(endptr, NULL);
381 flags = type + 256 * mclass;
382 /* now finish up the name (overwriting the input line) */
383 params[len++] = '\0'; /* zero-terminate */
384 while (len % sizeof(cell) != 0)
385 params[len++] = '\0'; /* pad with zeros up to full cell */
386 clen = len + 2 * sizeof(cell); /* add size of symbol address and flags */
387
388 if (fbin)
389 {
390 write_encoded(fbin, (ucell *) & opcode, 1);
391 write_encoded(fbin, &clen, 1);
392 write_encoded(fbin, &offset, 1);
393 write_encoded(fbin, &flags, 1);
394 write_encoded(fbin, (ucell *) params, len / sizeof(cell));
395 } /* if */
396
397#if !defined NDEBUG
398 /* function should start right after the symbolic information */
399 if (!fbin && mclass == 0 && type == iFUNCTN)
400 assert(offset == codeindex + opcodes(1) + opargs(1) + clen);
401#endif
402
403 return opcodes(1) + opargs(1) + clen; /* other 2 arguments are in clen */
404}
405
406static cell
407do_switch(FILE * fbin, char *params, cell opcode)
408{
409 int i;
410 ucell p;
411
412 i = (int)hex2long(params, NULL);
413 assert(i >= 0 && i < labnum);
414
415 if (fbin)
416 {
417 assert(lbltab != NULL);
418 p = lbltab[i];
419 write_encoded(fbin, (ucell *) & opcode, 1);
420 write_encoded(fbin, &p, 1);
421 } /* if */
422 return opcodes(1) + opargs(1);
423}
424
425#if defined __BORLANDC__ || defined __WATCOMC__
426#pragma argsused
427#endif
428
429static cell
430do_case(FILE * fbin, char *params, cell opcode __UNUSED__)
431{
432 int i;
433 ucell p, v;
434
435 v = hex2long(params, &params);
436 i = (int)hex2long(params, NULL);
437 assert(i >= 0 && i < labnum);
438
439 if (fbin)
440 {
441 assert(lbltab != NULL);
442 p = lbltab[i];
443 write_encoded(fbin, &v, 1);
444 write_encoded(fbin, &p, 1);
445 } /* if */
446 return opcodes(0) + opargs(2);
447}
448
449#if defined __BORLANDC__ || defined __WATCOMC__
450#pragma argsused
451#endif
452
453static cell
454curfile(FILE * fbin __UNUSED__, char *params, cell opcode __UNUSED__)
455{
456 fcurrent = (int)hex2long(params, NULL);
457 return 0;
458}
459
460static OPCODE opcodelist[] = {
461 /* node for "invalid instruction" */
462 {0, NULL, 0, noop},
463 /* opcodes in sorted order */
464 {78, "add", sIN_CSEG, parm0},
465 {87, "add.c", sIN_CSEG, parm1},
466 {14, "addr.alt", sIN_CSEG, parm1},
467 {13, "addr.pri", sIN_CSEG, parm1},
468 {30, "align.alt", sIN_CSEG, parm1},
469 {29, "align.pri", sIN_CSEG, parm1},
470 {81, "and", sIN_CSEG, parm0},
471 {121, "bounds", sIN_CSEG, parm1},
472 {49, "call", sIN_CSEG, do_call},
473 {50, "call.pri", sIN_CSEG, parm0},
474 {0, "case", sIN_CSEG, do_case},
475 {130, "casetbl", sIN_CSEG, parm0}, /* version 1 */
476 {118, "cmps", sIN_CSEG, parm1},
477 {0, "code", 0, noop},
478 {12, "const.alt", sIN_CSEG, parm1},
479 {11, "const.pri", sIN_CSEG, parm1},
480 {0, "curfile", sIN_CSEG, curfile},
481 {0, "data", 0, noop},
482 {114, "dec", sIN_CSEG, parm1},
483 {113, "dec.alt", sIN_CSEG, parm0},
484 {116, "dec.i", sIN_CSEG, parm0},
485 {112, "dec.pri", sIN_CSEG, parm0},
486 {115, "dec.s", sIN_CSEG, parm1},
487 {0, "dump", sIN_DSEG, do_dump},
488 {95, "eq", sIN_CSEG, parm0},
489 {106, "eq.c.alt", sIN_CSEG, parm1},
490 {105, "eq.c.pri", sIN_CSEG, parm1},
491 {124, "file", sIN_CSEG, do_file},
492 {119, "fill", sIN_CSEG, parm1},
493 {100, "geq", sIN_CSEG, parm0},
494 {99, "grtr", sIN_CSEG, parm0},
495 {120, "halt", sIN_CSEG, parm1},
496 {45, "heap", sIN_CSEG, parm1},
497 {27, "idxaddr", sIN_CSEG, parm0},
498 {28, "idxaddr.b", sIN_CSEG, parm1},
499 {109, "inc", sIN_CSEG, parm1},
500 {108, "inc.alt", sIN_CSEG, parm0},
501 {111, "inc.i", sIN_CSEG, parm0},
502 {107, "inc.pri", sIN_CSEG, parm0},
503 {110, "inc.s", sIN_CSEG, parm1},
504 {86, "invert", sIN_CSEG, parm0},
505 {55, "jeq", sIN_CSEG, do_jump},
506 {60, "jgeq", sIN_CSEG, do_jump},
507 {59, "jgrtr", sIN_CSEG, do_jump},
508 {58, "jleq", sIN_CSEG, do_jump},
509 {57, "jless", sIN_CSEG, do_jump},
510 {56, "jneq", sIN_CSEG, do_jump},
511 {54, "jnz", sIN_CSEG, do_jump},
512 {52, "jrel", sIN_CSEG, parm1}, /* always a number */
513 {64, "jsgeq", sIN_CSEG, do_jump},
514 {63, "jsgrtr", sIN_CSEG, do_jump},
515 {62, "jsleq", sIN_CSEG, do_jump},
516 {61, "jsless", sIN_CSEG, do_jump},
517 {51, "jump", sIN_CSEG, do_jump},
518 {128, "jump.pri", sIN_CSEG, parm0}, /* version 1 */
519 {53, "jzer", sIN_CSEG, do_jump},
520 {31, "lctrl", sIN_CSEG, parm1},
521 {98, "leq", sIN_CSEG, parm0},
522 {97, "less", sIN_CSEG, parm0},
523 {25, "lidx", sIN_CSEG, parm0},
524 {26, "lidx.b", sIN_CSEG, parm1},
525 {125, "line", sIN_CSEG, parm2},
526 {2, "load.alt", sIN_CSEG, parm1},
527 {9, "load.i", sIN_CSEG, parm0},
528 {1, "load.pri", sIN_CSEG, parm1},
529 {4, "load.s.alt", sIN_CSEG, parm1},
530 {3, "load.s.pri", sIN_CSEG, parm1},
531 {10, "lodb.i", sIN_CSEG, parm1},
532 {6, "lref.alt", sIN_CSEG, parm1},
533 {5, "lref.pri", sIN_CSEG, parm1},
534 {8, "lref.s.alt", sIN_CSEG, parm1},
535 {7, "lref.s.pri", sIN_CSEG, parm1},
536 {34, "move.alt", sIN_CSEG, parm0},
537 {33, "move.pri", sIN_CSEG, parm0},
538 {117, "movs", sIN_CSEG, parm1},
539 {85, "neg", sIN_CSEG, parm0},
540 {96, "neq", sIN_CSEG, parm0},
541 {134, "nop", sIN_CSEG, parm0}, /* version 6 */
542 {84, "not", sIN_CSEG, parm0},
543 {82, "or", sIN_CSEG, parm0},
544 {43, "pop.alt", sIN_CSEG, parm0},
545 {42, "pop.pri", sIN_CSEG, parm0},
546 {46, "proc", sIN_CSEG, parm0},
547 {40, "push", sIN_CSEG, parm1},
548 {37, "push.alt", sIN_CSEG, parm0},
549 {39, "push.c", sIN_CSEG, parm1},
550 {36, "push.pri", sIN_CSEG, parm0},
551 {38, "push.r", sIN_CSEG, parm1},
552 {41, "push.s", sIN_CSEG, parm1},
553 {133, "pushaddr", sIN_CSEG, parm1}, /* version 4 */
554 {47, "ret", sIN_CSEG, parm0},
555 {48, "retn", sIN_CSEG, parm0},
556 {32, "sctrl", sIN_CSEG, parm1},
557 {73, "sdiv", sIN_CSEG, parm0},
558 {74, "sdiv.alt", sIN_CSEG, parm0},
559 {104, "sgeq", sIN_CSEG, parm0},
560 {103, "sgrtr", sIN_CSEG, parm0},
561 {65, "shl", sIN_CSEG, parm0},
562 {69, "shl.c.alt", sIN_CSEG, parm1},
563 {68, "shl.c.pri", sIN_CSEG, parm1},
564 {66, "shr", sIN_CSEG, parm0},
565 {71, "shr.c.alt", sIN_CSEG, parm1},
566 {70, "shr.c.pri", sIN_CSEG, parm1},
567 {94, "sign.alt", sIN_CSEG, parm0},
568 {93, "sign.pri", sIN_CSEG, parm0},
569 {102, "sleq", sIN_CSEG, parm0},
570 {101, "sless", sIN_CSEG, parm0},
571 {72, "smul", sIN_CSEG, parm0},
572 {88, "smul.c", sIN_CSEG, parm1},
573 {127, "srange", sIN_CSEG, parm2}, /* version 1 */
574 {20, "sref.alt", sIN_CSEG, parm1},
575 {19, "sref.pri", sIN_CSEG, parm1},
576 {22, "sref.s.alt", sIN_CSEG, parm1},
577 {21, "sref.s.pri", sIN_CSEG, parm1},
578 {67, "sshr", sIN_CSEG, parm0},
579 {44, "stack", sIN_CSEG, parm1},
580 {0, "stksize", 0, noop},
581 {16, "stor.alt", sIN_CSEG, parm1},
582 {23, "stor.i", sIN_CSEG, parm0},
583 {15, "stor.pri", sIN_CSEG, parm1},
584 {18, "stor.s.alt", sIN_CSEG, parm1},
585 {17, "stor.s.pri", sIN_CSEG, parm1},
586 {24, "strb.i", sIN_CSEG, parm1},
587 {79, "sub", sIN_CSEG, parm0},
588 {80, "sub.alt", sIN_CSEG, parm0},
589 {132, "swap.alt", sIN_CSEG, parm0}, /* version 4 */
590 {131, "swap.pri", sIN_CSEG, parm0}, /* version 4 */
591 {129, "switch", sIN_CSEG, do_switch}, /* version 1 */
592 {126, "symbol", sIN_CSEG, do_symbol},
593 {136, "symtag", sIN_CSEG, parm1}, /* version 7 */
594 {123, "sysreq.c", sIN_CSEG, parm1},
595 {135, "sysreq.d", sIN_CSEG, parm1}, /* version 7, not generated directly */
596 {122, "sysreq.pri", sIN_CSEG, parm0},
597 {76, "udiv", sIN_CSEG, parm0},
598 {77, "udiv.alt", sIN_CSEG, parm0},
599 {75, "umul", sIN_CSEG, parm0},
600 {35, "xchg", sIN_CSEG, parm0},
601 {83, "xor", sIN_CSEG, parm0},
602 {91, "zero", sIN_CSEG, parm1},
603 {90, "zero.alt", sIN_CSEG, parm0},
604 {89, "zero.pri", sIN_CSEG, parm0},
605 {92, "zero.s", sIN_CSEG, parm1},
606};
607
608#define MAX_INSTR_LEN 30
609static int
610findopcode(char *instr, int maxlen)
611{
612 int low, high, mid, cmp;
613 char str[MAX_INSTR_LEN];
614
615 if (maxlen >= MAX_INSTR_LEN)
616 return 0;
617 strncpy(str, instr, maxlen);
618 str[maxlen] = '\0'; /* make sure the string is zero terminated */
619 /* look up the instruction with a binary search
620 * the assembler is case insensitive to instructions (but case sensitive
621 * to symbols)
622 */
623 low = 1; /* entry 0 is reserved (for "not found") */
624 high = (sizeof opcodelist / sizeof opcodelist[0]) - 1;
625 while (low < high)
626 {
627 mid = (low + high) / 2;
628 assert(opcodelist[mid].name != NULL);
629 cmp = strcasecmp(str, opcodelist[mid].name);
630 if (cmp > 0)
631 low = mid + 1;
632 else
633 high = mid;
634 } /* while */
635
636 assert(low == high);
637 if (strcasecmp(str, opcodelist[low].name) == 0)
638 return low; /* found */
639 return 0; /* not found, return special index */
640}
641
642void
643assemble(FILE * fout, FILE * fin)
644{
645 typedef struct tagFUNCSTUB
646 {
647 unsigned int address, nameofs;
648 } FUNCSTUB;
649 AMX_HEADER hdr;
650 FUNCSTUB func;
651 int numpublics, numnatives, numlibraries, numpubvars,
652 numtags, padding;
653 long nametablesize, nameofs;
654 char line[256], *instr, *params;
655 int i, pass;
656 short count;
657 symbol *sym, **nativelist;
658 constvalue *constptr;
659 cell mainaddr;
660 int nametable, tags, libraries, publics, natives, pubvars;
661 int cod, defsize;
662
663#if !defined NDEBUG
664 /* verify that the opcode list is sorted (skip entry 1; it is reserved
665 * for a non-existent opcode)
666 */
667 assert(opcodelist[1].name != NULL);
668 for (i = 2; i < (int)(sizeof(opcodelist) / sizeof(opcodelist[0])); i++)
669 {
670 assert(opcodelist[i].name != NULL);
671 assert(strcasecmp(opcodelist[i].name, opcodelist[i - 1].name) > 0);
672 } /* for */
673#endif
674
675 writeerror = FALSE;
676 nametablesize = sizeof(short);
677 numpublics = 0;
678 numnatives = 0;
679 numpubvars = 0;
680 mainaddr = -1;
681 /* count number of public and native functions and public variables */
682 for (sym = glbtab.next; sym; sym = sym->next)
683 {
684 char alias[sNAMEMAX + 1] = "";
685 int match = 0;
686
687 if (sym->ident == iFUNCTN)
688 {
689 assert(strlen(sym->name) <= sNAMEMAX);
690 if ((sym->usage & uNATIVE) != 0 && (sym->usage & uREAD) != 0
691 && sym->addr >= 0)
692 {
693 match = ++numnatives;
694 if (!lookup_alias(alias, sym->name))
695 strcpy(alias, sym->name);
696 } /* if */
697 if ((sym->usage & uPUBLIC) != 0 && (sym->usage & uDEFINE) != 0)
698 {
699 match = ++numpublics;
700 strcpy(alias, sym->name);
701 } /* if */
702 if (strcmp(sym->name, uMAINFUNC) == 0)
703 {
704 assert(sym->vclass == sGLOBAL);
705 mainaddr = sym->addr;
706 } /* if */
707 }
708 else if (sym->ident == iVARIABLE)
709 {
710 if ((sym->usage & uPUBLIC) != 0)
711 {
712 match = ++numpubvars;
713 strcpy(alias, sym->name);
714 } /* if */
715 } /* if */
716 if (match)
717 {
718 assert(alias[0] != '\0');
719 nametablesize += strlen(alias) + 1;
720 } /* if */
721 } /* for */
722 assert(numnatives == ntv_funcid);
723
724 /* count number of libraries */
725 numlibraries = 0;
726 for (constptr = libname_tab.next; constptr;
727 constptr = constptr->next)
728 {
729 if (constptr->value > 0)
730 {
731 assert(constptr->name[0] != '\0');
732 numlibraries++;
733 nametablesize += strlen(constptr->name) + 1;
734 } /* if */
735 } /* for */
736
737 /* count number of public tags */
738 numtags = 0;
739 for (constptr = tagname_tab.next; constptr;
740 constptr = constptr->next)
741 {
742 if ((constptr->value & PUBLICTAG) != 0)
743 {
744 assert(constptr->name[0] != '\0');
745 numtags++;
746 nametablesize += strlen(constptr->name) + 1;
747 } /* if */
748 } /* for */
749
750 /* pad the header to sc_dataalign
751 * => thereby the code segment is aligned
752 * => since the code segment is padded to a sc_dataalign boundary, the data segment is aligned
753 * => and thereby the stack top is aligned too
754 */
755 assert(sc_dataalign != 0);
756 padding = sc_dataalign - (sizeof hdr + nametablesize) % sc_dataalign;
757 if (padding == sc_dataalign)
758 padding = 0;
759
760 /* write the abstract machine header */
761 memset(&hdr, 0, sizeof hdr);
762 hdr.magic = (unsigned short)0xF1E0;
763 hdr.file_version = CUR_FILE_VERSION;
764 hdr.amx_version = MIN_AMX_VERSION;
765 hdr.flags = (short)(sc_debug & sSYMBOLIC);
766 if (charbits == 16)
767 hdr.flags |= AMX_FLAG_CHAR16;
768 if (sc_compress)
769 hdr.flags |= AMX_FLAG_COMPACT;
770 if (sc_debug == 0)
771 hdr.flags |= AMX_FLAG_NOCHECKS;
772// #ifdef WORDS_BIGENDIAN
773// hdr.flags|=AMX_FLAG_BIGENDIAN;
774// #endif
775 defsize = hdr.defsize = sizeof(FUNCSTUB);
776 assert((hdr.defsize % sizeof(cell)) == 0);
777 publics = hdr.publics = sizeof hdr; /* public table starts right after the header */
778 natives = hdr.natives = hdr.publics + numpublics * sizeof(FUNCSTUB);
779 libraries = hdr.libraries = hdr.natives + numnatives * sizeof(FUNCSTUB);
780 pubvars = hdr.pubvars = hdr.libraries + numlibraries * sizeof(FUNCSTUB);
781 tags = hdr.tags = hdr.pubvars + numpubvars * sizeof(FUNCSTUB);
782 nametable = hdr.nametable = hdr.tags + numtags * sizeof(FUNCSTUB);
783 cod = hdr.cod = hdr.nametable + nametablesize + padding;
784 hdr.dat = hdr.cod + code_idx;
785 hdr.hea = hdr.dat + glb_declared * sizeof(cell);
786 hdr.stp = hdr.hea + sc_stksize * sizeof(cell);
787 hdr.cip = mainaddr;
788 hdr.size = hdr.hea; /* preset, this is incorrect in case of compressed output */
789#ifdef WORDS_BIGENDIAN
790 align32(&hdr.size);
791 align16(&hdr.magic);
792 align16(&hdr.flags);
793 align16(&hdr.defsize);
794 align32(&hdr.cod);
795 align32(&hdr.dat);
796 align32(&hdr.hea);
797 align32(&hdr.stp);
798 align32(&hdr.cip);
799 align32(&hdr.publics);
800 align32(&hdr.natives);
801 align32(&hdr.libraries);
802 align32(&hdr.pubvars);
803 align32(&hdr.tags);
804 align32(&hdr.nametable);
805#endif
806 sc_writebin(fout, &hdr, sizeof hdr);
807
808 /* dump zeros up to the rest of the header, so that we can easily "seek" */
809 for (nameofs = sizeof hdr; nameofs < cod; nameofs++)
810 putc(0, fout);
811 nameofs = nametable + sizeof(short);
812
813 /* write the public functions table */
814 count = 0;
815 for (sym = glbtab.next; sym; sym = sym->next)
816 {
817 if (sym->ident == iFUNCTN
818 && (sym->usage & uPUBLIC) != 0 && (sym->usage & uDEFINE) != 0)
819 {
820 assert(sym->vclass == sGLOBAL);
821 func.address = sym->addr;
822 func.nameofs = nameofs;
823#ifdef WORDS_BIGENDIAN
824 align32(&func.address);
825 align32(&func.nameofs);
826#endif
827 fseek(fout, publics + count * sizeof(FUNCSTUB), SEEK_SET);
828 sc_writebin(fout, &func, sizeof func);
829 fseek(fout, nameofs, SEEK_SET);
830 sc_writebin(fout, sym->name, strlen(sym->name) + 1);
831 nameofs += strlen(sym->name) + 1;
832 count++;
833 } /* if */
834 } /* for */
835
836 /* write the natives table */
837 /* The native functions must be written in sorted order. (They are
838 * sorted on their "id", not on their name). A nested loop to find
839 * each successive function would be an O(n^2) operation. But we
840 * do not really need to sort, because the native function id's
841 * are sequential and there are no duplicates. So we first walk
842 * through the complete symbol list and store a pointer to every
843 * native function of interest in a temporary table, where its id
844 * serves as the index in the table. Now we can walk the table and
845 * have all native functions in sorted order.
846 */
847 if (numnatives > 0)
848 {
849 nativelist = (symbol **) malloc(numnatives * sizeof(symbol *));
850 if (!nativelist)
851 error(103); /* insufficient memory */
852#if !defined NDEBUG
853 memset(nativelist, 0, numnatives * sizeof(symbol *)); /* for NULL checking */
854#endif
855 for (sym = glbtab.next; sym; sym = sym->next)
856 {
857 if (sym->ident == iFUNCTN && (sym->usage & uNATIVE) != 0
858 && (sym->usage & uREAD) != 0 && sym->addr >= 0)
859 {
860 assert(sym->addr < numnatives);
861 nativelist[(int)sym->addr] = sym;
862 } /* if */
863 } /* for */
864 count = 0;
865 for (i = 0; i < numnatives; i++)
866 {
867 char alias[sNAMEMAX + 1];
868
869 sym = nativelist[i];
870 assert(sym != NULL);
871 if (!lookup_alias(alias, sym->name))
872 {
873 assert(strlen(sym->name) <= sNAMEMAX);
874 strcpy(alias, sym->name);
875 } /* if */
876 assert(sym->vclass == sGLOBAL);
877 func.address = 0;
878 func.nameofs = nameofs;
879#ifdef WORDS_BIGENDIAN
880 align32(&func.address);
881 align32(&func.nameofs);
882#endif
883 fseek(fout, natives + count * sizeof(FUNCSTUB), SEEK_SET);
884 sc_writebin(fout, &func, sizeof func);
885 fseek(fout, nameofs, SEEK_SET);
886 sc_writebin(fout, alias, strlen(alias) + 1);
887 nameofs += strlen(alias) + 1;
888 count++;
889 } /* for */
890 free(nativelist);
891 } /* if */
892
893 /* write the libraries table */
894 count = 0;
895 for (constptr = libname_tab.next; constptr;
896 constptr = constptr->next)
897 {
898 if (constptr->value > 0)
899 {
900 assert(constptr->name[0] != '\0');
901 func.address = 0;
902 func.nameofs = nameofs;
903#ifdef WORDS_BIGENDIAN
904 align32(&func.address);
905 align32(&func.nameofs);
906#endif
907 fseek(fout, libraries + count * sizeof(FUNCSTUB), SEEK_SET);
908 sc_writebin(fout, &func, sizeof func);
909 fseek(fout, nameofs, SEEK_SET);
910 sc_writebin(fout, constptr->name, strlen(constptr->name) + 1);
911 nameofs += strlen(constptr->name) + 1;
912 count++;
913 } /* if */
914 } /* for */
915
916 /* write the public variables table */
917 count = 0;
918 for (sym = glbtab.next; sym; sym = sym->next)
919 {
920 if (sym->ident == iVARIABLE && (sym->usage & uPUBLIC) != 0)
921 {
922 assert((sym->usage & uDEFINE) != 0);
923 assert(sym->vclass == sGLOBAL);
924 func.address = sym->addr;
925 func.nameofs = nameofs;
926#ifdef WORDS_BIGENDIAN
927 align32(&func.address);
928 align32(&func.nameofs);
929#endif
930 fseek(fout, pubvars + count * sizeof(FUNCSTUB), SEEK_SET);
931 sc_writebin(fout, &func, sizeof func);
932 fseek(fout, nameofs, SEEK_SET);
933 sc_writebin(fout, sym->name, strlen(sym->name) + 1);
934 nameofs += strlen(sym->name) + 1;
935 count++;
936 } /* if */
937 } /* for */
938
939 /* write the public tagnames table */
940 count = 0;
941 for (constptr = tagname_tab.next; constptr;
942 constptr = constptr->next)
943 {
944 if ((constptr->value & PUBLICTAG) != 0)
945 {
946 assert(constptr->name[0] != '\0');
947 func.address = constptr->value & TAGMASK;
948 func.nameofs = nameofs;
949#ifdef WORDS_BIGENDIAN
950 align32(&func.address);
951 align32(&func.nameofs);
952#endif
953 fseek(fout, tags + count * sizeof(FUNCSTUB), SEEK_SET);
954 sc_writebin(fout, &func, sizeof func);
955 fseek(fout, nameofs, SEEK_SET);
956 sc_writebin(fout, constptr->name, strlen(constptr->name) + 1);
957 nameofs += strlen(constptr->name) + 1;
958 count++;
959 } /* if */
960 } /* for */
961
962 /* write the "maximum name length" field in the name table */
963 assert(nameofs == nametable + nametablesize);
964 fseek(fout, nametable, SEEK_SET);
965 count = sNAMEMAX;
966#ifdef WORDS_BIGENDIAN
967 align16(&count);
968#endif
969 sc_writebin(fout, &count, sizeof count);
970 fseek(fout, cod, SEEK_SET);
971
972 /* First pass: relocate all labels */
973 /* This pass is necessary because the code addresses of labels is only known
974 * after the peephole optimization flag. Labels can occur inside expressions
975 * (e.g. the conditional operator), which are optimized.
976 */
977 lbltab = NULL;
978 if (labnum > 0)
979 {
980 /* only very short programs have zero labels; no first pass is needed
981 * if there are no labels */
982 lbltab = (cell *) malloc(labnum * sizeof(cell));
983 if (!lbltab)
984 error(103); /* insufficient memory */
985 codeindex = 0;
986 sc_resetasm(fin);
987 while (sc_readasm(fin, line, sizeof line))
988 {
989 stripcomment(line);
990 instr = skipwhitespace(line);
991 /* ignore empty lines */
992 if (*instr == '\0')
993 continue;
994 if (tolower(*instr) == 'l' && *(instr + 1) == '.')
995 {
996 int lindex = (int)hex2long(instr + 2, NULL);
997
998 assert(lindex < labnum);
999 lbltab[lindex] = codeindex;
1000 }
1001 else
1002 {
1003 /* get to the end of the instruction (make use of the '\n' that fgets()
1004 * added at the end of the line; this way we will *always* drop on a
1005 * whitespace character) */
1006 for (params = instr; *params != '\0' && !isspace(*params);
1007 params++)
1008 /* nothing */ ;
1009 assert(params > instr);
1010 i = findopcode(instr, (int)(params - instr));
1011 if (!opcodelist[i].name)
1012 {
1013 *params = '\0';
1014 error(104, instr); /* invalid assembler instruction */
1015 } /* if */
1016 if (opcodelist[i].segment == sIN_CSEG)
1017 codeindex +=
1018 opcodelist[i].func(NULL, skipwhitespace(params),
1019 opcodelist[i].opcode);
1020 } /* if */
1021 } /* while */
1022 } /* if */
1023
1024 /* Second pass (actually 2 more passes, one for all code and one for all data) */
1025 bytes_in = 0;
1026 bytes_out = 0;
1027 for (pass = sIN_CSEG; pass <= sIN_DSEG; pass++)
1028 {
1029 sc_resetasm(fin);
1030 while (sc_readasm(fin, line, sizeof line))
1031 {
1032 stripcomment(line);
1033 instr = skipwhitespace(line);
1034 /* ignore empty lines and labels (labels have a special syntax, so these
1035 * must be parsed separately) */
1036 if (*instr == '\0' || (tolower(*instr) == 'l'
1037 && *(instr + 1) == '.'))
1038 continue;
1039 /* get to the end of the instruction (make use of the '\n' that fgets()
1040 * added at the end of the line; this way we will *always* drop on a
1041 * whitespace character) */
1042 for (params = instr; *params != '\0' && !isspace(*params);
1043 params++)
1044 /* nothing */ ;
1045 assert(params > instr);
1046 i = findopcode(instr, (int)(params - instr));
1047 assert(opcodelist[i].name != NULL);
1048 if (opcodelist[i].segment == pass)
1049 opcodelist[i].func(fout, skipwhitespace(params),
1050 opcodelist[i].opcode);
1051 } /* while */
1052 } /* for */
1053 if (bytes_out - bytes_in > 0)
1054 error(106); /* compression buffer overflow */
1055
1056 if (lbltab)
1057 {
1058 free(lbltab);
1059#if !defined NDEBUG
1060 lbltab = NULL;
1061#endif
1062 } /* if */
1063
1064 if (writeerror)
1065 error(101, "disk full");
1066
1067 /* adjust the header */
1068 if (sc_compress)
1069 {
1070 hdr.size = sc_lengthbin(fout);
1071#ifdef WORDS_BIGENDIAN
1072 align32(&hdr.size);
1073#endif
1074 sc_resetbin(fout); /* "size" is the very first field */
1075 sc_writebin(fout, &hdr.size, sizeof hdr.size);
1076 } /* if */
1077}
diff --git a/libraries/embryo/src/bin/embryo_cc_sc7.c b/libraries/embryo/src/bin/embryo_cc_sc7.c
new file mode 100644
index 0000000..a2f9f4c
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc7.c
@@ -0,0 +1,688 @@
1/* Small compiler - Staging buffer and optimizer
2 *
3 * The staging buffer
4 * ------------------
5 * The staging buffer allows buffered output of generated code, deletion
6 * of redundant code, optimization by a tinkering process and reversing
7 * the ouput of evaluated expressions (which is used for the reversed
8 * evaluation of arguments in functions).
9 * Initially, stgwrite() writes to the file directly, but after a call to
10 * stgset(TRUE), output is redirected to the buffer. After a call to
11 * stgset(FALSE), stgwrite()'s output is directed to the file again. Thus
12 * only one routine is used for writing to the output, which can be
13 * buffered output or direct output.
14 *
15 * staging buffer variables: stgbuf - the buffer
16 * stgidx - current index in the staging buffer
17 * staging - if true, write to the staging buffer;
18 * if false, write to file directly.
19 *
20 * Copyright (c) ITB CompuPhase, 1997-2003
21 *
22 * This software is provided "as-is", without any express or implied warranty.
23 * In no event will the authors be held liable for any damages arising from
24 * the use of this software.
25 *
26 * Permission is granted to anyone to use this software for any purpose,
27 * including commercial applications, and to alter it and redistribute it
28 * freely, subject to the following restrictions:
29 *
30 * 1. The origin of this software must not be misrepresented; you must not
31 * claim that you wrote the original software. If you use this software in
32 * a product, an acknowledgment in the product documentation would be
33 * appreciated but is not required.
34 * 2. Altered source versions must be plainly marked as such, and must not be
35 * misrepresented as being the original software.
36 * 3. This notice may not be removed or altered from any source distribution.
37 *
38 * Version: $Id: embryo_cc_sc7.c 52451 2010-09-19 03:00:12Z raster $
39 */
40
41
42#ifdef HAVE_CONFIG_H
43# include <config.h>
44#endif
45
46#include <assert.h>
47#include <stdio.h>
48#include <stdlib.h> /* for atoi() */
49#include <string.h>
50#include <ctype.h>
51
52#include "embryo_cc_sc.h"
53
54#if defined _MSC_VER
55#pragma warning(push)
56#pragma warning(disable:4125) /* decimal digit terminates octal escape sequence */
57#endif
58
59#include "embryo_cc_sc7.scp"
60
61#if defined _MSC_VER
62#pragma warning(pop)
63#endif
64
65static void stgstring(char *start, char *end);
66static void stgopt(char *start, char *end);
67
68#define sSTG_GROW 512
69#define sSTG_MAX 20480
70
71static char *stgbuf = NULL;
72static int stgmax = 0; /* current size of the staging buffer */
73
74#define CHECK_STGBUFFER(index) if ((int)(index)>=stgmax) grow_stgbuffer((index)+1)
75
76static void
77grow_stgbuffer(int requiredsize)
78{
79 char *p;
80 int clear = !stgbuf; /* if previously none, empty buffer explicitly */
81
82 assert(stgmax < requiredsize);
83 /* if the staging buffer (holding intermediate code for one line) grows
84 * over a few kBytes, there is probably a run-away expression
85 */
86 if (requiredsize > sSTG_MAX)
87 error(102, "staging buffer"); /* staging buffer overflow (fatal error) */
88 stgmax = requiredsize + sSTG_GROW;
89 if (stgbuf)
90 p = (char *)realloc(stgbuf, stgmax * sizeof(char));
91 else
92 p = (char *)malloc(stgmax * sizeof(char));
93 if (!p)
94 error(102, "staging buffer"); /* staging buffer overflow (fatal error) */
95 stgbuf = p;
96 if (clear)
97 *stgbuf = '\0';
98}
99
100void
101stgbuffer_cleanup(void)
102{
103 if (stgbuf)
104 {
105 free(stgbuf);
106 stgbuf = NULL;
107 stgmax = 0;
108 } /* if */
109}
110
111/* the variables "stgidx" and "staging" are declared in "scvars.c" */
112
113/* stgmark
114 *
115 * Copies a mark into the staging buffer. At this moment there are three
116 * possible marks:
117 * sSTARTREORDER identifies the beginning of a series of expression
118 * strings that must be written to the output file in
119 * reordered order
120 * sENDREORDER identifies the end of 'reverse evaluation'
121 * sEXPRSTART + idx only valid within a block that is evaluated in
122 * reordered order, it identifies the start of an
123 * expression; the "idx" value is the argument position
124 *
125 * Global references: stgidx (altered)
126 * stgbuf (altered)
127 * staging (referred to only)
128 */
129void
130stgmark(char mark)
131{
132 if (staging)
133 {
134 CHECK_STGBUFFER(stgidx);
135 stgbuf[stgidx++] = mark;
136 } /* if */
137}
138
139static int
140filewrite(char *str)
141{
142 if (sc_status == statWRITE)
143 return sc_writeasm(outf, str);
144 return TRUE;
145}
146
147/* stgwrite
148 *
149 * Writes the string "st" to the staging buffer or to the output file. In the
150 * case of writing to the staging buffer, the terminating byte of zero is
151 * copied too, but... the optimizer can only work on complete lines (not on
152 * fractions of it. Therefore if the string is staged, if the last character
153 * written to the buffer is a '\0' and the previous-to-last is not a '\n',
154 * the string is concatenated to the last string in the buffer (the '\0' is
155 * overwritten). This also means an '\n' used in the middle of a string isn't
156 * recognized and could give wrong results with the optimizer.
157 * Even when writing to the output file directly, all strings are buffered
158 * until a whole line is complete.
159 *
160 * Global references: stgidx (altered)
161 * stgbuf (altered)
162 * staging (referred to only)
163 */
164void
165stgwrite(char *st)
166{
167 int len;
168
169 CHECK_STGBUFFER(0);
170 if (staging)
171 {
172 if (stgidx >= 2 && stgbuf[stgidx - 1] == '\0'
173 && stgbuf[stgidx - 2] != '\n')
174 stgidx -= 1; /* overwrite last '\0' */
175 while (*st != '\0')
176 { /* copy to staging buffer */
177 CHECK_STGBUFFER(stgidx);
178 stgbuf[stgidx++] = *st++;
179 } /* while */
180 CHECK_STGBUFFER(stgidx);
181 stgbuf[stgidx++] = '\0';
182 }
183 else
184 {
185 CHECK_STGBUFFER(strlen(stgbuf) + strlen(st) + 1);
186 strcat(stgbuf, st);
187 len = strlen(stgbuf);
188 if (len > 0 && stgbuf[len - 1] == '\n')
189 {
190 filewrite(stgbuf);
191 stgbuf[0] = '\0';
192 } /* if */
193 } /* if */
194}
195
196/* stgout
197 *
198 * Writes the staging buffer to the output file via stgstring() (for
199 * reversing expressions in the buffer) and stgopt() (for optimizing). It
200 * resets "stgidx".
201 *
202 * Global references: stgidx (altered)
203 * stgbuf (referred to only)
204 * staging (referred to only)
205 */
206void
207stgout(int index)
208{
209 if (!staging)
210 return;
211 stgstring(&stgbuf[index], &stgbuf[stgidx]);
212 stgidx = index;
213}
214
215typedef struct
216{
217 char *start, *end;
218} argstack;
219
220/* stgstring
221 *
222 * Analyses whether code strings should be output to the file as they appear
223 * in the staging buffer or whether portions of it should be re-ordered.
224 * Re-ordering takes place in function argument lists; Small passes arguments
225 * to functions from right to left. When arguments are "named" rather than
226 * positional, the order in the source stream is indeterminate.
227 * This function calls itself recursively in case it needs to re-order code
228 * strings, and it uses a private stack (or list) to mark the start and the
229 * end of expressions in their correct (reversed) order.
230 * In any case, stgstring() sends a block as large as possible to the
231 * optimizer stgopt().
232 *
233 * In "reorder" mode, each set of code strings must start with the token
234 * sEXPRSTART, even the first. If the token sSTARTREORDER is represented
235 * by '[', sENDREORDER by ']' and sEXPRSTART by '|' the following applies:
236 * '[]...' valid, but useless; no output
237 * '[|...] valid, but useless; only one string
238 * '[|...|...] valid and useful
239 * '[...|...] invalid, first string doesn't start with '|'
240 * '[|...|] invalid
241 */
242static void
243stgstring(char *start, char *end)
244{
245 char *ptr;
246 int nest, argc, arg;
247 argstack *stack;
248
249 while (start < end)
250 {
251 if (*start == sSTARTREORDER)
252 {
253 start += 1; /* skip token */
254 /* allocate a argstack with sMAXARGS items */
255 stack = (argstack *) malloc(sMAXARGS * sizeof(argstack));
256 if (!stack)
257 error(103); /* insufficient memory */
258 nest = 1; /* nesting counter */
259 argc = 0; /* argument counter */
260 arg = -1; /* argument index; no valid argument yet */
261 do
262 {
263 switch (*start)
264 {
265 case sSTARTREORDER:
266 nest++;
267 start++;
268 break;
269 case sENDREORDER:
270 nest--;
271 start++;
272 break;
273 default:
274 if ((*start & sEXPRSTART) == sEXPRSTART)
275 {
276 if (nest == 1)
277 {
278 if (arg >= 0)
279 stack[arg].end = start - 1; /* finish previous argument */
280 arg = (unsigned char)*start - sEXPRSTART;
281 stack[arg].start = start + 1;
282 if (arg >= argc)
283 argc = arg + 1;
284 } /* if */
285 start++;
286 }
287 else
288 {
289 start += strlen(start) + 1;
290 } /* if */
291 } /* switch */
292 }
293 while (nest); /* enddo */
294 if (arg >= 0)
295 stack[arg].end = start - 1; /* finish previous argument */
296 while (argc > 0)
297 {
298 argc--;
299 stgstring(stack[argc].start, stack[argc].end);
300 } /* while */
301 free(stack);
302 }
303 else
304 {
305 ptr = start;
306 while (ptr < end && *ptr != sSTARTREORDER)
307 ptr += strlen(ptr) + 1;
308 stgopt(start, ptr);
309 start = ptr;
310 } /* if */
311 } /* while */
312}
313
314/* stgdel
315 *
316 * Scraps code from the staging buffer by resetting "stgidx" to "index".
317 *
318 * Global references: stgidx (altered)
319 * staging (referred to only)
320 */
321void
322stgdel(int index, cell code_index)
323{
324 if (staging)
325 {
326 stgidx = index;
327 code_idx = code_index;
328 } /* if */
329}
330
331int
332stgget(int *index, cell * code_index)
333{
334 if (staging)
335 {
336 *index = stgidx;
337 *code_index = code_idx;
338 } /* if */
339 return staging;
340}
341
342/* stgset
343 *
344 * Sets staging on or off. If it's turned off, the staging buffer must be
345 * initialized to an empty string. If it's turned on, the routine makes sure
346 * the index ("stgidx") is set to 0 (it should already be 0).
347 *
348 * Global references: staging (altered)
349 * stgidx (altered)
350 * stgbuf (contents altered)
351 */
352void
353stgset(int onoff)
354{
355 staging = onoff;
356 if (staging)
357 {
358 assert(stgidx == 0);
359 stgidx = 0;
360 CHECK_STGBUFFER(stgidx);
361 /* write any contents that may be put in the buffer by stgwrite()
362 * when "staging" was 0
363 */
364 if (stgbuf[0] != '\0')
365 filewrite(stgbuf);
366 } /* if */
367 stgbuf[0] = '\0';
368}
369
370/* phopt_init
371 * Initialize all sequence strings of the peehole optimizer. The strings
372 * are embedded in the .EXE file in compressed format, here we expand
373 * them (and allocate memory for the sequences).
374 */
375static SEQUENCE *sequences;
376
377int
378phopt_init(void)
379{
380 int number, i, len;
381 char str[160];
382
383 /* count number of sequences */
384 for (number = 0; sequences_cmp[number].find; number++)
385 /* nothing */ ;
386 number++; /* include an item for the NULL terminator */
387
388 if (!(sequences = (SEQUENCE *)malloc(number * sizeof(SEQUENCE))))
389 return FALSE;
390
391 /* pre-initialize all to NULL (in case of failure) */
392 for (i = 0; i < number; i++)
393 {
394 sequences[i].find = NULL;
395 sequences[i].replace = NULL;
396 sequences[i].savesize = 0;
397 } /* for */
398
399 /* expand all strings */
400 for (i = 0; i < number - 1; i++)
401 {
402 len =
403 strexpand(str, (unsigned char *)sequences_cmp[i].find, sizeof str,
404 SCPACK_TABLE);
405 assert(len <= (int)(sizeof(str)));
406 assert(len == (int)(strlen(str) + 1));
407 sequences[i].find = (char *)malloc(len);
408 if (sequences[i].find)
409 strcpy(sequences[i].find, str);
410 len =
411 strexpand(str, (unsigned char *)sequences_cmp[i].replace, sizeof str,
412 SCPACK_TABLE);
413 assert(len <= (int)(sizeof(str)));
414 assert(len == (int)(strlen(str) + 1));
415 sequences[i].replace = (char *)malloc(len);
416 if (sequences[i].replace)
417 strcpy(sequences[i].replace, str);
418 sequences[i].savesize = sequences_cmp[i].savesize;
419 if (!sequences[i].find || !sequences[i].replace)
420 return phopt_cleanup();
421 } /* for */
422
423 return TRUE;
424}
425
426int
427phopt_cleanup(void)
428{
429 int i;
430
431 if (sequences)
432 {
433 i = 0;
434 while (sequences[i].find || sequences[i].replace)
435 {
436 if (sequences[i].find)
437 free(sequences[i].find);
438 if (sequences[i].replace)
439 free(sequences[i].replace);
440 i++;
441 } /* while */
442 free(sequences);
443 sequences = NULL;
444 } /* if */
445 return FALSE;
446}
447
448#define _maxoptvars 4
449#define _aliasmax 10 /* a 32-bit number can be represented in
450 * 9 decimal digits */
451
452static int
453matchsequence(char *start, char *end, char *pattern,
454 char symbols[_maxoptvars][_aliasmax + 1], int *match_length)
455{
456 int var, i;
457 char str[_aliasmax + 1];
458 char *start_org = start;
459
460 *match_length = 0;
461 for (var = 0; var < _maxoptvars; var++)
462 symbols[var][0] = '\0';
463
464 while (*start == '\t' || *start == ' ')
465 start++;
466 while (*pattern)
467 {
468 if (start >= end)
469 return FALSE;
470 switch (*pattern)
471 {
472 case '%': /* new "symbol" */
473 pattern++;
474 assert(isdigit(*pattern));
475 var = atoi(pattern) - 1;
476 assert(var >= 0 && var < _maxoptvars);
477 assert(alphanum(*start));
478 for (i = 0; start < end && alphanum(*start); i++, start++)
479 {
480 assert(i <= _aliasmax);
481 str[i] = *start;
482 } /* for */
483 str[i] = '\0';
484 if (symbols[var][0] != '\0')
485 {
486 if (strcmp(symbols[var], str) != 0)
487 return FALSE; /* symbols should be identical */
488 }
489 else
490 {
491 strcpy(symbols[var], str);
492 } /* if */
493 break;
494 case ' ':
495 if (*start != '\t' && *start != ' ')
496 return FALSE;
497 while ((start < end && *start == '\t') || *start == ' ')
498 start++;
499 break;
500 case '!':
501 while ((start < end && *start == '\t') || *start == ' ')
502 start++; /* skip trailing white space */
503 if (*start != '\n')
504 return FALSE;
505 assert(*(start + 1) == '\0');
506 start += 2; /* skip '\n' and '\0' */
507 if (*(pattern + 1) != '\0')
508 while ((start < end && *start == '\t') || *start == ' ')
509 start++; /* skip leading white space of next instruction */
510 break;
511 default:
512 if (tolower(*start) != tolower(*pattern))
513 return FALSE;
514 start++;
515 } /* switch */
516 pattern++;
517 } /* while */
518
519 *match_length = (int)(start - start_org);
520 return TRUE;
521}
522
523static char *
524replacesequence(char *pattern, char symbols[_maxoptvars][_aliasmax + 1],
525 int *repl_length)
526{
527 char *lptr;
528 int var;
529 char *buffer;
530
531 /* calculate the length of the new buffer
532 * this is the length of the pattern plus the length of all symbols (note
533 * that the same symbol may occur multiple times in the pattern) plus
534 * line endings and startings ('\t' to start a line and '\n\0' to end one)
535 */
536 assert(repl_length != NULL);
537 *repl_length = 0;
538 lptr = pattern;
539 while (*lptr)
540 {
541 switch (*lptr)
542 {
543 case '%':
544 lptr++; /* skip '%' */
545 assert(isdigit(*lptr));
546 var = atoi(lptr) - 1;
547 assert(var >= 0 && var < _maxoptvars);
548 assert(symbols[var][0] != '\0'); /* variable should be defined */
549 *repl_length += strlen(symbols[var]);
550 break;
551 case '!':
552 *repl_length += 3; /* '\t', '\n' & '\0' */
553 break;
554 default:
555 *repl_length += 1;
556 } /* switch */
557 lptr++;
558 } /* while */
559
560 /* allocate a buffer to replace the sequence in */
561 if (!(buffer = malloc(*repl_length)))
562 {
563 error(103);
564 return NULL;
565 }
566
567 /* replace the pattern into this temporary buffer */
568 lptr = buffer;
569 *lptr++ = '\t'; /* the "replace" patterns do not have tabs */
570 while (*pattern)
571 {
572 assert((int)(lptr - buffer) < *repl_length);
573 switch (*pattern)
574 {
575 case '%':
576 /* write out the symbol */
577 pattern++;
578 assert(isdigit(*pattern));
579 var = atoi(pattern) - 1;
580 assert(var >= 0 && var < _maxoptvars);
581 assert(symbols[var][0] != '\0'); /* variable should be defined */
582 strcpy(lptr, symbols[var]);
583 lptr += strlen(symbols[var]);
584 break;
585 case '!':
586 /* finish the line, optionally start the next line with an indent */
587 *lptr++ = '\n';
588 *lptr++ = '\0';
589 if (*(pattern + 1) != '\0')
590 *lptr++ = '\t';
591 break;
592 default:
593 *lptr++ = *pattern;
594 } /* switch */
595 pattern++;
596 } /* while */
597
598 assert((int)(lptr - buffer) == *repl_length);
599 return buffer;
600}
601
602static void
603strreplace(char *dest, char *replace, int sub_length, int repl_length,
604 int dest_length)
605{
606 int offset = sub_length - repl_length;
607
608 if (offset > 0) /* delete a section */
609 memmove(dest, dest + offset, dest_length - offset);
610 else if (offset < 0) /* insert a section */
611 memmove(dest - offset, dest, dest_length);
612 memcpy(dest, replace, repl_length);
613}
614
615/* stgopt
616 *
617 * Optimizes the staging buffer by checking for series of instructions that
618 * can be coded more compact. The routine expects the lines in the staging
619 * buffer to be separated with '\n' and '\0' characters.
620 *
621 * The longest sequences must be checked first.
622 */
623
624static void
625stgopt(char *start, char *end)
626{
627 char symbols[_maxoptvars][_aliasmax + 1];
628 int seq, match_length, repl_length;
629
630 assert(sequences != NULL);
631 while (start < end)
632 {
633 if ((sc_debug & sNOOPTIMIZE) != 0 || sc_status != statWRITE)
634 {
635 /* do not match anything if debug-level is maximum */
636 filewrite(start);
637 }
638 else
639 {
640 seq = 0;
641 while (sequences[seq].find)
642 {
643 assert(seq >= 0);
644 if (matchsequence
645 (start, end, sequences[seq].find, symbols, &match_length))
646 {
647 char *replace =
648 replacesequence(sequences[seq].replace, symbols,
649 &repl_length);
650 /* If the replacement is bigger than the original section, we may need
651 * to "grow" the staging buffer. This is quite complex, due to the
652 * re-ordering of expressions that can also happen in the staging
653 * buffer. In addition, it should not happen: the peephole optimizer
654 * must replace sequences with *shorter* sequences, not longer ones.
655 * So, I simply forbid sequences that are longer than the ones they
656 * are meant to replace.
657 */
658 assert(match_length >= repl_length);
659 if (match_length >= repl_length)
660 {
661 strreplace(start, replace, match_length,
662 repl_length, (int)(end - start));
663 end -= match_length - repl_length;
664 free(replace);
665 code_idx -= sequences[seq].savesize;
666 seq = 0; /* restart search for matches */
667 }
668 else
669 {
670 /* actually, we should never get here (match_length<repl_length) */
671 assert(0);
672 seq++;
673 } /* if */
674 }
675 else
676 {
677 seq++;
678 } /* if */
679 } /* while */
680 assert(sequences[seq].find == NULL);
681 filewrite(start);
682 } /* if */
683 assert(start < end);
684 start += strlen(start) + 1; /* to next string */
685 } /* while (start<end) */
686}
687
688#undef SCPACK_TABLE
diff --git a/libraries/embryo/src/bin/embryo_cc_sc7.scp b/libraries/embryo/src/bin/embryo_cc_sc7.scp
new file mode 100644
index 0000000..15c80ac
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc7.scp
@@ -0,0 +1,1473 @@
1/* Small compiler - Peephole optimizer "sequences" strings (plain
2 * and compressed formats)
3 *
4 * Copyright (c) ITB CompuPhase, 2000-2003
5 *
6 * This software is provided "as-is", without any express or implied warranty.
7 * In no event will the authors be held liable for any damages arising from
8 * the use of this software.
9 *
10 * Permission is granted to anyone to use this software for any purpose,
11 * including commercial applications, and to alter it and redistribute it
12 * freely, subject to the following restrictions:
13 *
14 * 1. The origin of this software must not be misrepresented; you must not
15 * claim that you wrote the original software. If you use this software in
16 * a product, an acknowledgment in the product documentation would be
17 * appreciated but is not required.
18 * 2. Altered source versions must be plainly marked as such, and must not be
19 * misrepresented as being the original software.
20 * 3. This notice may not be removed or altered from any source distribution.
21 *
22 * Version: $Id: embryo_cc_sc7.scp 35497 2008-08-17 07:44:18Z raster $
23 */
24
25int strexpand(char *dest, unsigned char *source, int maxlen,
26 unsigned char pairtable[128][2]);
27
28#define SCPACK_TERMINATOR , /* end each section with a comma */
29
30#define SCPACK_TABLE sequences_table
31/*-*SCPACK start of pair table, do not change or remove this line */
32unsigned char sequences_table[][2] = {
33 {32, 37}, {114, 105}, {112, 129}, {46, 130}, {49, 33}, {128, 132}, {97, 100},
34 {46, 97}, {135, 108}, {136, 116}, {111, 134}, {108, 138}, {50, 33}, {115,
35 104},
36 {128, 140}, {137, 33},
37 {46, 115}, {117, 141}, {112, 145}, {131, 133}, {139, 144}, {112, 143}, {131,
38 142},
39 {115, 116}, {111, 149}, {112, 152}, {131, 33}, {134, 100}, {110, 151},
40 {111, 156}, {99, 157}, {59, 36},
41 {146, 154}, {148, 150}, {112, 33}, {120, 162}, {101, 163}, {159, 164}, {137,
42 133},
43 {46, 99}, {122, 101}, {110, 100}, {155, 114}, {101, 113}, {168, 114},
44 {147, 160}, {51, 33}, {128, 174},
45 {103, 33}, {133, 165}, {104, 176}, {99, 178}, {120, 179}, {171, 33}, {106,
46 172},
47 {173, 161}, {155, 33}, {108, 167}, {117, 169}, {115, 175}, {186, 187},
48 {153, 184}, {141, 185}, {111, 188},
49 {98, 191}, {105, 100}, {115, 103}, {115, 108}, {193, 120}, {182, 133}, {114,
50 33},
51 {166, 161}, {190, 131}, {137, 142}, {169, 33}, {97, 202}, {139, 147},
52 {172, 111}, {158, 147}, {139, 150},
53 {105, 33}, {101, 115}, {209, 115}, {114, 116}, {148, 147}, {171, 133}, {189,
54 139},
55 {32, 140}, {146, 167}, {196, 170}, {158, 183}, {170, 183}, {199, 192},
56 {108, 196}, {97, 198}, {194, 211},
57 {46, 208}, {195, 210}, {200, 215}, {112, 222}, {159, 227}, {46, 98}, {118,
58 101},
59 {111, 230}, {109, 231}, {146, 143}, {99, 144}, {158, 150}, {97, 149},
60 {203, 153}, {52, 33}, {225, 33},
61 {158, 166}, {194, 181}, {195, 181}, {201, 180}, {223, 198}, {153, 203}, {214,
62 224},
63 {100, 101}, {128, 238}, {119, 236}, {249, 237}, {105, 110}, {115, 250},
64 {232, 143}, {205, 154}
65};
66/*-*SCPACK end of pair table, do not change or remove this line */
67
68#define seqsize(o,p) (opcodes(o)+opargs(p))
69typedef struct
70{
71 char *find;
72 char *replace;
73 int savesize; /* number of bytes saved (in bytecode) */
74} SEQUENCE;
75static SEQUENCE sequences_cmp[] = {
76 /* A very common sequence in four varieties
77 * load.s.pri n1 load.s.pri n2
78 * push.pri load.s.alt n1
79 * load.s.pri n2 -
80 * pop.alt -
81 * --------------------------------------
82 * load.pri n1 load.s.pri n2
83 * push.pri load.alt n1
84 * load.s.pri n2 -
85 * pop.alt -
86 * --------------------------------------
87 * load.s.pri n1 load.pri n2
88 * push.pri load.s.alt n1
89 * load.pri n2 -
90 * pop.alt -
91 * --------------------------------------
92 * load.pri n1 load.pri n2
93 * push.pri load.alt n1
94 * load.pri n2 -
95 * pop.alt -
96 */
97 {
98#ifdef SCPACK
99 "load.s.pri %1!push.pri!load.s.pri %2!pop.alt!",
100 "load.s.pri %2!load.s.alt %1!",
101#else
102 "\224\267\231",
103 "\241\224\246",
104#endif
105 seqsize(4, 2) - seqsize(2, 2)},
106 {
107#ifdef SCPACK
108 "load.pri %1!push.pri!load.s.pri %2!pop.alt!",
109 "load.s.pri %2!load.alt %1!",
110#else
111 "\213\267\231",
112 "\241\213\246",
113#endif
114 seqsize(4, 2) - seqsize(2, 2)},
115 {
116#ifdef SCPACK
117 "load.s.pri %1!push.pri!load.pri %2!pop.alt!",
118 "load.pri %2!load.s.alt %1!",
119#else
120 "\224\255\317\231",
121 "\317\224\246",
122#endif
123 seqsize(4, 2) - seqsize(2, 2)},
124 {
125#ifdef SCPACK
126 "load.pri %1!push.pri!load.pri %2!pop.alt!",
127 "load.pri %2!load.alt %1!",
128#else
129 "\213\255\317\231",
130 "\317\213\246",
131#endif
132 seqsize(4, 2) - seqsize(2, 2)},
133 /* (#1#) The above also occurs with "addr.pri" (array
134 * indexing) as the first line; so that adds 2 cases.
135 */
136 {
137#ifdef SCPACK
138 "addr.pri %1!push.pri!load.s.pri %2!pop.alt!",
139 "addr.alt %1!load.s.pri %2!",
140#else
141 "\333\231",
142 "\252\307",
143#endif
144 seqsize(4, 2) - seqsize(2, 2)},
145 {
146#ifdef SCPACK
147 "addr.pri %1!push.pri!load.pri %2!pop.alt!",
148 "addr.alt %1!load.pri %2!",
149#else
150 "\252\255\317\231",
151 "\252\246\317",
152#endif
153 seqsize(4, 2) - seqsize(2, 2)},
154 /* And the same sequence with const.pri as either the first
155 * or the second load instruction: four more cases.
156 */
157 {
158#ifdef SCPACK
159 "const.pri %1!push.pri!load.s.pri %2!pop.alt!",
160 "load.s.pri %2!const.alt %1!",
161#else
162 "\332\231",
163 "\241\360",
164#endif
165 seqsize(4, 2) - seqsize(2, 2)},
166 {
167#ifdef SCPACK
168 "const.pri %1!push.pri!load.pri %2!pop.alt!",
169 "load.pri %2!const.alt %1!",
170#else
171 "\236\255\317\231",
172 "\317\360",
173#endif
174 seqsize(4, 2) - seqsize(2, 2)},
175 {
176#ifdef SCPACK
177 "load.s.pri %1!push.pri!const.pri %2!pop.alt!",
178 "const.pri %2!load.s.alt %1!",
179#else
180 "\224\255\353\231",
181 "\353\224\246",
182#endif
183 seqsize(4, 2) - seqsize(2, 2)},
184 {
185#ifdef SCPACK
186 "load.pri %1!push.pri!const.pri %2!pop.alt!",
187 "const.pri %2!load.alt %1!",
188#else
189 "\213\255\353\231",
190 "\353\213\246",
191#endif
192 seqsize(4, 2) - seqsize(2, 2)},
193 /* The same as above, but now with "addr.pri" (array
194 * indexing) on the first line and const.pri on
195 * the second.
196 */
197 {
198#ifdef SCPACK
199 "addr.pri %1!push.pri!const.pri %2!pop.alt!",
200 "addr.alt %1!const.pri %2!",
201#else
202 "\252\255\353\231",
203 "\252\246\353",
204#endif
205 seqsize(4, 2) - seqsize(2, 2)},
206 /* ??? add references */
207 /* Chained relational operators can contain sequences like:
208 * move.pri load.s.pri n1
209 * push.pri -
210 * load.s.pri n1 -
211 * pop.alt -
212 * The above also accurs for "load.pri" and for "const.pri",
213 * so add another two cases.
214 */
215 {
216#ifdef SCPACK
217 "move.pri!push.pri!load.s.pri %1!pop.alt!",
218 "load.s.pri %1!",
219#else
220 "\350\232\240\324\231",
221 "\324",
222#endif
223 seqsize(4, 1) - seqsize(1, 1)},
224 {
225#ifdef SCPACK
226 "move.pri!push.pri!load.pri %1!pop.alt!",
227 "load.pri %1!",
228#else
229 "\350\232\240\314\231",
230 "\314",
231#endif
232 seqsize(4, 1) - seqsize(1, 1)},
233 {
234#ifdef SCPACK
235 "move.pri!push.pri!const.pri %1!pop.alt!",
236 "const.pri %1!",
237#else
238 "\350\232\240\316\231",
239 "\316",
240#endif
241 seqsize(4, 1) - seqsize(1, 1)},
242 /* More optimizations for chained relational operators; the
243 * continuation sequences can be simplified if they turn out
244 * to be termination sequences:
245 * xchg sless also for sless, sgeq and sleq
246 * sgrtr pop.alt
247 * swap.alt and
248 * and ;$exp
249 * pop.alt -
250 * ;$exp -
251 * --------------------------------------
252 * xchg sless also for sless, sgeq and sleq
253 * sgrtr pop.alt
254 * swap.alt and
255 * and jzer n1
256 * pop.alt -
257 * jzer n1 -
258 * --------------------------------------
259 * xchg jsgeq n1 also for sless, sgeq and sleq
260 * sgrtr ;$exp (occurs for non-chained comparisons)
261 * jzer n1 -
262 * ;$exp -
263 * --------------------------------------
264 * xchg sless also for sless, sgeq and sleq
265 * sgrtr ;$exp (occurs for non-chained comparisons)
266 * ;$exp -
267 */
268 {
269#ifdef SCPACK
270 "xchg!sgrtr!swap.alt!and!pop.alt!;$exp!",
271 "sless!pop.alt!and!;$exp!",
272#else
273 "\264\364\374\245",
274 "\357\365\245",
275#endif
276 seqsize(5, 0) - seqsize(3, 0)},
277 {
278#ifdef SCPACK
279 "xchg!sless!swap.alt!and!pop.alt!;$exp!",
280 "sgrtr!pop.alt!and!;$exp!",
281#else
282 "\264\357\374\245",
283 "\364\365\245",
284#endif
285 seqsize(5, 0) - seqsize(3, 0)},
286 {
287#ifdef SCPACK
288 "xchg!sgeq!swap.alt!and!pop.alt!;$exp!",
289 "sleq!pop.alt!and!;$exp!",
290#else
291 "\264\361\374\245",
292 "\362\365\245",
293#endif
294 seqsize(5, 0) - seqsize(3, 0)},
295 {
296#ifdef SCPACK
297 "xchg!sleq!swap.alt!and!pop.alt!;$exp!",
298 "sgeq!pop.alt!and!;$exp!",
299#else
300 "\264\362\374\245",
301 "\361\365\245",
302#endif
303 seqsize(5, 0) - seqsize(3, 0)},
304 {
305#ifdef SCPACK
306 "xchg!sgrtr!swap.alt!and!pop.alt!jzer %1!",
307 "sless!pop.alt!and!jzer %1!",
308#else
309 "\264\364\374\305",
310 "\357\365\305",
311#endif
312 seqsize(5, 0) - seqsize(3, 0)},
313 {
314#ifdef SCPACK
315 "xchg!sless!swap.alt!and!pop.alt!jzer %1!",
316 "sgrtr!pop.alt!and!jzer %1!",
317#else
318 "\264\357\374\305",
319 "\364\365\305",
320#endif
321 seqsize(5, 0) - seqsize(3, 0)},
322 {
323#ifdef SCPACK
324 "xchg!sgeq!swap.alt!and!pop.alt!jzer %1!",
325 "sleq!pop.alt!and!jzer %1!",
326#else
327 "\264\361\374\305",
328 "\362\365\305",
329#endif
330 seqsize(5, 0) - seqsize(3, 0)},
331 {
332#ifdef SCPACK
333 "xchg!sleq!swap.alt!and!pop.alt!jzer %1!",
334 "sgeq!pop.alt!and!jzer %1!",
335#else
336 "\264\362\374\305",
337 "\361\365\305",
338#endif
339 seqsize(5, 0) - seqsize(3, 0)},
340 {
341#ifdef SCPACK
342 "xchg!sgrtr!jzer %1!;$exp!",
343 "jsgeq %1!;$exp!",
344#else
345 "\264\364\266\261",
346 "j\302\253\261",
347#endif
348 seqsize(3, 1) - seqsize(1, 1)},
349 {
350#ifdef SCPACK
351 "xchg!sless!jzer %1!;$exp!",
352 "jsleq %1!;$exp!",
353#else
354 "\264\357\266\261",
355 "j\303\253\261",
356#endif
357 seqsize(3, 1) - seqsize(1, 1)},
358 {
359#ifdef SCPACK
360 "xchg!sgeq!jzer %1!;$exp!",
361 "jsgrtr %1!;$exp!",
362#else
363 "\264\361\266\261",
364 "j\337r\261",
365#endif
366 seqsize(3, 1) - seqsize(1, 1)},
367 {
368#ifdef SCPACK
369 "xchg!sleq!jzer %1!;$exp!",
370 "jsless %1!;$exp!",
371#else
372 "\264\362\266\261",
373 "j\341\261",
374#endif
375 seqsize(3, 1) - seqsize(1, 1)},
376 {
377#ifdef SCPACK
378 "xchg!sgrtr!;$exp!",
379 "sless!;$exp!",
380#else
381 "\264\364\245",
382 "\357\245",
383#endif
384 seqsize(2, 0) - seqsize(1, 0)},
385 {
386#ifdef SCPACK
387 "xchg!sless!;$exp!",
388 "sgrtr!;$exp!",
389#else
390 "\264\357\245",
391 "\364\245",
392#endif
393 seqsize(2, 0) - seqsize(1, 0)},
394 {
395#ifdef SCPACK
396 "xchg!sgeq!;$exp!",
397 "sleq!;$exp!",
398#else
399 "\264\361\245",
400 "\362\245",
401#endif
402 seqsize(2, 0) - seqsize(1, 0)},
403 {
404#ifdef SCPACK
405 "xchg!sleq!;$exp!",
406 "sgeq!;$exp!",
407#else
408 "\264\362\245",
409 "\361\245",
410#endif
411 seqsize(2, 0) - seqsize(1, 0)},
412 /* The entry to chained operators is also opt to optimization
413 * load.s.pri n1 load.s.pri n2
414 * load.s.alt n2 load.s.alt n1
415 * xchg -
416 * --------------------------------------
417 * load.s.pri n1 load.pri n2
418 * load.alt n2 load.s.alt n1
419 * xchg -
420 * --------------------------------------
421 * load.s.pri n1 const.pri n2
422 * const.alt n2 load.s.alt n1
423 * xchg -
424 * --------------------------------------
425 * and all permutations...
426 */
427 {
428#ifdef SCPACK
429 "load.s.pri %1!load.s.alt %2!xchg!",
430 "load.s.pri %2!load.s.alt %1!",
431#else
432 "\324\224\363",
433 "\241\224\246",
434#endif
435 seqsize(3, 2) - seqsize(2, 2)},
436 {
437#ifdef SCPACK
438 "load.s.pri %1!load.alt %2!xchg!",
439 "load.pri %2!load.s.alt %1!",
440#else
441 "\324\213\363",
442 "\317\224\246",
443#endif
444 seqsize(3, 2) - seqsize(2, 2)},
445 {
446#ifdef SCPACK
447 "load.s.pri %1!const.alt %2!xchg!",
448 "const.pri %2!load.s.alt %1!",
449#else
450 "\324\236\363",
451 "\353\224\246",
452#endif
453 seqsize(3, 2) - seqsize(2, 2)},
454 {
455#ifdef SCPACK
456 "load.pri %1!load.s.alt %2!xchg!",
457 "load.s.pri %2!load.alt %1!",
458#else
459 "\314\224\363",
460 "\241\213\246",
461#endif
462 seqsize(3, 2) - seqsize(2, 2)},
463 {
464#ifdef SCPACK
465 "load.pri %1!load.alt %2!xchg!",
466 "load.pri %2!load.alt %1!",
467#else
468 "\314\213\363",
469 "\317\213\246",
470#endif
471 seqsize(3, 2) - seqsize(2, 2)},
472 {
473#ifdef SCPACK
474 "load.pri %1!const.alt %2!xchg!",
475 "const.pri %2!load.alt %1!",
476#else
477 "\314\236\363",
478 "\353\213\246",
479#endif
480 seqsize(3, 2) - seqsize(2, 2)},
481 {
482#ifdef SCPACK
483 "const.pri %1!load.s.alt %2!xchg!",
484 "load.s.pri %2!const.alt %1!",
485#else
486 "\316\224\363",
487 "\241\360",
488#endif
489 seqsize(3, 2) - seqsize(2, 2)},
490 {
491#ifdef SCPACK
492 "const.pri %1!load.alt %2!xchg!",
493 "load.pri %2!const.alt %1!",
494#else
495 "\316\213\363",
496 "\317\360",
497#endif
498 seqsize(3, 2) - seqsize(2, 2)},
499 /* Array indexing can merit from special instructions.
500 * Simple indexed array lookup can be optimized quite
501 * a bit.
502 * addr.pri n1 addr.alt n1
503 * push.pri load.s.pri n2
504 * load.s.pri n2 bounds n3
505 * bounds n3 lidx.b n4
506 * shl.c.pri n4 -
507 * pop.alt -
508 * add -
509 * load.i -
510 *
511 * And to prepare for storing a value in an array
512 * addr.pri n1 addr.alt n1
513 * push.pri load.s.pri n2
514 * load.s.pri n2 bounds n3
515 * bounds n3 idxaddr.b n4
516 * shl.c.pri n4 -
517 * pop.alt -
518 * add -
519 *
520 * Notes (additional cases):
521 * 1. instruction addr.pri can also be const.pri (for
522 * global arrays)
523 * 2. the bounds instruction can be absent
524 * 3. when "n4" (the shift value) is the 2 (with 32-bit cels), use the
525 * even more optimal instructions LIDX and IDDXADDR
526 *
527 * If the array index is more complex, one can only optimize
528 * the last four instructions:
529 * shl.c.pri n1 pop.alt
530 * pop.alt lidx.b n1
531 * add -
532 * loadi -
533 * --------------------------------------
534 * shl.c.pri n1 pop.alt
535 * pop.alt idxaddr.b n1
536 * add -
537 */
538#if !defined BIT16
539 /* loading from array, "cell" shifted */
540 {
541#ifdef SCPACK
542 "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!load.i!",
543 "addr.alt %1!load.s.pri %2!bounds %3!lidx!",
544#else
545 "\333\300\342\366",
546 "\252\334\335!",
547#endif
548 seqsize(8, 4) - seqsize(4, 3)},
549 {
550#ifdef SCPACK
551 "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!load.i!",
552 "const.alt %1!load.s.pri %2!bounds %3!lidx!",
553#else
554 "\332\300\342\366",
555 "\236\334\335!",
556#endif
557 seqsize(8, 4) - seqsize(4, 3)},
558 {
559#ifdef SCPACK
560 "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!load.i!",
561 "addr.alt %1!load.s.pri %2!lidx!",
562#else
563 "\333\342\366",
564 "\252\307\335!",
565#endif
566 seqsize(7, 3) - seqsize(3, 2)},
567 {
568#ifdef SCPACK
569 "const.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!load.i!",
570 "const.alt %1!load.s.pri %2!lidx!",
571#else
572 "\332\342\366",
573 "\236\307\335!",
574#endif
575 seqsize(7, 3) - seqsize(3, 2)},
576#endif
577 /* loading from array, not "cell" shifted */
578 {
579#ifdef SCPACK
580 "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!load.i!",
581 "addr.alt %1!load.s.pri %2!bounds %3!lidx.b %4!",
582#else
583 "\333\300\310\370\366",
584 "\252\334\335\345\370",
585#endif
586 seqsize(8, 4) - seqsize(4, 4)},
587 {
588#ifdef SCPACK
589 "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!load.i!",
590 "const.alt %1!load.s.pri %2!bounds %3!lidx.b %4!",
591#else
592 "\332\300\310\370\366",
593 "\236\334\335\345\370",
594#endif
595 seqsize(8, 4) - seqsize(4, 4)},
596 {
597#ifdef SCPACK
598 "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!load.i!",
599 "addr.alt %1!load.s.pri %2!lidx.b %3!",
600#else
601 "\333\310\257\366",
602 "\252\307\335\345\257",
603#endif
604 seqsize(7, 3) - seqsize(3, 3)},
605 {
606#ifdef SCPACK
607 "const.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!load.i!",
608 "const.alt %1!load.s.pri %2!lidx.b %3!",
609#else
610 "\332\310\257\366",
611 "\236\307\335\345\257",
612#endif
613 seqsize(7, 3) - seqsize(3, 3)},
614#if !defined BIT16
615 /* array index calculation for storing a value, "cell" aligned */
616 {
617#ifdef SCPACK
618 "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!",
619 "addr.alt %1!load.s.pri %2!bounds %3!idxaddr!",
620#else
621 "\333\300\342\275",
622 "\252\334\331!",
623#endif
624 seqsize(7, 4) - seqsize(4, 3)},
625 {
626#ifdef SCPACK
627 "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri 2!pop.alt!add!",
628 "const.alt %1!load.s.pri %2!bounds %3!idxaddr!",
629#else
630 "\332\300\342\275",
631 "\236\334\331!",
632#endif
633 seqsize(7, 4) - seqsize(4, 3)},
634 {
635#ifdef SCPACK
636 "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!",
637 "addr.alt %1!load.s.pri %2!idxaddr!",
638#else
639 "\333\342\275",
640 "\252\307\331!",
641#endif
642 seqsize(6, 3) - seqsize(3, 2)},
643 {
644#ifdef SCPACK
645 "const.pri %1!push.pri!load.s.pri %2!shl.c.pri 2!pop.alt!add!",
646 "const.alt %1!load.s.pri %2!idxaddr!",
647#else
648 "\332\342\275",
649 "\236\307\331!",
650#endif
651 seqsize(6, 3) - seqsize(3, 2)},
652#endif
653 /* array index calculation for storing a value, not "cell" packed */
654 {
655#ifdef SCPACK
656 "addr.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!",
657 "addr.alt %1!load.s.pri %2!bounds %3!idxaddr.b %4!",
658#else
659 "\333\300\310\370\275",
660 "\252\334\331\345\370",
661#endif
662 seqsize(7, 4) - seqsize(4, 4)},
663 {
664#ifdef SCPACK
665 "const.pri %1!push.pri!load.s.pri %2!bounds %3!shl.c.pri %4!pop.alt!add!",
666 "const.alt %1!load.s.pri %2!bounds %3!idxaddr.b %4!",
667#else
668 "\332\300\310\370\275",
669 "\236\334\331\345\370",
670#endif
671 seqsize(7, 4) - seqsize(4, 4)},
672 {
673#ifdef SCPACK
674 "addr.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!",
675 "addr.alt %1!load.s.pri %2!idxaddr.b %3!",
676#else
677 "\333\310\257\275",
678 "\252\307\331\345\257",
679#endif
680 seqsize(6, 3) - seqsize(3, 3)},
681 {
682#ifdef SCPACK
683 "const.pri %1!push.pri!load.s.pri %2!shl.c.pri %3!pop.alt!add!",
684 "const.alt %1!load.s.pri %2!idxaddr.b %3!",
685#else
686 "\332\310\257\275",
687 "\236\307\331\345\257",
688#endif
689 seqsize(6, 3) - seqsize(3, 3)},
690#if !defined BIT16
691 /* the shorter array indexing sequences, see above for comments */
692 {
693#ifdef SCPACK
694 "shl.c.pri 2!pop.alt!add!loadi!",
695 "pop.alt!lidx!",
696#else
697 "\342\326\320",
698 "\231\335!",
699#endif
700 seqsize(4, 1) - seqsize(2, 0)},
701 {
702#ifdef SCPACK
703 "shl.c.pri 2!pop.alt!add!",
704 "pop.alt!idxaddr!",
705#else
706 "\342\275",
707 "\231\331!",
708#endif
709 seqsize(3, 1) - seqsize(2, 0)},
710#endif
711 {
712#ifdef SCPACK
713 "shl.c.pri %1!pop.alt!add!loadi!",
714 "pop.alt!lidx.b %1!",
715#else
716 "\276\223\326\320",
717 "\231\335\345\205",
718#endif
719 seqsize(4, 1) - seqsize(2, 1)},
720 {
721#ifdef SCPACK
722 "shl.c.pri %1!pop.alt!add!",
723 "pop.alt!idxaddr.b %1!",
724#else
725 "\276\223\275",
726 "\231\331\345\205",
727#endif
728 seqsize(3, 1) - seqsize(2, 1)},
729 /* For packed arrays, there is another case (packed arrays
730 * do not take advantage of the LIDX or IDXADDR instructions).
731 * addr.pri n1 addr.alt n1
732 * push.pri load.s.pri n2
733 * load.s.pri n2 bounds n3
734 * bounds n3 -
735 * pop.alt -
736 *
737 * Notes (additional cases):
738 * 1. instruction addr.pri can also be const.pri (for
739 * global arrays)
740 * 2. the bounds instruction can be absent, but that
741 * case is already handled (see #1#)
742 */
743 {
744#ifdef SCPACK
745 "addr.pri %1!push.pri!load.s.pri %2!bounds %3!pop.alt!",
746 "addr.alt %1!load.s.pri %2!bounds %3!",
747#else
748 "\333\300\231",
749 "\252\334",
750#endif
751 seqsize(5, 3) - seqsize(3, 3)},
752 {
753#ifdef SCPACK
754 "const.pri %1!push.pri!load.s.pri %2!bounds %3!pop.alt!",
755 "const.alt %1!load.s.pri %2!bounds %3!",
756#else
757 "\332\300\231",
758 "\236\334",
759#endif
760 seqsize(5, 3) - seqsize(3, 3)},
761 /* During a calculation, the intermediate result must sometimes
762 * be moved from PRI to ALT, like in:
763 * push.pri move.alt
764 * load.s.pri n1 load.s.pri n1
765 * pop.alt -
766 *
767 * The above also accurs for "load.pri" and for "const.pri",
768 * so add another two cases.
769 */
770 {
771#ifdef SCPACK
772 "push.pri!load.s.pri %1!pop.alt!",
773 "move.alt!load.s.pri %1!",
774#else
775 "\240\324\231",
776 "\375\324",
777#endif
778 seqsize(3, 1) - seqsize(2, 1)},
779 {
780#ifdef SCPACK
781 "push.pri!load.pri %1!pop.alt!",
782 "move.alt!load.pri %1!",
783#else
784 "\240\314\231",
785 "\375\314",
786#endif
787 seqsize(3, 1) - seqsize(2, 1)},
788 {
789#ifdef SCPACK
790 "push.pri!const.pri %1!pop.alt!",
791 "move.alt!const.pri %1!",
792#else
793 "\240\316\231",
794 "\375\316",
795#endif
796 seqsize(3, 1) - seqsize(2, 1)},
797 {
798#ifdef SCPACK
799 "push.pri!zero.pri!pop.alt!",
800 "move.alt!zero.pri!",
801#else
802 "\240\376\231",
803 "\375\376",
804#endif
805 seqsize(3, 0) - seqsize(2, 0)},
806 /* saving PRI and then loading from its address
807 * occurs when indexing a multi-dimensional array
808 */
809 {
810#ifdef SCPACK
811 "push.pri!load.i!pop.alt!",
812 "move.alt!load.i!",
813#else
814 "\240\213\340\231",
815 "\375\213\340",
816#endif
817 seqsize(3, 0) - seqsize(2, 0)},
818 /* An even simpler PUSH/POP optimization (occurs in
819 * switch statements):
820 * push.pri move.alt
821 * pop.alt -
822 */
823 {
824#ifdef SCPACK
825 "push.pri!pop.alt!",
826 "move.alt!",
827#else
828 "\240\231",
829 "\375",
830#endif
831 seqsize(2, 0) - seqsize(1, 0)},
832 /* And what to think of this PUSH/POP sequence, which occurs
833 * due to the support for user-defined assignment operator):
834 * push.alt -
835 * pop.alt -
836 */
837//???
838//{
839// #ifdef SCPACK
840// "push.alt!pop.alt!",
841// ";$", /* SCPACK cannot handle empty strings */
842// #else
843// "\225\237",
844// "\353",
845// #endif
846// seqsize(2,0) - seqsize(0,0)
847//},
848 /* Functions with many parameters with the same default
849 * value have sequences like:
850 * push.c n1 const.pri n1
851 * ;$par push.r.pri n2 ; where n2 is the number of pushes
852 * push.c n1 ;$par
853 * ;$par -
854 * push.c n1 -
855 * ;$par -
856 * etc. etc.
857 * The shortest matched sequence is 3, because a sequence of two can also be
858 * optimized as two "push.c n1" instructions.
859 * => this optimization does not work, because the argument re-ordering in
860 * a function call causes each argument to be optimized individually
861 */
862//{
863// #ifdef SCPACK
864// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
865// "const.pri %1!push.r.pri 5!;$par!",
866// #else
867// "\327\327\254",
868// "\352\221.r\2745!",
869// #endif
870// seqsize(10,5) - seqsize(2,2)
871//},
872//{
873// #ifdef SCPACK
874// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
875// "const.pri %1!push.r.pri 4!;$par!",
876// #else
877// "\327\327",
878// "\352\221.r\274\326",
879// #endif
880// seqsize(8,4) - seqsize(2,2)
881//},
882//{
883// #ifdef SCPACK
884// "const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!const.pri %1!push.pri!;$par!",
885// "const.pri %1!push.r.pri 3!;$par!",
886// #else
887// "\327\254",
888// "\352\221.r\274\247",
889// #endif
890// seqsize(6,3) - seqsize(2,2)
891//},
892 /* User-defined operators first load the operands into registers and
893 * then have them pushed onto the stack. This can give rise to sequences
894 * like:
895 * const.pri n1 push.c n1
896 * const.alt n2 push.c n2
897 * push.pri -
898 * push.alt -
899 * A similar sequence occurs with the two PUSH.pri/alt instructions inverted.
900 * The first, second, or both CONST.pri/alt instructions can also be
901 * LOAD.pri/alt.
902 * This gives 2 x 4 cases.
903 */
904 {
905#ifdef SCPACK
906 "const.pri %1!const.alt %2!push.pri!push.alt!",
907 "push.c %1!push.c %2!",
908#else
909 "\316\236\311\240\351",
910 "\330\205\330\216",
911#endif
912 seqsize(4, 2) - seqsize(2, 2)},
913 {
914#ifdef SCPACK
915 "const.pri %1!const.alt %2!push.alt!push.pri!",
916 "push.c %2!push.c %1!",
917#else
918 "\316\236\311\351\240",
919 "\330\216\330\205",
920#endif
921 seqsize(4, 2) - seqsize(2, 2)},
922 {
923#ifdef SCPACK
924 "const.pri %1!load.alt %2!push.pri!push.alt!",
925 "push.c %1!push %2!",
926#else
927 "\316\213\311\240\351",
928 "\330\205\222\216",
929#endif
930 seqsize(4, 2) - seqsize(2, 2)},
931 {
932#ifdef SCPACK
933 "const.pri %1!load.alt %2!push.alt!push.pri!",
934 "push %2!push.c %1!",
935#else
936 "\316\213\311\351\240",
937 "\222\216\330\205",
938#endif
939 seqsize(4, 2) - seqsize(2, 2)},
940 {
941#ifdef SCPACK
942 "load.pri %1!const.alt %2!push.pri!push.alt!",
943 "push %1!push.c %2!",
944#else
945 "\314\236\311\240\351",
946 "\222\205\330\216",
947#endif
948 seqsize(4, 2) - seqsize(2, 2)},
949 {
950#ifdef SCPACK
951 "load.pri %1!const.alt %2!push.alt!push.pri!",
952 "push.c %2!push %1!",
953#else
954 "\314\236\311\351\240",
955 "\330\216\222\205",
956#endif
957 seqsize(4, 2) - seqsize(2, 2)},
958 {
959#ifdef SCPACK
960 "load.pri %1!load.alt %2!push.pri!push.alt!",
961 "push %1!push %2!",
962#else
963 "\314\213\311\240\351",
964 "\222\205\222\216",
965#endif
966 seqsize(4, 2) - seqsize(2, 2)},
967 {
968#ifdef SCPACK
969 "load.pri %1!load.alt %2!push.alt!push.pri!",
970 "push %2!push %1!",
971#else
972 "\314\213\311\351\240",
973 "\222\216\222\205",
974#endif
975 seqsize(4, 2) - seqsize(2, 2)},
976 /* Function calls (parameters are passed on the stack)
977 * load.s.pri n1 push.s n1
978 * push.pri -
979 * --------------------------------------
980 * load.pri n1 push n1
981 * push.pri -
982 * --------------------------------------
983 * const.pri n1 push.c n1
984 * push.pri -
985 * --------------------------------------
986 * zero.pri push.c 0
987 * push.pri -
988 * --------------------------------------
989 * addr.pri n1 pushaddr n1
990 * push.pri -
991 *
992 * However, PRI must not be needed after this instruction
993 * if this shortcut is used. Check for the ;$par comment.
994 */
995 {
996#ifdef SCPACK
997 "load.s.pri %1!push.pri!;$par!",
998 "push.s %1!;$par!",
999#else
1000 "\224\255\344",
1001 "\222\220\205\344",
1002#endif
1003 seqsize(2, 1) - seqsize(1, 1)},
1004 {
1005#ifdef SCPACK
1006 "load.pri %1!push.pri!;$par!",
1007 "push %1!;$par!",
1008#else
1009 "\213\255\344",
1010 "\222\205\344",
1011#endif
1012 seqsize(2, 1) - seqsize(1, 1)},
1013 {
1014#ifdef SCPACK
1015 "const.pri %1!push.pri!;$par!",
1016 "push.c %1!;$par!",
1017#else
1018 "\236\255\344",
1019 "\330\205\344",
1020#endif
1021 seqsize(2, 1) - seqsize(1, 1)},
1022 {
1023#ifdef SCPACK
1024 "zero.pri!push.pri!;$par!",
1025 "push.c 0!;$par!",
1026#else
1027 "\376\240\344",
1028 "\330 0!\344",
1029#endif
1030 seqsize(2, 0) - seqsize(1, 1)},
1031 {
1032#ifdef SCPACK
1033 "addr.pri %1!push.pri!;$par!",
1034 "pushaddr %1!;$par!",
1035#else
1036 "\252\255\344",
1037 "\222\252\205\344",
1038#endif
1039 seqsize(2, 1) - seqsize(1, 1)},
1040 /* References with a default value generate new cells on the heap
1041 * dynamically. That code often ends with:
1042 * move.pri push.alt
1043 * push.pri -
1044 */
1045 {
1046#ifdef SCPACK
1047 "move.pri!push.pri!",
1048 "push.alt!",
1049#else
1050 "\350\232\240",
1051 "\351",
1052#endif
1053 seqsize(2, 0) - seqsize(1, 0)},
1054 /* Simple arithmetic operations on constants. Noteworthy is the
1055 * subtraction of a constant, since it is converted to the addition
1056 * of the inverse value.
1057 * const.alt n1 add.c n1
1058 * add -
1059 * --------------------------------------
1060 * const.alt n1 add.c -n1
1061 * sub -
1062 * --------------------------------------
1063 * const.alt n1 smul.c n1
1064 * smul -
1065 * --------------------------------------
1066 * const.alt n1 eq.c.pri n1
1067 * eq -
1068 */
1069 {
1070#ifdef SCPACK
1071 "const.alt %1!add!",
1072 "add.c %1!",
1073#else
1074 "\360\270",
1075 "\233\247\205",
1076#endif
1077 seqsize(2, 1) - seqsize(1, 1)},
1078 {
1079#ifdef SCPACK
1080 "const.alt %1!sub!",
1081 "add.c -%1!",
1082#else
1083 "\360sub!",
1084 "\233\247 -%\204",
1085#endif
1086 seqsize(2, 1) - seqsize(1, 1)},
1087 {
1088#ifdef SCPACK
1089 "const.alt %1!smul!",
1090 "smul.c %1!",
1091#else
1092 "\360smul!",
1093 "smu\271\205",
1094#endif
1095 seqsize(2, 1) - seqsize(1, 1)},
1096 {
1097#ifdef SCPACK
1098 "const.alt %1!eq!",
1099 "eq.c.pri %1!",
1100#else
1101 "\360\265",
1102 "\253\247\223",
1103#endif
1104 seqsize(2, 1) - seqsize(1, 1)},
1105 /* Some operations use the alternative subtraction operation --these
1106 * can also be optimized.
1107 * const.pri n1 load.s.pri n2
1108 * load.s.alt n2 add.c -n1
1109 * sub.alt -
1110 * --------------------------------------
1111 * const.pri n1 load.pri n2
1112 * load.alt n2 add.c -n1
1113 * sub.alt -
1114 */
1115 {
1116#ifdef SCPACK
1117 "const.pri %1!load.s.alt %2!sub.alt!",
1118 "load.s.pri %2!add.c -%1!",
1119#else
1120 "\316\224\311sub\217",
1121 "\241\233\247 -%\204",
1122#endif
1123 seqsize(3, 2) - seqsize(2, 2)},
1124 {
1125#ifdef SCPACK
1126 "const.pri %1!load.alt %2!sub.alt!",
1127 "load.pri %2!add.c -%1!",
1128#else
1129 "\316\213\311sub\217",
1130 "\317\233\247 -%\204",
1131#endif
1132 seqsize(3, 2) - seqsize(2, 2)},
1133 /* Compare and jump
1134 * eq jneq n1
1135 * jzer n1 -
1136 * --------------------------------------
1137 * eq jeq n1
1138 * jnz n1 -
1139 * --------------------------------------
1140 * neq jeq n1
1141 * jzer n1 -
1142 * --------------------------------------
1143 * neq jneq n1
1144 * jnz n1 -
1145 * Compares followed by jzer occur much more
1146 * often than compares followed with jnz. So we
1147 * take the easy route here.
1148 * less jgeq n1
1149 * jzer n1 -
1150 * --------------------------------------
1151 * leq jgrtr n1
1152 * jzer n1 -
1153 * --------------------------------------
1154 * grtr jleq n1
1155 * jzer n1 -
1156 * --------------------------------------
1157 * geq jless n1
1158 * jzer n1 -
1159 * --------------------------------------
1160 * sless jsgeq n1
1161 * jzer n1 -
1162 * --------------------------------------
1163 * sleq jsgrtr n1
1164 * jzer n1 -
1165 * --------------------------------------
1166 * sgrtr jsleq n1
1167 * jzer n1 -
1168 * --------------------------------------
1169 * sgeq jsless n1
1170 * jzer n1 -
1171 */
1172 {
1173#ifdef SCPACK
1174 "eq!jzer %1!",
1175 "jneq %1!",
1176#else
1177 "\265\305",
1178 "jn\325",
1179#endif
1180 seqsize(2, 1) - seqsize(1, 1)},
1181 {
1182#ifdef SCPACK
1183 "eq!jnz %1!",
1184 "jeq %1!",
1185#else
1186 "\265jnz\205",
1187 "j\325",
1188#endif
1189 seqsize(2, 1) - seqsize(1, 1)},
1190 {
1191#ifdef SCPACK
1192 "neq!jzer %1!",
1193 "jeq %1!",
1194#else
1195 "n\265\305",
1196 "j\325",
1197#endif
1198 seqsize(2, 1) - seqsize(1, 1)},
1199 {
1200#ifdef SCPACK
1201 "neq!jnz %1!",
1202 "jneq %1!",
1203#else
1204 "n\265jnz\205",
1205 "jn\325",
1206#endif
1207 seqsize(2, 1) - seqsize(1, 1)},
1208 {
1209#ifdef SCPACK
1210 "less!jzer %1!",
1211 "jgeq %1!",
1212#else
1213 "l\322!\305",
1214 "jg\325",
1215#endif
1216 seqsize(2, 1) - seqsize(1, 1)},
1217 {
1218#ifdef SCPACK
1219 "leq!jzer %1!",
1220 "jgrtr %1!",
1221#else
1222 "l\265\305",
1223 "jg\323r\205",
1224#endif
1225 seqsize(2, 1) - seqsize(1, 1)},
1226 {
1227#ifdef SCPACK
1228 "grtr!jzer %1!",
1229 "jleq %1!",
1230#else
1231 "g\323\306\305",
1232 "jl\325",
1233#endif
1234 seqsize(2, 1) - seqsize(1, 1)},
1235 {
1236#ifdef SCPACK
1237 "geq!jzer %1!",
1238 "jless %1!",
1239#else
1240 "g\265\305",
1241 "jl\322\205",
1242#endif
1243 seqsize(2, 1) - seqsize(1, 1)},
1244 {
1245#ifdef SCPACK
1246 "sless!jzer %1!",
1247 "jsgeq %1!",
1248#else
1249 "\357\305",
1250 "j\302\325",
1251#endif
1252 seqsize(2, 1) - seqsize(1, 1)},
1253 {
1254#ifdef SCPACK
1255 "sleq!jzer %1!",
1256 "jsgrtr %1!",
1257#else
1258 "\362\305",
1259 "j\337r\205",
1260#endif
1261 seqsize(2, 1) - seqsize(1, 1)},
1262 {
1263#ifdef SCPACK
1264 "sgrtr!jzer %1!",
1265 "jsleq %1!",
1266#else
1267 "\364\305",
1268 "j\303\325",
1269#endif
1270 seqsize(2, 1) - seqsize(1, 1)},
1271 {
1272#ifdef SCPACK
1273 "sgeq!jzer %1!",
1274 "jsless %1!",
1275#else
1276 "\361\305",
1277 "j\341\205",
1278#endif
1279 seqsize(2, 1) - seqsize(1, 1)},
1280 /* Test for zero (common case, especially for strings)
1281 * E.g. the test expression of: "for (i=0; str{i}!=0; ++i)"
1282 *
1283 * zero.alt jzer n1
1284 * jeq n1 -
1285 * --------------------------------------
1286 * zero.alt jnz n1
1287 * jneq n1 -
1288 */
1289 {
1290#ifdef SCPACK
1291 "zero.alt!jeq %1!",
1292 "jzer %1!",
1293#else
1294 "\315\217j\325",
1295 "\305",
1296#endif
1297 seqsize(2, 1) - seqsize(1, 1)},
1298 {
1299#ifdef SCPACK
1300 "zero.alt!jneq %1!",
1301 "jnz %1!",
1302#else
1303 "\315\217jn\325",
1304 "jnz\205",
1305#endif
1306 seqsize(2, 1) - seqsize(1, 1)},
1307 /* Incrementing and decrementing leaves a value in
1308 * in PRI which may not be used (for example, as the
1309 * third expression in a "for" loop).
1310 * inc n1 inc n1 ; ++n
1311 * load.pri n1 ;$exp
1312 * ;$exp -
1313 * --------------------------------------
1314 * load.pri n1 inc n1 ; n++, e.g. "for (n=0; n<10; n++)"
1315 * inc n1 ;$exp
1316 * ;$exp -
1317 * Plus the varieties for stack relative increments
1318 * and decrements.
1319 */
1320 {
1321#ifdef SCPACK
1322 "inc %1!load.pri %1!;$exp!",
1323 "inc %1!;$exp!",
1324#else
1325 "\373c\205\314\245",
1326 "\373c\261",
1327#endif
1328 seqsize(2, 2) - seqsize(1, 1)},
1329 {
1330#ifdef SCPACK
1331 "load.pri %1!inc %1!;$exp!",
1332 "inc %1!;$exp!",
1333#else
1334 "\314\373c\261",
1335 "\373c\261",
1336#endif
1337 seqsize(2, 2) - seqsize(1, 1)},
1338 {
1339#ifdef SCPACK
1340 "inc.s %1!load.s.pri %1!;$exp!",
1341 "inc.s %1!;$exp!",
1342#else
1343 "\373\352\205\324\245",
1344 "\373\352\261",
1345#endif
1346 seqsize(2, 2) - seqsize(1, 1)},
1347 {
1348#ifdef SCPACK
1349 "load.s.pri %1!inc.s %1!;$exp!",
1350 "inc.s %1!;$exp!",
1351#else
1352 "\324\373\352\261",
1353 "\373\352\261",
1354#endif
1355 seqsize(2, 2) - seqsize(1, 1)},
1356 {
1357#ifdef SCPACK
1358 "dec %1!load.pri %1!;$exp!",
1359 "dec %1!;$exp!",
1360#else
1361 "\367c\205\314\245",
1362 "\367c\261",
1363#endif
1364 seqsize(2, 2) - seqsize(1, 1)},
1365 {
1366#ifdef SCPACK
1367 "load.pri %1!dec %1!;$exp!",
1368 "dec %1!;$exp!",
1369#else
1370 "\314\367c\261",
1371 "\367c\261",
1372#endif
1373 seqsize(2, 2) - seqsize(1, 1)},
1374 {
1375#ifdef SCPACK
1376 "dec.s %1!load.s.pri %1!;$exp!",
1377 "dec.s %1!;$exp!",
1378#else
1379 "\367\352\205\324\245",
1380 "\367\352\261",
1381#endif
1382 seqsize(2, 2) - seqsize(1, 1)},
1383 {
1384#ifdef SCPACK
1385 "load.s.pri %1!dec.s %1!;$exp!",
1386 "dec.s %1!;$exp!",
1387#else
1388 "\324\367\352\261",
1389 "\367\352\261",
1390#endif
1391 seqsize(2, 2) - seqsize(1, 1)},
1392 /* ??? the same (increments and decrements) for references */
1393 /* Loading the constant zero has a special opcode.
1394 * When storing zero in memory, the value of PRI must not be later on.
1395 * const.pri 0 zero n1
1396 * stor.pri n1 ;$exp
1397 * ;$exp -
1398 * --------------------------------------
1399 * const.pri 0 zero.s n1
1400 * stor.s.pri n1 ;$exp
1401 * ;$exp -
1402 * --------------------------------------
1403 * zero.pri zero n1
1404 * stor.pri n1 ;$exp
1405 * ;$exp -
1406 * --------------------------------------
1407 * zero.pri zero.s n1
1408 * stor.s.pri n1 ;$exp
1409 * ;$exp -
1410 * --------------------------------------
1411 * const.pri 0 zero.pri
1412 * --------------------------------------
1413 * const.alt 0 zero.alt
1414 * The last two alternatives save more memory than they save
1415 * time, but anyway...
1416 */
1417 {
1418#ifdef SCPACK
1419 "const.pri 0!stor.pri %1!;$exp!",
1420 "zero %1!;$exp!",
1421#else
1422 "\236\203 0!\227or\223\245",
1423 "\315\261",
1424#endif
1425 seqsize(2, 2) - seqsize(1, 1)},
1426 {
1427#ifdef SCPACK
1428 "const.pri 0!stor.s.pri %1!;$exp!",
1429 "zero.s %1!;$exp!",
1430#else
1431 "\236\203 0!\227or\220\223\245",
1432 "\315\220\261",
1433#endif
1434 seqsize(2, 2) - seqsize(1, 1)},
1435 {
1436#ifdef SCPACK
1437 "zero.pri!stor.pri %1!;$exp!",
1438 "zero %1!;$exp!",
1439#else
1440 "\376\227or\223\245",
1441 "\315\261",
1442#endif
1443 seqsize(2, 1) - seqsize(1, 1)},
1444 {
1445#ifdef SCPACK
1446 "zero.pri!stor.s.pri %1!;$exp!",
1447 "zero.s %1!;$exp!",
1448#else
1449 "\376\227or\220\223\245",
1450 "\315\220\261",
1451#endif
1452 seqsize(2, 1) - seqsize(1, 1)},
1453 {
1454#ifdef SCPACK
1455 "const.pri 0!",
1456 "zero.pri!",
1457#else
1458 "\236\203 0!",
1459 "\376",
1460#endif
1461 seqsize(1, 1) - seqsize(1, 0)},
1462 {
1463#ifdef SCPACK
1464 "const.alt 0!",
1465 "zero.alt!",
1466#else
1467 "\236\211 0!",
1468 "\315\217",
1469#endif
1470 seqsize(1, 1) - seqsize(1, 0)},
1471 /* ----- */
1472 {NULL, NULL, 0}
1473};
diff --git a/libraries/embryo/src/bin/embryo_cc_scexpand.c b/libraries/embryo/src/bin/embryo_cc_scexpand.c
new file mode 100644
index 0000000..6ab34a1
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_scexpand.c
@@ -0,0 +1,53 @@
1/* expand.c -- Byte Pair Encoding decompression */
2/* Copyright 1996 Philip Gage */
3
4/* Byte Pair Compression appeared in the September 1997
5 * issue of C/C++ Users Journal. The original source code
6 * may still be found at the web site of the magazine
7 * (www.cuj.com).
8 *
9 * The decompressor has been modified by me (Thiadmer
10 * Riemersma) to accept a string as input, instead of a
11 * complete file.
12 */
13
14
15#include "embryo_cc_sc.h"
16
17#define STACKSIZE 16
18
19int
20strexpand(char *dest, unsigned char *source, int maxlen, unsigned char pairtable[128][2])
21{
22 unsigned char stack[STACKSIZE];
23 short c, top = 0;
24 int len;
25
26 len = 1; /* already 1 byte for '\0' */
27 for (;;)
28 {
29 /* Pop byte from stack or read byte from the input string */
30 if (top)
31 c = stack[--top];
32 else if ((c = *(unsigned char *)source++) == '\0')
33 break;
34
35 /* Push pair on stack or output byte to the output string */
36 if (c > 127)
37 {
38 stack[top++] = pairtable[c - 128][1];
39 stack[top++] = pairtable[c - 128][0];
40 }
41 else
42 {
43 len++;
44 if (maxlen > 1)
45 {
46 *dest++ = (char)c;
47 maxlen--;
48 }
49 }
50 }
51 *dest = '\0';
52 return len;
53}
diff --git a/libraries/embryo/src/bin/embryo_cc_sclist.c b/libraries/embryo/src/bin/embryo_cc_sclist.c
new file mode 100644
index 0000000..94ebbb7
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sclist.c
@@ -0,0 +1,293 @@
1/* Small compiler - maintenance of various lists
2 *
3 * Name list (aliases)
4 * Include path list
5 *
6 * Copyright (c) ITB CompuPhase, 2001-2003
7 *
8 * This software is provided "as-is", without any express or implied warranty.
9 * In no event will the authors be held liable for any damages arising from
10 * the use of this software.
11 *
12 * Permission is granted to anyone to use this software for any purpose,
13 * including commercial applications, and to alter it and redistribute it
14 * freely, subject to the following restrictions:
15 *
16 * 1. The origin of this software must not be misrepresented; you must not
17 * claim that you wrote the original software. If you use this software in
18 * a product, an acknowledgment in the product documentation would be
19 * appreciated but is not required.
20 * 2. Altered source versions must be plainly marked as such, and must not be
21 * misrepresented as being the original software.
22 * 3. This notice may not be removed or altered from any source distribution.
23 *
24 * Version: $Id: embryo_cc_sclist.c 52451 2010-09-19 03:00:12Z raster $
25 */
26
27
28#ifdef HAVE_CONFIG_H
29# include <config.h>
30#endif
31
32#include <assert.h>
33#include <stdlib.h>
34#include <string.h>
35#include "embryo_cc_sc.h"
36
37static stringpair *
38insert_stringpair(stringpair * root, char *first, char *second, int matchlength)
39{
40 stringpair *cur, *pred;
41
42 assert(root != NULL);
43 assert(first != NULL);
44 assert(second != NULL);
45 /* create a new node, and check whether all is okay */
46 if (!(cur = (stringpair *)malloc(sizeof(stringpair))))
47 return NULL;
48 cur->first = strdup(first);
49 cur->second = strdup(second);
50 cur->matchlength = matchlength;
51 if (!cur->first || !cur->second)
52 {
53 if (cur->first)
54 free(cur->first);
55 if (cur->second)
56 free(cur->second);
57 free(cur);
58 return NULL;
59 } /* if */
60 /* link the node to the tree, find the position */
61 for (pred = root; pred->next && strcmp(pred->next->first, first) < 0;
62 pred = pred->next)
63 /* nothing */ ;
64 cur->next = pred->next;
65 pred->next = cur;
66 return cur;
67}
68
69static void
70delete_stringpairtable(stringpair * root)
71{
72 stringpair *cur, *next;
73
74 assert(root != NULL);
75 cur = root->next;
76 while (cur)
77 {
78 next = cur->next;
79 assert(cur->first != NULL);
80 assert(cur->second != NULL);
81 free(cur->first);
82 free(cur->second);
83 free(cur);
84 cur = next;
85 } /* while */
86 memset(root, 0, sizeof(stringpair));
87}
88
89static stringpair *
90find_stringpair(stringpair * cur, char *first, int matchlength)
91{
92 int result = 0;
93
94 assert(matchlength > 0); /* the function cannot handle zero-length comparison */
95 assert(first != NULL);
96 while (cur && result <= 0)
97 {
98 result = (int)*cur->first - (int)*first;
99 if (result == 0 && matchlength == cur->matchlength)
100 {
101 result = strncmp(cur->first, first, matchlength);
102 if (result == 0)
103 return cur;
104 } /* if */
105 cur = cur->next;
106 } /* while */
107 return NULL;
108}
109
110static int
111delete_stringpair(stringpair * root, stringpair * item)
112{
113 stringpair *cur;
114
115 assert(root != NULL);
116 cur = root;
117 while (cur->next)
118 {
119 if (cur->next == item)
120 {
121 cur->next = item->next; /* unlink from list */
122 assert(item->first != NULL);
123 assert(item->second != NULL);
124 free(item->first);
125 free(item->second);
126 free(item);
127 return TRUE;
128 } /* if */
129 cur = cur->next;
130 } /* while */
131 return FALSE;
132}
133
134/* ----- alias table --------------------------------------------- */
135static stringpair alias_tab = { NULL, NULL, NULL, 0 }; /* alias table */
136
137stringpair *
138insert_alias(char *name, char *alias)
139{
140 stringpair *cur;
141
142 assert(name != NULL);
143 assert(strlen(name) <= sNAMEMAX);
144 assert(alias != NULL);
145 assert(strlen(alias) <= sEXPMAX);
146 if (!(cur = insert_stringpair(&alias_tab, name, alias, strlen(name))))
147 error(103); /* insufficient memory (fatal error) */
148 return cur;
149}
150
151int
152lookup_alias(char *target, char *name)
153{
154 stringpair *cur =
155 find_stringpair(alias_tab.next, name, strlen(name));
156 if (cur)
157 {
158 assert(strlen(cur->second) <= sEXPMAX);
159 strcpy(target, cur->second);
160 } /* if */
161 return !!cur;
162}
163
164void
165delete_aliastable(void)
166{
167 delete_stringpairtable(&alias_tab);
168}
169
170/* ----- include paths list -------------------------------------- */
171static stringlist includepaths = { NULL, NULL }; /* directory list for include files */
172
173stringlist *
174insert_path(char *path)
175{
176 stringlist *cur;
177
178 assert(path != NULL);
179 if (!(cur = (stringlist *)malloc(sizeof(stringlist))))
180 error(103); /* insufficient memory (fatal error) */
181 if (!(cur->line = strdup(path)))
182 error(103); /* insufficient memory (fatal error) */
183 cur->next = includepaths.next;
184 includepaths.next = cur;
185 return cur;
186}
187
188char *
189get_path(int index)
190{
191 stringlist *cur = includepaths.next;
192
193 while (cur && index-- > 0)
194 cur = cur->next;
195 if (cur)
196 {
197 assert(cur->line != NULL);
198 return cur->line;
199 } /* if */
200 return NULL;
201}
202
203void
204delete_pathtable(void)
205{
206 stringlist *cur = includepaths.next, *next;
207
208 while (cur)
209 {
210 next = cur->next;
211 assert(cur->line != NULL);
212 free(cur->line);
213 free(cur);
214 cur = next;
215 } /* while */
216 memset(&includepaths, 0, sizeof(stringlist));
217}
218
219/* ----- text substitution patterns ------------------------------ */
220
221static stringpair substpair = { NULL, NULL, NULL, 0 }; /* list of substitution pairs */
222static stringpair *substindex['z' - 'A' + 1]; /* quick index to first character */
223
224static void
225adjustindex(char c)
226{
227 stringpair *cur;
228
229 assert((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') || c == '_');
230 assert('A' < '_' && '_' < 'z');
231
232 for (cur = substpair.next; cur && cur->first[0] != c;
233 cur = cur->next)
234 /* nothing */ ;
235 substindex[(int)c - 'A'] = cur;
236}
237
238stringpair *
239insert_subst(char *pattern, char *substitution, int prefixlen)
240{
241 stringpair *cur;
242
243 assert(pattern != NULL);
244 assert(substitution != NULL);
245 if (!(cur = insert_stringpair(&substpair, pattern, substitution, prefixlen)))
246 error(103); /* insufficient memory (fatal error) */
247 adjustindex(*pattern);
248 return cur;
249}
250
251stringpair *
252find_subst(char *name, int length)
253{
254 stringpair *item;
255
256 assert(name != NULL);
257 assert(length > 0);
258 assert((*name >= 'A' && *name <= 'Z') || (*name >= 'a' && *name <= 'z')
259 || *name == '_');
260 item = substindex[(int)*name - 'A'];
261 if (item)
262 item = find_stringpair(item, name, length);
263 return item;
264}
265
266int
267delete_subst(char *name, int length)
268{
269 stringpair *item;
270
271 assert(name != NULL);
272 assert(length > 0);
273 assert((*name >= 'A' && *name <= 'Z') || (*name >= 'a' && *name <= 'z')
274 || *name == '_');
275 item = substindex[(int)*name - 'A'];
276 if (item)
277 item = find_stringpair(item, name, length);
278 if (!item)
279 return FALSE;
280 delete_stringpair(&substpair, item);
281 adjustindex(*name);
282 return TRUE;
283}
284
285void
286delete_substtable(void)
287{
288 int i;
289
290 delete_stringpairtable(&substpair);
291 for (i = 0; i < (int)(sizeof(substindex) / sizeof(substindex[0])); i++)
292 substindex[i] = NULL;
293}
diff --git a/libraries/embryo/src/bin/embryo_cc_scvars.c b/libraries/embryo/src/bin/embryo_cc_scvars.c
new file mode 100644
index 0000000..fb9eb12
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_scvars.c
@@ -0,0 +1,88 @@
1/* Small compiler
2 *
3 * Global (cross-module) variables.
4 *
5 * Copyright (c) ITB CompuPhase, 1997-2003
6 *
7 * This software is provided "as-is", without any express or implied warranty.
8 * In no event will the authors be held liable for any damages arising from
9 * the use of this software.
10 *
11 * Permission is granted to anyone to use this software for any purpose,
12 * including commercial applications, and to alter it and redistribute it
13 * freely, subject to the following restrictions:
14 *
15 * 1. The origin of this software must not be misrepresented; you must not
16 * claim that you wrote the original software. If you use this software in
17 * a product, an acknowledgment in the product documentation would be
18 * appreciated but is not required.
19 * 2. Altered source versions must be plainly marked as such, and must not be
20 * misrepresented as being the original software.
21 * 3. This notice may not be removed or altered from any source distribution.
22 *
23 * Version: $Id: embryo_cc_scvars.c 50816 2010-08-04 16:57:32Z lucas $
24 */
25
26
27#ifdef HAVE_CONFIG_H
28# include <config.h> /* for PATH_MAX */
29#endif
30
31#include "embryo_cc_sc.h"
32
33/* global variables
34 *
35 * All global variables that are shared amongst the compiler files are
36 * declared here.
37 */
38symbol loctab; /* local symbol table */
39symbol glbtab; /* global symbol table */
40cell *litq; /* the literal queue */
41char pline[sLINEMAX + 1]; /* the line read from the input file */
42char *lptr; /* points to the current position in "pline" */
43constvalue tagname_tab = { NULL, "", 0, 0 }; /* tagname table */
44constvalue libname_tab = { NULL, "", 0, 0 }; /* library table (#pragma library "..." syntax) */
45constvalue *curlibrary = NULL; /* current library */
46symbol *curfunc; /* pointer to current function */
47char *inpfname; /* pointer to name of the file currently read from */
48char outfname[PATH_MAX]; /* output file name */
49char sc_ctrlchar = CTRL_CHAR; /* the control character (or escape character) */
50int litidx = 0; /* index to literal table */
51int litmax = sDEF_LITMAX; /* current size of the literal table */
52int stgidx = 0; /* index to the staging buffer */
53int labnum = 0; /* number of (internal) labels */
54int staging = 0; /* true if staging output */
55cell declared = 0; /* number of local cells declared */
56cell glb_declared = 0; /* number of global cells declared */
57cell code_idx = 0; /* number of bytes with generated code */
58int ntv_funcid = 0; /* incremental number of native function */
59int errnum = 0; /* number of errors */
60int warnnum = 0; /* number of warnings */
61int sc_debug = sCHKBOUNDS; /* by default: bounds checking+assertions */
62int charbits = 8; /* a "char" is 8 bits */
63int sc_packstr = FALSE; /* strings are packed by default? */
64int sc_compress = TRUE; /* compress bytecode? */
65int sc_needsemicolon = TRUE; /* semicolon required to terminate expressions? */
66int sc_dataalign = sizeof(cell); /* data alignment value */
67int sc_alignnext = FALSE; /* must frame of the next function be aligned? */
68int curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */
69cell sc_stksize = sDEF_AMXSTACK; /* default stack size */
70int freading = FALSE; /* Is there an input file ready for reading? */
71int fline = 0; /* the line number in the current file */
72int fnumber = 0; /* the file number in the file table (debugging) */
73int fcurrent = 0; /* current file being processed (debugging) */
74int intest = 0; /* true if inside a test */
75int sideeffect = 0; /* true if an expression causes a side-effect */
76int stmtindent = 0; /* current indent of the statement */
77int indent_nowarn = TRUE; /* skip warning "217 loose indentation" */
78int sc_tabsize = 8; /* number of spaces that a TAB represents */
79int sc_allowtags = TRUE; /* allow/detect tagnames in lex() */
80int sc_status; /* read/write status */
81int sc_rationaltag = 0; /* tag for rational numbers */
82int rational_digits = 0; /* number of fractional digits */
83
84FILE *inpf = NULL; /* file read from (source or include) */
85FILE *inpf_org = NULL; /* main source file */
86FILE *outf = NULL; /* file written to */
87
88jmp_buf errbuf;
generated by cgit v1.1 at 2024-10-30 22:54:24 +0000