gambc30/ 777 541 730 0 6524325704 5360 5gambc30/readme 754 541 730 21557 6524076247 6575 Readme file for Gambit-C version 3.0 (May 6, 1998) ==================================== This software is Copyright (C) 1994-1998 by Marc Feeley, all rights reserved. This directory contains release 3.0 of the Gambit-C Scheme programming system. Gambit-C includes a Scheme interpreter and a compiler which can be used to build standalone executables. Because the compiler generates portable C code, it is fairly easy to port to any machine with a decent C compiler. This release of the Gambit-C system has been built successfully on the following platforms: - DEC Alpha workstation - SUN Sparc workstation - SGI Mips workstation - Hewlett-Packard HP-PA workstation - PC with Linux ELF - PC with Microsoft Visual C++ - PC with Borland C++ - PC with Watcom C/C++ - PC with MSDOS and DJGPP - Apple Macintosh with CodeWarrior C/C++ - Apple Macintosh with MkLinux This release has not been tested on the following platforms but previous releases of Gambit-C have been built successfully: - IBM RS6000 workstation - Apple Macintosh with Power MachTen - PC with NetBSD/i386 1.0 - PC with FreeBSD The Gambit-C system conforms to the R4RS and IEEE Scheme standards. The full numeric tower is implemented, including: infinite precision integers (bignums), rationals, inexact reals (floating point numbers), and complex numbers. Gambit-C supports a number of extensions to the standards including: - a debugger with - a continuation inspection facility (i.e. "backtrace") - a single-stepping mode - error messages with location of error (file, line, and column number) - a foreign function interface for C - a memory management system that grows and shrinks the heap based on the program's needs - a linker that builds standalone executables and shared libraries - dynamic loading of compiled modules and libraries (supported on many platforms including Macintosh when CodeWarrior is installed) - Unicode support for characters, strings, I/O and source code - object finalization - pretty printing - string ports - bytevectors (uniform vectors of integers or floating point numbers) - record structures - keyword objects - optional and keyword parameters (with the syntax and semantics of DSSSL) - configurable reader with control over case sensitivity - write/read invariance of symbols, e.g. (string->symbol "B;123") => |B;123| - write/read invariance of floating point numbers - dynamic variables (i.e. variables with dynamic scope) - eval - Maclisp style macros Installation instructions are given in the next section. The user manual for the Gambit-C system is available in Postscript format (the file "doc/gambit-c.ps"), in HTML format (the file "doc/gambit-c.html") and in "info" format (the files "doc/gambit-c.info*"). If you have any questions concerning Gambit-C please address them to: gambit@iro.umontreal.ca The latest official release of the system can be obtained from the Gambit web page at: http://www.iro.umontreal.ca/~gambit Installation instructions for Gambit-C version 3.0 ================================================== STEP 1 "./configure" ------ If your machine/OS configuration appears in the tested platform list shown below type "./configure". This will create makefiles adapted to your system in the current directory and subdirectories (the makefiles are generated from the makefile.in files). By default the "gcc" compiler is used if it is available. To force the use of the "cc" compiler, set the environment variable "FORCE_CC" to a non-null string when you do the "./configure". For example: FORCE_CC=yes ./configure By default, Gambit-C's runtime system will not place any limit on the size of the Scheme heap. A heap overflow will only be signalled when virtual memory is all used up, which can take a long time and cause lots of paging. To place a limit on the heap size, define the symbol "FORCE_MAX_HEAP" in the environment variable CFLAGS when you do the "./configure". For example, to get a 5000 kilobyte limit (a reasonable amount for an educational environment) do: CFLAGS="-DFORCE_MAX_HEAP=5000" ./configure TESTED PLATFORMS: - DEC Alpha workstation: uname -a = OSF1 raptor.IRO.UMontreal.CA V4.0 386 alpha C compiler = OSF1 cc compiler (version unknown) - SUN Sparc workstation with SunOS 4.1.4: uname -a = SunOS saguenay 4.1.4 5 sun4m C compiler = gcc version 2.7.2 - SUN Sparc workstation with Solaris: uname -a = SunOS jazz01 5.5 Generic_103093-03 sun4u sparc SUNW,Ultra-1 C compiler = gcc version 2.7.2 uname -a = SunOS ungava 5.6 Generic sun4m sparc SUNW,SPARCstation-20 C compiler = gcc version 2.8.1 - SGI Mips workstation: uname -a = IRIX derby 5.3 11091811 IP19 mips C compiler = IRIX cc compiler (version unknown) make command = make SHELL=/bin/sh - Hewlett-Packard HP-PA workstation: uname -a = HP-UX stjean B.10.01 A 9000/755 C compiler = gcc version 2.7.2.2 - IBM RS6000 workstation: uname -a = AIX diana 2 3 000005641800 C compiler = AIX cc compiler (version unknown) - PC running Linux: uname -a = Linux bronto 2.1.86 #13 Fri Feb 20 10:47:36 EST 1998 i686 unknn C compiler = gcc version 2.8.1 - Apple Macintosh with MkLinux: uname -a = Linux terram 2.0.30-osfmach3 #1 Wed Nov 12 16:06:55 PST 1997 ppc unknown C compiler = gcc version 2.7.2.1-ppclinux - Apple Macintosh with MachTen: OS = MACOS System 7.5.3 and Power MachTen 4.0.2 uname -a = powerpc-tenon-machten tops 4 0.1 Power Macintosh C compiler = gcc version 2.7.0 If you have one of the following machine/OS configurations, you need to use the build procedure explained in the file "misc/readme": - PC running Windows-NT/95 and Microsoft Visual C++ - PC running Windows-NT/95 and Borland C++ - PC running Windows-NT/95 and Watcom C/C++ - Apple Macintosh and Macintosh CodeWarrior C/C++ If your machine appears in the tested platform list but the OS version or C compiler is not the same, you can still try a "configure" and go to step 2. There is a high likelihood that this will work. If this fails because of some problem with the C compiler (for example not enough swap space available), modify the file "lib/gambit.h" so that appropriate options are passed to the C compiler (such as removing optimizations) or call up a different C compiler, and start back at step 1 after a "make clean". Otherwise, you will have to configure the files "lib/gambit.h", "lib/os.h" and "lib/os.c" to suit your system. The file "lib/gambit.h" defines the endianess of the machine, the size of "long" ints, etc as well as which C compiler to use and the options to pass to the C compiler, linker, etc. The files "lib/os.h" and "lib/os.c" implements OS-dependent routines (filename expansion, interrupt handling, dynamic loading, etc). If you needed to modify any file to get Gambit-C to work properly on your system, please send your modifications along with your machine/OS specification to gambit@iro.umontreal.ca so that it can be added to the next release. STEP 2 "make" ------ Type "make". This will build the following components: in "gsi" subdirectory: the Gambit-C interpreter in "gsc" subdirectory: the Gambit-C compiler in "lib" subdirectory: the Gambit-C runtime library These components are built as shared libraries if this is supported by the OS, otherwise they are statically linked. To force static linking, set the environment variable "FORCE_STATIC_LINK" to a non-null string when you do the "make" such as: make FORCE_STATIC_LINK=yes After a successful "make" you will have the following files: static link build shared library build gsi/gsi gsi/gsi interpreter gsc/gsc gsc/gsc compiler lib/libgambc.a lib/libgambc.so (on most versions of UNIX) lib/libgambc.a lib/libgambc.so.1.1 (SunOS) lib/libgambc.a lib/libgambc.sl (HP-UX) lib/libgambc.lib lib/gambc.dll + lib/gambc.lib (Windows-NT/95) and also doc/gambit-c.dvi the Gambit-C user manual in "dvi" format doc/gambit-c.info* the Gambit-C user manual in "info" format STEP 3 "make check" ------ You can check that the programs work properly by doing "make check". This will run the interpreter and compiler on some benchmark programs and compare the result with the expected result. If everything is fine there should be no differences signaled by "diff". Other benchmarks are included in the file "misc/bench.tgz". STEP 4 "make install" ------ On UNIX systems you can now type "make install" to get a permanent installation of the system (assuming you have the required permissions). By default the files will go in /usr/local/bin /usr/local/lib /usr/local/info /usr/local/include /usr/local/share/gambc Previous versions of Gambit-C installed the files /usr/lib/libgambc.so /usr/include/gambit.h Make sure you remove these files otherwise they will conflict with those installed in /usr/local/lib and /usr/local/include. gambc30/makefile.in 754 541 730 6167 6514555403 7475 # makefile for Gambit-C system. # Copyright (C) 1994-1997 by Marc Feeley, All Rights Reserved. PACKAGE = @PACKAGE@ VERSION = @VERSION@ srcdir = @srcdir@ VPATH = @srcdir@ srcdirpfx = @srcdirpfx@ @SET_MAKE@ # This directory's subdirectories are mostly independent; you can cd # into them and run `make' without going through this makefile. # To change the values of `make' variables: instead of editing makefiles, # (1) if the variable is set in `config.status', edit `config.status' # (which will cause the makefiles to be regenerated when you run `make'); # (2) otherwise, pass the desired values on the `make' command line. prefix = @prefix@ exec_prefix = @exec_prefix@ bindir = $(exec_prefix)/bin gambcdir = $(prefix)/share/$(PACKAGE) includedir = $(prefix)/include libdir = $(prefix)/lib MDEFINES = prefix=$(prefix) exec_prefix=$(exec_prefix) \ bindir=$(bindir) gambcdir=$(gambcdir) libdir=$(libdir) \ includedir=$(includedir) SUBDIRS = lib gsi gsc check doc misc DISTFILES = readme \ makefile.in configure.in configure settings.h inst-sh mkidirs .SUFFIXES: goal: all all install uninstall: for subdir in $(SUBDIRS); do \ echo making $@ in $$subdir; \ (cd $$subdir && $(MAKE) $(MDEFINES) $@) || exit 1; \ done doc info dvi: cd doc && $(MAKE) $@ check: all cd check && $(MAKE) $(MDEFINES) $@ tags: cd lib && $(MAKE) $@ mostlyclean: mostlyclean-recursive mostlyclean-local clean: clean-recursive clean-local distclean: distclean-recursive distclean-local rm -f config.status # This goal is not meant for real situations. Do not use it. realclean: realclean-recursive realclean-local rm -f config.status mostlyclean-recursive clean-recursive distclean-recursive realclean-recursive: for subdir in $(SUBDIRS); do \ target=`echo $@ | sed 's/-recursive//'`; \ echo making $$target in $$subdir; \ (cd $$subdir && $(MAKE) $$target) || exit 1; \ done mostlyclean-local: clean-local: mostlyclean-local distclean-local: clean-local rm -f makefile config.cache config.h config.log realclean-local: distclean-local dist: rm -rf $(PACKAGE)$(VERSION) mkdir $(PACKAGE)$(VERSION) chmod 777 $(PACKAGE)$(VERSION) @echo "Copying distribution files" @for file in $(DISTFILES); do \ ln $(srcdirpfx)$$file $(PACKAGE)$(VERSION) 2> /dev/null \ || cp -p $(srcdirpfx)$$file $(PACKAGE)$(VERSION); \ done for subdir in $(SUBDIRS); do \ echo making $@ in $$subdir; \ mkdir $(PACKAGE)$(VERSION)/$$subdir; \ chmod 777 $(PACKAGE)$(VERSION)/$$subdir; \ (cd $$subdir && $(MAKE) $(MDEFINES) $@) || exit 1; \ done chmod -R a+r $(PACKAGE)$(VERSION) tar chof $(PACKAGE)$(VERSION).tar $(PACKAGE)$(VERSION) gzip -9 $(PACKAGE)$(VERSION).tar rm -rf $(PACKAGE)$(VERSION) # For an explanation of the following makefile rules, see node # `Automatic Remaking' in GNU Autoconf documentation. makefile: makefile.in config.status CONFIG_FILES=$@ CONFIG_HEADERS= ./config.status config.status: configure ./config.status --recheck configure: configure.in cd $(srcdir) && autoconf configure.in > configure # Tell versions [3.59,3.63) of GNU make not to export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: gambc30/configure.in 644 541 730 2317 6523603561 7667 # Configure template for Gambit-C system. # Copyright (C) 1994-1998 by Marc Feeley, All Rights Reserved. # Process this file with autoconf to produce a configure script. AC_INIT(gsi/gsi.scm) PACKAGE=gambc VERSION=30 AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE") AC_DEFINE_UNQUOTED(VERSION, "$VERSION") AC_SUBST(PACKAGE) AC_SUBST(VERSION) AC_CHECK_PROG(HAVEGCC,gcc,yes) if test -n "$HAVEGCC" -a -z "$FORCE_CC"; then CPREPROC=gcc else CPREPROC=cc fi saved_ifs="$IFS"; IFS="" eval `$CPREPROC -E $srcdir/settings.h | grep _equ_ | sed -e 's/ *_equ_ */=/'` IFS="$saved_ifs" if test "$srcdir" = "."; then srcdirpfx="" else srcdirpfx="\$(srcdir)/" fi INSTALL="../inst-sh -c" INSTALL_DATA="../inst-sh -c -m 644" INSTALL_PROGRAM="../inst-sh -c -m 755" AC_SUBST(srcdirpfx) AC_SUBST(o) AC_SUBST(CC_O) AC_SUBST(CC_O_SH) AC_SUBST(LINK) AC_SUBST(LINK_SH) AC_SUBST(LINK_SH_INSTALL) AC_SUBST(CLIBS) AC_SUBST(GAMBCLIB) AC_SUBST(GAMBCLIB_SH) AC_SUBST(MAKE_GAMBCLIB) AC_SUBST(MAKE_GAMBCLIB_SH) AC_SUBST(SETDLPATH) AC_SUBST(CFLAGS) AC_SUBST(CPPFLAGS) AC_SUBST(INSTALL) AC_SUBST(INSTALL_DATA) AC_SUBST(INSTALL_PROGRAM) AC_PROG_MAKE_SET AC_OUTPUT(makefile lib/makefile gsi/makefile gsc/makefile \ check/makefile doc/makefile misc/makefile) gambc30/configure 754 541 730 65104 6523603573 7312 #! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated automatically using autoconf version 2.4.2 # Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. # Defaults: ac_help= ac_default_prefix=/usr/local # Any additions from configure.in: # Initialize some variables set by options. # The variables have the same names as the options, with # dashes changed to underlines. build=NONE cache_file=./config.cache exec_prefix=NONE host=NONE no_create= nonopt=NONE no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= target=NONE verbose= x_includes=NONE x_libraries=NONE bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' # Initialize some other variables. subdirs= ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi case "$ac_option" in -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; *) ac_optarg= ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case "$ac_option" in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir="$ac_optarg" ;; -build | --build | --buil | --bui | --bu) ac_prev=build ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build="$ac_optarg" ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file="$ac_optarg" ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir="$ac_optarg" ;; -disable-* | --disable-*) ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` eval "enable_${ac_feature}=no" ;; -enable-* | --enable-*) ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } fi ac_feature=`echo $ac_feature| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "enable_${ac_feature}='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix="$ac_optarg" ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he) # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat << EOF Usage: configure [options] [host] Options: [defaults in brackets after descriptions] Configuration: --cache-file=FILE cache test results in FILE --help print this message --no-create do not create output files --quiet, --silent do not print \`checking...' messages --version print the version of autoconf that created configure Directory and file names: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [same as prefix] --bindir=DIR user executables in DIR [EPREFIX/bin] --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] --libexecdir=DIR program executables in DIR [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data in DIR [PREFIX/share] --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data in DIR [PREFIX/com] --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] --libdir=DIR object code libraries in DIR [EPREFIX/lib] --includedir=DIR C header files in DIR [PREFIX/include] --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] --infodir=DIR info documentation in DIR [PREFIX/info] --mandir=DIR man documentation in DIR [PREFIX/man] --srcdir=DIR find the sources in DIR [configure dir or ..] --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names EOF cat << EOF Host type: --build=BUILD configure for building on BUILD [BUILD=HOST] --host=HOST configure for HOST [guessed] --target=TARGET configure for TARGET [TARGET=HOST] Features and packages: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --x-includes=DIR X include files are in DIR --x-libraries=DIR X library files are in DIR --enable and --with options recognized:$ac_help EOF exit 0 ;; -host | --host | --hos | --ho) ac_prev=host ;; -host=* | --host=* | --hos=* | --ho=*) host="$ac_optarg" ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir="$ac_optarg" ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir="$ac_optarg" ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir="$ac_optarg" ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir="$ac_optarg" ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir="$ac_optarg" ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir="$ac_optarg" ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir="$ac_optarg" ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix="$ac_optarg" ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix="$ac_optarg" ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix="$ac_optarg" ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name="$ac_optarg" ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir="$ac_optarg" ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir="$ac_optarg" ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site="$ac_optarg" ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir="$ac_optarg" ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir="$ac_optarg" ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target="$ac_optarg" ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers) echo "configure generated by autoconf version 2.4.2" exit 0 ;; -with-* | --with-*) ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` case "$ac_option" in *=*) ;; *) ac_optarg=yes ;; esac eval "with_${ac_package}='$ac_optarg'" ;; -without-* | --without-*) ac_package=`echo $ac_option|sed -e 's/-*without-//'` # Reject names that are not valid shell variable names. if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } fi ac_package=`echo $ac_package| sed 's/-/_/g'` eval "with_${ac_package}=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes="$ac_optarg" ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries="$ac_optarg" ;; -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } ;; *) if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then echo "configure: warning: $ac_option: invalid host type" 1>&2 fi if test "x$nonopt" != xNONE; then { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } fi nonopt="$ac_option" ;; esac done if test -n "$ac_prev"; then { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } fi trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 # File descriptor usage: # 0 standard input # 1 file creation # 2 errors and warnings # 3 some systems may open it to /dev/tty # 4 used on the Kubota Titan # 6 checking for... messages and results # 5 compiler messages saved in config.log if test "$silent" = yes; then exec 6>/dev/null else exec 6>&1 fi exec 5>./config.log echo "\ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. " 1>&5 # Strip out --no-create and --no-recursion so they do not pile up. # Also quote any args containing shell metacharacters. ac_configure_args= for ac_arg do case "$ac_arg" in -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c) ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) ac_configure_args="$ac_configure_args '$ac_arg'" ;; *) ac_configure_args="$ac_configure_args $ac_arg" ;; esac done # NLS nuisances. # Only set LANG and LC_ALL to C if already set. # These must not be set unconditionally because not all systems understand # e.g. LANG=C (notably SCO). if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi if test "${LANG+set}" = set; then LANG=C; export LANG; fi # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo > confdefs.h # A filename unique to this package, relative to the directory that # configure is in, which we can look for to find out if srcdir is correct. ac_unique_file=gsi/gsi.scm # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_prog=$0 ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } else { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } fi fi srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then echo "loading site script $ac_site_file" . "$ac_site_file" fi done if test -r "$cache_file"; then echo "loading cache $cache_file" . $cache_file else echo "creating cache $cache_file" > $cache_file fi ac_ext=c # CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. ac_cpp='echo $CPP $CPPFLAGS 1>&5; $CPP $CPPFLAGS' ac_compile='echo ${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5; ${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5 2>&5' ac_link='echo ${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5; ${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5 2>&5' if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then ac_n= ac_c=' ' ac_t=' ' else ac_n=-n ac_c= ac_t= fi else ac_n= ac_c='\c' ac_t= fi PACKAGE=gambc VERSION=30 cat >> confdefs.h <> confdefs.h <&6 if eval "test \"`echo '$''{'ac_cv_prog_HAVEGCC'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else if test -n "$HAVEGCC"; then ac_cv_prog_HAVEGCC="$HAVEGCC" # Let the user override the test. else IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" for ac_dir in $PATH; do test -z "$ac_dir" && ac_dir=. if test -f $ac_dir/$ac_word; then ac_cv_prog_HAVEGCC="yes" break fi done IFS="$ac_save_ifs" fi fi HAVEGCC="$ac_cv_prog_HAVEGCC" if test -n "$HAVEGCC"; then echo "$ac_t""$HAVEGCC" 1>&6 else echo "$ac_t""no" 1>&6 fi if test -n "$HAVEGCC" -a -z "$FORCE_CC"; then CPREPROC=gcc else CPREPROC=cc fi saved_ifs="$IFS"; IFS="" eval `$CPREPROC -E $srcdir/settings.h | grep _equ_ | sed -e 's/ *_equ_ */=/'` IFS="$saved_ifs" if test "$srcdir" = "."; then srcdirpfx="" else srcdirpfx="\$(srcdir)/" fi INSTALL="../inst-sh -c" INSTALL_DATA="../inst-sh -c -m 644" INSTALL_PROGRAM="../inst-sh -c -m 755" echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 set dummy ${MAKE-make}; ac_make=$2 if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then echo $ac_n "(cached) $ac_c" 1>&6 else cat > conftestmake <<\EOF all: @echo 'ac_maketemp="${MAKE}"' EOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=` if test -n "$ac_maketemp"; then eval ac_cv_prog_make_${ac_make}_set=yes else eval ac_cv_prog_make_${ac_make}_set=no fi rm -f conftestmake fi if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then echo "$ac_t""yes" 1>&6 SET_MAKE= else echo "$ac_t""no" 1>&6 SET_MAKE="MAKE=${MAKE-make}" fi trap '' 1 2 15 cat > confcache <<\EOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs. It is not useful on other systems. # If it contains results you don't want to keep, you may remove or edit it. # # By default, configure uses ./config.cache as the cache file, # creating it if it does not exist already. You can give configure # the --cache-file=FILE option to use a different cache file; that is # what configure does when it calls configure scripts in # subdirectories, so they share the cache. # Giving --cache-file=/dev/null disables caching, for debugging configure. # config.status only pays attention to the cache file if you give it the # --recheck option to rerun configure. # EOF # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. (set) 2>&1 | sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \ >> confcache if cmp -s $cache_file confcache; then : else if test -w $cache_file; then echo "updating cache $cache_file" cat confcache > $cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Any assignment to VPATH causes Sun make to only execute # the first set of double-colon rules, so remove it if not needed. # If there is a colon in the path, we need to keep it. if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' fi trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. cat > conftest.defs <<\EOF s%#define \([A-Za-z_][A-Za-z0-9_]*\) \(.*\)%-D\1=\2%g s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g s%\[%\\&%g s%\]%\\&%g s%\$%$$%g EOF DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` rm -f conftest.defs # Without the "./", some shells look in PATH for config.status. : ${CONFIG_STATUS=./config.status} echo creating $CONFIG_STATUS rm -f $CONFIG_STATUS cat > $CONFIG_STATUS </dev/null | sed 1q`: # # $0 $ac_configure_args # # Compiler output produced by configure, useful for debugging # configure, is in ./config.log if it exists. ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" for ac_option do case "\$ac_option" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; -version | --version | --versio | --versi | --vers | --ver | --ve | --v) echo "$CONFIG_STATUS generated by autoconf version 2.4.2" exit 0 ;; -help | --help | --hel | --he | --h) echo "\$ac_cs_usage"; exit 0 ;; *) echo "\$ac_cs_usage"; exit 1 ;; esac done ac_given_srcdir=$srcdir trap 'rm -fr `echo "makefile lib/makefile gsi/makefile gsc/makefile \ check/makefile doc/makefile misc/makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 # Protect against being on the right side of a sed subst in config.status. sed 's/%@/@@/; s/@%/@@/; s/%g$/@g/; /@g$/s/[\\\\&%]/\\\\&/g; s/@@/%@/; s/@@/@%/; s/@g$/%g/' > conftest.subs <<\CEOF $ac_vpsub $extrasub s%@CFLAGS@%$CFLAGS%g s%@CPPFLAGS@%$CPPFLAGS%g s%@CXXFLAGS@%$CXXFLAGS%g s%@DEFS@%$DEFS%g s%@LDFLAGS@%$LDFLAGS%g s%@LIBS@%$LIBS%g s%@exec_prefix@%$exec_prefix%g s%@prefix@%$prefix%g s%@program_transform_name@%$program_transform_name%g s%@bindir@%$bindir%g s%@sbindir@%$sbindir%g s%@libexecdir@%$libexecdir%g s%@datadir@%$datadir%g s%@sysconfdir@%$sysconfdir%g s%@sharedstatedir@%$sharedstatedir%g s%@localstatedir@%$localstatedir%g s%@libdir@%$libdir%g s%@includedir@%$includedir%g s%@oldincludedir@%$oldincludedir%g s%@infodir@%$infodir%g s%@mandir@%$mandir%g s%@PACKAGE@%$PACKAGE%g s%@VERSION@%$VERSION%g s%@HAVEGCC@%$HAVEGCC%g s%@srcdirpfx@%$srcdirpfx%g s%@o@%$o%g s%@CC_O@%$CC_O%g s%@CC_O_SH@%$CC_O_SH%g s%@LINK@%$LINK%g s%@LINK_SH@%$LINK_SH%g s%@LINK_SH_INSTALL@%$LINK_SH_INSTALL%g s%@CLIBS@%$CLIBS%g s%@GAMBCLIB@%$GAMBCLIB%g s%@GAMBCLIB_SH@%$GAMBCLIB_SH%g s%@MAKE_GAMBCLIB@%$MAKE_GAMBCLIB%g s%@MAKE_GAMBCLIB_SH@%$MAKE_GAMBCLIB_SH%g s%@SETDLPATH@%$SETDLPATH%g s%@INSTALL@%$INSTALL%g s%@INSTALL_DATA@%$INSTALL_DATA%g s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g s%@SET_MAKE@%$SET_MAKE%g CEOF EOF cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then # Support "outfile[:infile]", defaulting infile="outfile.in". case "$ac_file" in *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'` ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; *) ac_file_in="${ac_file}.in" ;; esac # Adjust relative srcdir, etc. for subdirectories. # Remove last slash and all that follows it. Not all systems have dirname. ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then # The file is in a subdirectory. test ! -d "$ac_dir" && mkdir "$ac_dir" ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" # A "../" for each directory in $ac_dir_suffix. ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` else ac_dir_suffix= ac_dots= fi case "$ac_given_srcdir" in .) srcdir=. if test -z "$ac_dots"; then top_srcdir=. else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; *) # Relative path. srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" top_srcdir="$ac_dots$ac_given_srcdir" ;; esac echo creating "$ac_file" rm -f "$ac_file" configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." case "$ac_file" in *Makefile*) ac_comsub="1i\\ # $configure_input" ;; *) ac_comsub= ;; esac sed -e "$ac_comsub s%@configure_input@%$configure_input%g s%@srcdir@%$srcdir%g s%@top_srcdir@%$top_srcdir%g " -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file fi; done rm -f conftest.subs exit 0 EOF chmod +x $CONFIG_STATUS rm -fr confdefs* $ac_clean_files test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 gambc30/settings.h 644 541 730 1254 6243405030 7354 #include "lib/gambit.h" #ifdef ___o o _equ_ ___o #endif #ifdef ___CC_O CC_O _equ_ ___CC_O #endif #ifdef ___CC_O_SH CC_O_SH _equ_ ___CC_O_SH #endif #ifdef ___LINK LINK _equ_ ___LINK #endif #ifdef ___LINK_SH LINK_SH _equ_ ___LINK_SH #endif #ifdef ___LINK_SH_INSTALL LINK_SH_INSTALL _equ_ ___LINK_SH_INSTALL #endif #ifdef ___CLIBS CLIBS _equ_ ___CLIBS #endif #ifdef ___GAMBCLIB GAMBCLIB _equ_ ___GAMBCLIB #endif #ifdef ___GAMBCLIB_SH GAMBCLIB_SH _equ_ ___GAMBCLIB_SH #endif #ifdef ___MAKE_GAMBCLIB MAKE_GAMBCLIB _equ_ ___MAKE_GAMBCLIB #endif #ifdef ___MAKE_GAMBCLIB_SH MAKE_GAMBCLIB_SH _equ_ ___MAKE_GAMBCLIB_SH #endif #ifdef ___SETDLPATH SETDLPATH _equ_ ___SETDLPATH #endif gambc30/inst-sh 754 541 730 11243 5741062274 6707 #!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. # # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" tranformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else true fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: else instcmd=mkdir fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f $src -o -d $src ] then true else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else true fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else true fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else true fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else true fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0 gambc30/mkidirs 754 541 730 1211 5741062274 6736 #!/bin/sh # mkinstalldirs --- make directory hierarchy # Author: Noah Friedman # Created: 1993-05-16 # Last modified: 1994-03-25 # Public domain errstatus=0 for file in ${1+"$@"} ; do set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'` shift pathcomp= for d in ${1+"$@"} ; do pathcomp="$pathcomp$d" case "$pathcomp" in -* ) pathcomp=./$pathcomp ;; esac if test ! -d "$pathcomp"; then echo "mkdir $pathcomp" 1>&2 mkdir "$pathcomp" || errstatus=$? fi pathcomp="$pathcomp/" done done exit $errstatus # mkinstalldirs ends here gambc30/lib/ 777 541 730 0 6524325700 6122 5gambc30/lib/makefile.in 644 541 730 12303 6513511574 10246 # makefile for Gambit-C library. # Copyright (C) 1994-1997 by Marc Feeley, All Rights Reserved. PACKAGE = @PACKAGE@ VERSION = @VERSION@ srcdir = @srcdir@ VPATH = @srcdir@ srcdirpfx = @srcdirpfx@ CC_O = @CC_O@ CC_O_SH = @CC_O_SH@ LINK = @LINK@ LINK_SH = @LINK_SH@ LINK_SH_INSTALL = @LINK_SH_INSTALL@ CLIBS = @CLIBS@ GAMBCLIB = @GAMBCLIB@ GAMBCLIB_SH = @GAMBCLIB_SH@ MAKE_GAMBCLIB = @MAKE_GAMBCLIB@ MAKE_GAMBCLIB_SH = @MAKE_GAMBCLIB_SH@ SETDLPATH = @SETDLPATH@ INSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ CFLAGS = @CFLAGS@ DEFS = @DEFS@ prefix = @prefix@ exec_prefix = @exec_prefix@ gambcdir = $(prefix)/share/$(PACKAGE) includedir = $(prefix)/include libdir = $(prefix)/lib CC_O_ARGS = $(INCLUDES) $(CFLAGS) -D___PRIMAL -D___LIBRARY CC_O_SH_ARGS = $(INCLUDES) $(CFLAGS) -D___PRIMAL -D___LIBRARY -D___SHARED .SUFFIXES: .SUFFIXES: .scm .c .@o@ .c.@o@: if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ $(CC_O) $*.c; \ else \ $(CC_O_SH) $*.c; \ fi .scm.c: $(SETDLPATH) ../gsc/gsc -f -c -check $(srcdirpfx)$*.scm INCLUDES = -I$(srcdir) NORMAL_SOURCES = main.c setup.c mem.c os.c c_intf.c setup.h mem.h os.h c_intf.h NORMAL_OBJECTS = main.@o@ setup.@o@ mem.@o@ c_intf.@o@ os.@o@ NORMAL_OBJECTS_PLUS = +main.@o@ +setup.@o@ +mem.@o@ +c_intf.@o@ +os.@o@ NORMAL_OBJECTS_COMMA = main.@o@,setup.@o@,mem.@o@,c_intf.@o@,os.@o@ MODULES = _kernel _system _errors _multi \ _num1 _num2 _io _eval _repl _std _nonstd MODULES_SCM = _kernel.scm _system.scm _errors.scm _multi.scm \ _num1.scm _num2.scm _io.scm _eval.scm _repl.scm _std.scm _nonstd.scm MODULES_C = _kernel.c _system.c _errors.c _multi.c \ _num1.c _num2.c _io.c _eval.c _repl.c _std.c _nonstd.c MODULES_O = _kernel.@o@ _system.@o@ _errors.@o@ _multi.@o@ \ _num1.@o@ _num2.@o@ _io.@o@ _eval.@o@ _repl.@o@ _std.@o@ _nonstd.@o@ MODULES_O_PLUS = +_kernel.@o@ +_system.@o@ +_errors.@o@ +_multi.@o@ \ +_num1.@o@ +_num2.@o@ +_io.@o@ +_eval.@o@ +_repl.@o@ +_std.@o@ +_nonstd.@o@ MODULES_O_COMMA = _kernel.@o@,_system.@o@,_errors.@o@,_multi.@o@,\ _num1.@o@,_num2.@o@,_io.@o@,_eval.@o@,_repl.@o@,_std.@o@,_nonstd.@o@ SOURCES = $(NORMAL_SOURCES) $(MODULES_C) _gambc.c $(MODULES_SCM) OBJECTS = $(NORMAL_OBJECTS) $(MODULES_O) _gambc.@o@ OBJECTS_PLUS = $(NORMAL_OBJECTS_PLUS) $(MODULES_O_PLUS) +_gambc.@o@ OBJECTS_COMMA = $(NORMAL_OBJECTS_COMMA),$(MODULES_O_COMMA),_gambc.@o@ DISTFILES = makefile.in gambit.h header.scm $(SOURCES) tagsfile all: $(GAMBCLIB) _gambc.c $(GAMBCLIB): $(OBJECTS) if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ rm -f $(GAMBCLIB); \ OBJECTS="$(OBJECTS)" \ OBJECTS_PLUS="$(OBJECTS_PLUS)" \ OBJECTS_COMMA="$(OBJECTS_COMMA)" \ eval $(MAKE_GAMBCLIB); \ else \ rm -f $(GAMBCLIB_SH); \ OBJECTS="$(OBJECTS)" \ OBJECTS_PLUS="$(OBJECTS_PLUS)" \ OBJECTS_COMMA="$(OBJECTS_COMMA)" \ eval "$(MAKE_GAMBCLIB_SH)"; \ fi _gambc.c: $(MODULES_C) $(SETDLPATH) ../gsc/gsc -f -flat -o _gambc.c $(MODULES_C) main.@o@: main.c gambit.h if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ $(CC_O) $(srcdirpfx)main.c; \ else \ $(CC_O_SH) $(srcdirpfx)main.c; \ fi setup.@o@: setup.c gambit.h os.h setup.h mem.h c_intf.h if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ $(CC_O) $(srcdirpfx)setup.c; \ else \ $(CC_O_SH) $(srcdirpfx)setup.c; \ fi mem.@o@: mem.c gambit.h os.h setup.h mem.h c_intf.h if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ $(CC_O) $(srcdirpfx)mem.c; \ else \ $(CC_O_SH) $(srcdirpfx)mem.c; \ fi c_intf.@o@: c_intf.c gambit.h os.h setup.h mem.h c_intf.h if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ $(CC_O) $(srcdirpfx)c_intf.c; \ else \ $(CC_O_SH) $(srcdirpfx)c_intf.c; \ fi os.@o@: os.c gambit.h os.h setup.h mem.h c_intf.h if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ $(CC_O) $(srcdirpfx)os.c; \ else \ $(CC_O_SH) $(srcdirpfx)os.c; \ fi $(MODULES_C): $(srcdirpfx)header.scm install: all $(srcdirpfx)../mkidirs $(gambcdir) $(includedir) $(libdir) if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ $(INSTALL_DATA) $(GAMBCLIB) $(libdir)/$(GAMBCLIB); \ else \ $(INSTALL_DATA) $(GAMBCLIB_SH) $(libdir)/$(GAMBCLIB_SH); \ fi $(INSTALL_DATA) _gambc.c $(gambcdir)/_gambc.c $(INSTALL_DATA) $(srcdirpfx)gambit.h $(includedir)/gambit.h uninstall: if [ -n "$(FORCE_STATIC_LINK)" -o -z "$(CC_O_SH)" ]; then \ rm -f $(libdir)/$(GAMBCLIB); \ else \ rm -f $(libdir)/$(GAMBCLIB_SH); \ fi rm -f $(gambcdir)/_gambc.c rm -f $(includedir)/gambit.h tags: tagsfile tagsfile: $(NORMAL_SOURCES) $(MODULES_SCM) cd $(srcdir) && etags -o tagsfile $(NORMAL_SOURCES) $(MODULES_SCM) mostlyclean: rm -f $(OBJECTS) clean: mostlyclean rm -f $(GAMBCLIB) $(GAMBCLIB_SH) distclean: clean rm -f makefile realclean: distclean rm -f tagsfile $(MODULES_C) _gambc.c dist: @echo "Copying distribution files" @for file in $(DISTFILES); do \ ln $(srcdirpfx)$$file ../$(PACKAGE)$(VERSION)/lib 2> /dev/null \ || cp -p $(srcdirpfx)$$file ../$(PACKAGE)$(VERSION)/lib; \ done makefile: makefile.in ../config.status cd .. && CONFIG_FILES=lib/$@ CONFIG_HEADERS= ./config.status # Tell versions [3.59,3.63) of GNU make not to export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: gambc30/lib/gambit.h 644 541 730 375175 6524075776 7633 /* file: "gambit.h" */ /* * Copyright (C) 1994-1998 by Marc Feeley, All Rights Reserved. */ #ifndef ___GAMBIT_H #define ___GAMBIT_H #ifndef ___VERSION @error "___VERSION has not been set by includer" #endif #if ___VERSION != 21 @error "Incompatible version of gambit.h include file" #endif /*---------------------------------------------------------------------------*/ /* * DETERMINE PROGRAMMING ENVIRONMENT'S CHARACTERISTICS * * The following symbols need to be defined to reflect the * programming environment's characteristics: * * define one of the following symbols depending on the processor type * ___CPU_alpha DEC Alpha AXP processor * ___CPU_hppa HP PA-RISC processor * ___CPU_m68k Motorola 68k family processor * ___CPU_mips MIPS Rx000 family processor * ___CPU_ppc PowerPC processor * ___CPU_rs6k IBM RS6000 processor * ___CPU_sony_news Christian Queinnec's processor! * ___CPU_sparc SUN SPARC processor * ___CPU_x86 Intel x86 family processor * * define ___CPU_BIGEND if integers are stored in "big-endian" format * define ___CPU_LITEND if integers are stored in "little-endian" format * * define ___FORCE_32 to force the use of 32 bit words even if 64 bit * words are available * * define ___SCHAR to "char" if the C compiler does not support * signed characters (e.g. SunOS 4.1 cc). * * define ___IMPORTED_ID_PREFIX to the prefix that the C compiler puts on * imported functions (for example "_" if an underscore is needed) * define ___IMPORTED_ID_SUFFIX to the suffix that the C compiler puts on * imported functions * * define ___o as the extension for object files (e.g. "o", "obj") * define ___CC_O as the command that compiles a C file to an object file * define ___CC_O_SH like ___CC_O except that object file is for a shared lib * define ___CLIBS as the libraries to use (e.g. "-lm", "-ldl") * define ___CC_CMD as the command that invokes the C compiler for a * dynamic Scheme compilation * define ___LD_CMD as the command that invokes the linker for a * dynamic Scheme compilation * define ___LD_FLIP to flip the two arguments to the linker * define ___CANT_IMPORT_CLIB_DYNAMICALLY if the dynamic loader can not load * files that import C library functions such as "sqrt" * define ___CANT_IMPORT_SETJMP_DYNAMICALLY if the dynamic loader can not load * files that use "setjmp" * define ___CANT_IMPORT_DYNAMICALLY if the dynamic loader can not load * files that import functions defined in other files * define ___CANT_IMPORT_EXPORTED if exported data/functions in an * executable/library can't be imported in that executable/library * define ___IMPORTED_ADR_NOT_CONST if address-of operator (&) applied to * imported data/functions can't be used in a constant initializer * define ___SETDLPATH as the variable definition that sets up the path * to search for shared libraries in "../lib" * define ___USE_ISNAN if the test "x!=x" does not return true when x * is a NaN */ #define ___FORCE_32 /* remove this line to use 64 bit words if available */ #ifdef sparc #ifndef __linux__ #define ___CPU_sparc #define ___CPU_BIGEND #ifdef __SVR4 #define ___o "o" #ifdef __GNUC__ #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "gcc -fPIC -O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB_SH) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___MAKE_GAMBCLIB_SH "gcc -shared -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "gcc -fPIC -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #else #define ___CC_O "cc -xO1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "cc -Kpic -xO1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "cc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "cc \\\$\$OBJECTS ../lib/\$(GAMBCLIB_SH) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "cc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___MAKE_GAMBCLIB_SH "cc -G -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "cc -Kpic -xO1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #endif #define ___CLIBS "-lm -ldl" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.so.1.1" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___LD_CMD "/usr/ccs/bin/ld -G %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #else #define ___o "o" #ifdef __GNUC__ #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___CC_CMD "gcc -fPIC -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #else #define ___CC_O "cc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "cc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___CC_CMD "cc -pic -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___SCHAR char #endif #define ___LINK_SH "echo" #define ___LINK_SH_INSTALL "echo" #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "echo" #define ___LD_CMD "/usr/bin/ld %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #endif #endif #ifdef sgi #define ___CPU_mips #define ___CPU_BIGEND #define ___o "o" #ifdef __GNUC__ #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "gcc -fpic -O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___MAKE_GAMBCLIB_SH "gcc -shared -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "gcc -fPIC -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #else #define ___CC_O "cc -OPT:IEEE_comparisons=ON -c \$(CC_O_ARGS)" #define ___CC_O_SH "cc -OPT:IEEE_comparisons=ON -c \$(CC_O_SH_ARGS)" #define ___LINK "cc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "cc \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "cc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___MAKE_GAMBCLIB_SH "cc -shared -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "cc -OPT:IEEE_comparisons=ON -c -D___DYNAMIC -o %s.o %s.c" #endif #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.so" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___LD_CMD "/usr/bin/ld -shared %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib LD_LIBRARYN32_PATH=../lib LD_LIBRARY64_PATH=../lib" #endif #ifdef __alpha #define ___CPU_alpha #define ___CPU_LITEND #undef __GNUC__ #ifdef ___FORCE_32 #define ___WORD_IS_SMALLER_THAN_POINTERS #undef __GNUC__ #define ___o "o" #define ___CC_O "cc -w -ieee -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "cc -w -ieee -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "cc -taso -call_shared \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "cc -taso -call_shared \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "cc -taso -call_shared \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.so" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "cc -taso -shared -call_shared -expect_unresolved \\* -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "cc -w -ieee -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___LD_CMD "/usr/bin/ld -taso -shared -expect_unresolved \\* %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #else #define ___o "o" #ifdef __GNUC__ #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "gcc -fpic -O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___MAKE_GAMBCLIB_SH "gcc -shared -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "gcc -fPIC -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #else #define ___CC_O "cc -ieee -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "cc -ieee -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "cc -call_shared \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "cc -call_shared \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "cc -call_shared \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___MAKE_GAMBCLIB_SH "cc -shared -call_shared -expect_unresolved \\* -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "cc -ieee -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #endif #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.so" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___LD_CMD "/usr/bin/ld -shared -expect_unresolved \\* %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #endif #ifdef hpux #ifdef __hp9000s300 #define ___CPU_m68k #define ___CPU_BIGEND #endif #ifdef __hppa #define ___CPU_hppa #define ___CPU_BIGEND #endif #define ___o "o" #ifdef __GNUC__ #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "gcc -fPIC -O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___MAKE_GAMBCLIB_SH "gcc -shared -fPIC -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "gcc -fPIC -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #else #define ___CC_O "cc +O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "cc +z +O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "cc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "cc \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "cc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___MAKE_GAMBCLIB_SH "/bin/ld -b -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "cc +z -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___SCHAR char #endif #define ___CLIBS "-lm -ldld" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.sl" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___LD_CMD "/bin/ld -b %s.o -lm -o %s" #define ___CANT_IMPORT_DYNAMICALLY #define ___SETDLPATH "SHLIB_PATH=../lib" #endif #ifdef _AIX #define ___CPU_rs6k #define ___CPU_BIGEND #define ___o "o" #ifdef __GNUC__ #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #else #define ___CC_O "cc -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "cc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #define ___LINK_SH "echo" #define ___LINK_SH_INSTALL "echo" #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "echo" #define ___SETDLPATH "LIBPATH=../lib" #endif #ifdef sony_news #define ___CPU_sony_news #define ___CPU_BIGEND #define ___o "o" #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "echo" #define ___LINK_SH_INSTALL "echo" #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "echo" #define ___CC_CMD "gcc -fPIC -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___LD_CMD "/usr/ccs/bin/ld -G %s.o -o %s" #define ___CANT_IMPORT_DYNAMICALLY #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #ifdef __linux__using_gplusplus #ifdef __i386__ #define ___CPU_x86 #define ___CPU_LITEND #define ___LINK "g++ -fhandle-exceptions -rdynamic \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "g++ -fhandle-exceptions -rdynamic \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "g++ -fhandle-exceptions -rdynamic \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #ifdef __sparc__ #define ___CPU_sparc #define ___CPU_BIGEND #define ___LINK "g++ -fhandle-exceptions -rdynamic \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "g++ -fhandle-exceptions -rdynamic \\\$\$OBJECTS -L../lib -lgambc -\$(CLIBS) o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "g++ -fhandle-exceptions -rdynamic \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #ifdef __powerpc__ #define ___CPU_ppc #define ___CPU_BIGEND #define ___LINK "g++ -fhandle-exceptions -export-dynamic \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "g++ -fhandle-exceptions -export-dynamic \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "g++ -fhandle-exceptions -export-dynamic \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #define ___o "o" #define ___CC_O "g++ -fhandle-exceptions -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "g++ -fhandle-exceptions -fpic -O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___CLIBS "-lm -ldl" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.so" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "g++ -fhandle-exceptions -shared -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "g++ -fhandle-exceptions -fPIC -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___LD_CMD "/usr/bin/ld -shared %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #ifdef __linux__ #ifdef __i386__ #define ___CPU_x86 #define ___CPU_LITEND #define ___LINK "gcc -rdynamic \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc -rdynamic \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc -rdynamic \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #ifdef __sparc__ #define ___CPU_sparc #define ___CPU_BIGEND #define ___LINK "gcc -rdynamic \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc -rdynamic \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc -rdynamic \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #ifdef __powerpc__ #define ___CPU_ppc #define ___CPU_BIGEND #define ___LINK "gcc -export-dynamic \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc -export-dynamic \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc -export-dynamic \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #define ___o "o" #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "gcc -fpic -O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___CLIBS "-lm -ldl" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.so" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "gcc -shared -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "gcc -fPIC -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___LD_CMD "/usr/bin/ld -shared %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #ifdef __NetBSD__ #ifdef i386 #define ___CPU_x86 #define ___CPU_LITEND #define ___IMPORTED_ID_PREFIX "_" #define ___o "o" #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "gcc -fpic -O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.so.1.1" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "ld -Bshareable -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "gcc -fPIC -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___LD_CMD "/usr/bin/ld -Bshareable %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #endif #ifdef __FreeBSD__ #ifdef i386 #define ___CPU_x86 #define ___CPU_LITEND #define ___IMPORTED_ID_PREFIX "_" #define ___o "o" #define ___CC_O "gcc -O1 -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "gcc -fpic -O1 -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "gcc \\\$\$OBJECTS -L../lib -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "gcc \\\$\$OBJECTS -L\$(libdir) -lgambc \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___GAMBCLIB_SH "libgambc.so.1.1" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "ld -Bshareable -o \$(GAMBCLIB_SH) \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "gcc -fPIC -O1 -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___LD_CMD "/usr/bin/ld -Bshareable %s.o -o %s" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #endif #ifdef __DJGPP__ #ifdef __i386__ #define ___CPU_x86 #define ___CPU_LITEND #define ___o "o" #define ___CC_O "gcc -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "echo" #define ___LINK_SH_INSTALL "echo" #define ___CLIBS "-lm -lemu" #define ___GAMBCLIB "libgambc.a" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "echo" #define ___CC_CMD "gcc -c -D___DYNAMIC -D___SINGLE_HOST -o %s.o %s.c" #define ___LD_CMD "dxegen %s ____linker %s.o" #define ___LD_FLIP #define ___SETDLPATH "" #define ___CANT_IMPORT_DYNAMICALLY #ifdef ___DYNAMIC #undef ___LINKER_ID #define ___LINKER_ID ___linker #endif #define ___CANT_IMPORT_CLIB_DYNAMICALLY #define ___CANT_IMPORT_SETJMP_DYNAMICALLY #endif #endif #ifdef _MSC_VER #ifndef __MWERKS__ #if _MSC_VER < 1000 #ifdef _M_I86 #define ___CPU_x86 #define ___CPU_LITEND #define ___EXPORT_FUNC(type,name)__declspec(dllexport) type name #define ___EXPORT_DATA(type,name)__declspec(dllexport) type name #define ___IMPORT_FUNC(type,name)__declspec(dllimport) type name #define ___IMPORT_DATA(type,name)__declspec(dllimport) type name #define ___o "obj" #define ___CC_O "cl -W0 -AH -Oitb1 -G3s \$(CFLAGS) -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "cl \$(LFLAGS) \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "echo" #define ___LINK_SH_INSTALL "echo" #define ___CLIBS "" #define ___GAMBCLIB "libgambc.lib" #define ___GAMBCLIB_SH "gambc.lib" #define ___MAKE_GAMBCLIB "lib -out:\$(GAMBCLIB) \\\$\$OBJECTS" #define ___MAKE_GAMBCLIB_SH "link -dll \$(LFLAGS) -out:gambc.dll \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "cl -W0 -AH -Oitb1 -G3s -D___DYNAMIC -D___SINGLE_HOST -c -Fo%s.obj %s.c" #define ___LD_CMD "link -noentry -dll %s.obj -out:%s" #define ___SETDLPATH "OLDPATH=\"\$\$PATH\" PATH=\"\$\$OLDPATH;..\\\\\\\\lib\"" #define ___CANT_IMPORT_DYNAMICALLY #define ___IMPORTED_ADR_NOT_CONST #define ___USE_ISNAN #endif #else #ifdef _M_IX86 #define ___CPU_x86 #define ___CPU_LITEND #define ___EXPORT_FUNC(type,name)__declspec(dllexport) type name #define ___EXPORT_DATA(type,name)__declspec(dllexport) type name #define ___IMPORT_FUNC(type,name)__declspec(dllimport) type name #define ___IMPORT_DATA(type,name)__declspec(dllimport) type name #define ___o "obj" #define ___CC_O "cl -nologo -Oityb1 -G5s -MD \$(CFLAGS) -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "cl -nologo -Oityb1 -G5s -MD \$(CFLAGS) -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "cl -nologo \$(LFLAGS) \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #define ___LINK_SH "cl -nologo \$(LFLAGS) \\\$\$OBJECTS ../lib/\$(GAMBCLIB_SH) -o \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "cl -nologo \$(LFLAGS) \\\$\$OBJECTS ../lib/\$(GAMBCLIB_SH) -o \\\$\$EXECUTABLE" #define ___CLIBS "" #define ___GAMBCLIB "libgambc.lib" #define ___GAMBCLIB_SH "gambc.lib" #define ___MAKE_GAMBCLIB "lib -out:\$(GAMBCLIB) \\\$\$OBJECTS" #define ___MAKE_GAMBCLIB_SH "link -nologo -dll \$(LFLAGS) -out:gambc.dll \\\$\$OBJECTS \$(CLIBS)" #define ___CC_CMD "cl -nologo -Oityb1 -G5s -MD -D___DYNAMIC -D___SINGLE_HOST -c -Fo%s.obj %s.c" #define ___LD_CMD "link -nologo -noentry -dll %s.obj -out:%s" #define ___SETDLPATH "OLDPATH=\"\$\$PATH\" PATH=\"\$\$OLDPATH;..\\\\\\\\lib\"" #define ___CANT_IMPORT_DYNAMICALLY #define ___IMPORTED_ADR_NOT_CONST #define ___USE_ISNAN #endif #endif #endif #endif #ifdef __BORLANDC__ #ifdef _M_IX86 #define ___CPU_x86 #define ___CPU_LITEND #define ___EXPORT_FUNC(type,name)type __export name #define ___EXPORT_DATA(type,name)type __export name #define ___IMPORT_FUNC(type,name)type __import name #define ___IMPORT_DATA(type,name)type __import name #define ___IMPORTED_ID_PREFIX "_" #define ___o "obj" #define ___CC_O "bcc32 -w- -O2 -a4 -tWM \$(CFLAGS) -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH "bcc32 -w- -O2 -a4 -tWM \$(CFLAGS) -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "bcc32 -e\\\$\$EXECUTABLE \$(LFLAGS) \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS)" #define ___LINK_SH "bcc32 -e\\\$\$EXECUTABLE \$(LFLAGS) \\\$\$OBJECTS ../lib/\$(GAMBCLIB_SH)" #define ___LINK_SH_INSTALL "bcc32 -e\\\$\$EXECUTABLE \$(LFLAGS) \\\$\$OBJECTS ../lib/\$(GAMBCLIB_SH)" #define ___CLIBS "" #define ___GAMBCLIB "libgambc.lib" #define ___GAMBCLIB_SH "gambc.lib" #define ___MAKE_GAMBCLIB "tlib \$(GAMBCLIB) /p32 \\\$\$OBJECTS_PLUS" #define ___MAKE_GAMBCLIB_SH "tlink32 -Tpd \$(LFLAGS) c0d32.obj \\\$\$OBJECTS, gambc.dll, , import32 cw32mti ; implib \$(GAMBCLIB_SH) gambc.dll" #define ___CC_CMD "bcc32 -w- -O2 -a4 -tWM -D___DYNAMIC -D___SINGLE_HOST -c -o%s.obj %s.c" #define ___LD_CMD "tlink32 -Tpd c0d32.obj %s.obj, %s, , import32 cw32mti" #define ___SETDLPATH "OLDPATH=\"\$\$PATH\" PATH=\"\$\$OLDPATH;..\\\\\\\\lib\"" #define ___CANT_IMPORT_DYNAMICALLY #define ___CANT_IMPORT_EXPORTED #define ___IMPORTED_ADR_NOT_CONST #define ___USE_ISNAN #endif #endif #ifdef __WATCOMC__ #ifdef __386__ #define ___CPU_x86 #define ___CPU_LITEND #define ___EXPORT_FUNC(type,name)__declspec(dllexport) type name #define ___EXPORT_DATA(type,name)__declspec(dllexport) type name #define ___IMPORT_FUNC(type,name)__declspec(dllimport) type name #define ___IMPORT_DATA(type,name)__declspec(dllimport) type name #define ___IMPORTED_ID_SUFFIX "_" #define ___o "obj" #define ___CC_O "wcl386 -w0 -obetir -zp4 -s -5r -fp5 -bm -bt=nt -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___CC_O_SH_BROKEN "wcl386 -w0 -obetir -zp4 -s -5r -fp5 -bm -bt=nt -bd -br -c \$(CC_O_SH_ARGS) -D___SINGLE_HOST" #define ___LINK "wlink option stack=16384 system nt file \\\$\$OBJECTS_COMMA library ..\\\\\\\\lib\\\\\\\\\$(GAMBCLIB),\$(CLIBS) name \\\$\$EXECUTABLE" #define ___LINK_SH "wlink option stack=16384 system nt file \\\$\$OBJECTS_COMMA library ..\\\\\\\\lib\\\\\\\\\$(GAMBCLIB_SH),\$(CLIBS) name \\\$\$EXECUTABLE" #define ___LINK_SH_INSTALL "echo" #define ___CLIBS "kernel32,user32" #define ___GAMBCLIB "libgambc.lib" #define ___GAMBCLIB_SH "gambc.lib" #define ___MAKE_GAMBCLIB "wlib -n -p=32 \$(GAMBCLIB) \\\$\$OBJECTS_PLUS" #define ___MAKE_GAMBCLIB_SH "wlink option stack=16384 system nt_dll file \\\$\$OBJECTS_COMMA library \$(CLIBS),mthrdll name gambc.dll;wlib -n -p=32 \$(GAMBCLIB_SH) +gambc.dll" #define ___CC_CMD "wcl386 -w0 -obetir -zp4 -s -5r -fp5 -bm -bt=nt -bd -br -D___DYNAMIC -D___SINGLE_HOST -c -fo=%s.obj %s.c" #define ___LD_CMD "wlink option stack=16384 system nt_dll file %s.obj name %s" #define ___SETDLPATH "OLDPATH=\"\$\$PATH\" PATH=\"\$\$OLDPATH;..\\\\\\\\lib\"" #define ___CANT_IMPORT_CLIB_DYNAMICALLY #define ___CANT_IMPORT_DYNAMICALLY #define ___CANT_IMPORT_EXPORTED #define ___USE_ISNAN #endif #endif #ifdef __MACHTEN__ #ifdef __MACHTEN_PPC__ #define ___CPU_ppc #define ___CPU_BIGEND #define ___LINK "cc -Xlstack=300000 \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #else #define ___CPU_m68k #define ___LINK "cc \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #define ___LINK_SH "echo" #define ___LINK_SH_INSTALL "echo" #define ___o "o" #define ___CC_O "cc -c \$(CC_O_ARGS)" #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "echo" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #ifdef NeXT #ifdef i386 #define ___CPU_x86 #define ___CPU_LITEND #else #define ___CPU_m68k #define ___CPU_BIGEND #endif #define ___o "o" #ifdef __GNUC__ #define ___CC_O "gcc -posix -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "gcc -posix \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #else #define ___CC_O "cc -posix -c \$(CC_O_ARGS) -D___SINGLE_HOST" #define ___LINK "cc -posix \\\$\$OBJECTS ../lib/\$(GAMBCLIB) \$(CLIBS) -o \\\$\$EXECUTABLE" #endif #define ___LINK_SH "echo" #define ___LINK_SH_INSTALL "echo" #define ___CLIBS "-lm" #define ___GAMBCLIB "libgambc.a" #define ___MAKE_GAMBCLIB "ar rc \$(GAMBCLIB) \\\$\$OBJECTS;ranlib \$(GAMBCLIB)" #define ___MAKE_GAMBCLIB_SH "echo" #define ___SETDLPATH "LD_LIBRARY_PATH=../lib" #endif #ifdef __MWERKS__ #ifdef __INTEL__ #define ___CPU_x86 #define ___CPU_LITEND #define ___SINGLE_HOST #define ___EXPORT_FUNC(type,name)__declspec(dllexport) type name #define ___EXPORT_DATA(type,name)__declspec(dllexport) type name #define ___IMPORT_FUNC(type,name)__declspec(dllimport) type name #define ___IMPORT_DATA(type,name)__declspec(dllimport) type name #define ___CANT_IMPORT_DYNAMICALLY #define ___CANT_IMPORT_EXPORTED #else #ifdef __POWERPC__ #define ___CPU_ppc #define ___SINGLE_HOST #define ___CPU_BIGEND #if __MWERKS__ == 0x1100 #define ___CC_CMD "~~:compile-file.cw11" #else #if __MWERKS__ == 0x1800 #define ___CC_CMD "~~:compile-file.cwpro1" #else #if __MWERKS__ == 0x2000 #define ___CC_CMD "~~:compile-file.cwpro2" #else #if __MWERKS__ == 0x2100 #define ___CC_CMD "~~:compile-file.cwpro3" #else #define ___CC_CMD "~~:compile-file.cwpro4" #endif #endif #endif #endif #else #define ___CPU_m68k #define ___CPU_BIGEND #endif #define ___EXPORT_FUNC(type,name)__declspec(export) type name #define ___EXPORT_DATA(type,name)__declspec(export) type name #define ___IMPORT_FUNC(type,name)__declspec(import) type name #define ___IMPORT_DATA(type,name)__declspec(import) type name #define ___CANT_IMPORT_DYNAMICALLY #define ___CANT_IMPORT_EXPORTED #endif #if __option (warn_illpragma) #define ___PRIMAL #endif #if __option (warn_unusedarg) #define ___LIBRARY #endif #if __option (warn_extracomma) #define ___SHARED #endif #if __option (warn_emptydecl) #define ___DYNAMIC #endif #endif #ifdef __MINGW32__ #define ___CPU_x86 #define ___CPU_LITEND #ifdef __ONLY_FOR_EXPORT__ #define ___EXPORT(type,name)EXPORTED: name :END #define ___IMPORT(type,name)IMPORTED: name :END #else #define ___EXPORT(type,name)type name #define ___IMPORT(type,name)extern type name #endif #define ___o "o" #define ___CC_CMD "gambc-compile.cmd %s %s" #define ___LD_CMD "gambc-link.cmd %s %s" #define ___CANT_IMPORT_DYNAMICALLY #define ___CANT_IMPORT_EXPORTED #endif #ifdef __EMX__ #define ___CPU_x86 #define ___CPU_LITEND #define ___EXPORT(type,name)type name #define ___IMPORT(type,name)extern type name #define ___o "o" #define ___CC_CMD "gambc-compile.cmd %s %s" #define ___LD_CMD "gambc-link.cmd %s %s" #define ___CANT_IMPORT_DYNAMICALLY #define ___CANT_IMPORT_EXPORTED #endif /*---------------------------------------------------------------------------*/ /* * DETERMINE C COMPILER'S CHARACTERISTICS * * The following symbols need to be defined to reflect the * C compiler's characteristics: * * define ___I16 as the integer type of exactly 16 bits * define ___I32 as the integer type of exactly 32 bits * define ___I64 as the integer type of exactly 64 bits (only if one exists) * define ___F32 as the floating-point type of exactly 32 bits * define ___F64 as the floating-point type of exactly 64 bits */ #ifdef ___CPU_alpha #define ___I16 short #define ___I32 int #define ___I64 long #define ___F32 float #define ___F64 double #endif #ifdef ___CPU_hppa #define ___I16 short #define ___I32 long #define ___F32 float #define ___F64 double #endif #ifdef ___CPU_m68k #define ___I16 short #define ___I32 long #define ___F32 float #define ___F64 double #endif #ifdef ___CPU_mips #define ___I16 short #define ___I32 long #define ___F32 float #define ___F64 double #endif #ifdef ___CPU_sony_news #define ___I16 short #define ___I32 long #define ___F32 float #define ___F64 double #endif #ifdef ___CPU_sparc #define ___I16 short #define ___I32 long #define ___F32 float #define ___F64 double #endif #ifdef ___CPU_ppc #define ___I16 short #define ___I32 long #define ___F32 float #define ___F64 double #endif #ifdef ___CPU_rs6k #define ___I16 short #define ___I32 long #define ___F32 float #define ___F64 double #endif #ifdef ___CPU_x86 #define ___I16 short #define ___I32 long #define ___F32 float #define ___F64 double #endif #ifdef __GNUC__ #ifndef ___I64 #define ___I64 long long #endif #endif #ifndef ___SCHAR #define ___SCHAR signed char #endif /*---------------------------------------------------------------------------*/ /* SANITY CHECKS AND SETTING OF DEFAULT OPTIONS */ /* * Verify that processor type is known. */ #ifndef ___I16 @error "___I16 must be defined" #endif #ifndef ___I32 @error "___I32 must be defined" #endif #ifndef ___F32 @error "___F32 must be defined" #endif #ifndef ___F64 @error "___F64 must be defined" #endif #ifdef ___CPU_BIGEND #ifdef ___CPU_LITEND @error "Either ___CPU_BIGEND or ___CPU_LITEND must be defined" #endif #else #ifndef ___CPU_LITEND @error "Either ___CPU_BIGEND or ___CPU_LITEND must be defined" #endif #endif /* * Generate a single host procedure or multiple C host * procedures (default) per Scheme module? */ #ifdef ___SINGLE_HOST #ifdef ___MULTIPLE_HOSTS @error "Define either ___SINGLE_HOST or ___MULTIPLE_HOSTS" #endif #else #ifndef ___MULTIPLE_HOSTS #define ___MULTIPLE_HOSTS #endif #endif /* * Compiling for dynamic loading or not (default). */ #ifdef ___DYNAMIC #ifdef ___NON_DYNAMIC @error "Define either ___DYNAMIC or ___NON_DYNAMIC" #endif #else #ifndef ___NON_DYNAMIC #define ___NON_DYNAMIC #endif #endif /* * Define symbols appropriate for dynamic loading. */ #ifdef ___DYNAMIC #undef ___PRIMAL #define ___PRIMAL #undef ___LIBRARY #define ___LIBRARY #undef ___SHARED #define ___SHARED #undef ___BIND_LATE #define ___BIND_LATE #endif /* * Compiling to produce a library or an application with a "main" (default * unless compiling a flat link file). */ #ifdef ___LIBRARY #ifdef ___APPLICATION @error "Define either ___LIBRARY or ___APPLICATION" #endif #else #ifndef ___APPLICATION #ifdef ___FLAT_LINKFILE #define ___LIBRARY #else #define ___APPLICATION #endif #endif #endif /* * Compiling to produce a shared-library or not (default). */ #ifdef ___SHARED #ifdef ___NON_SHARED @error "Define either ___SHARED or ___NON_SHARED" #endif #else #ifndef ___NON_SHARED #define ___NON_SHARED #endif #endif /* * Select binding time for global variables, symbols, and keywords. * Early binding (default) produces faster code because it directly * accesses the resource. Late binding does an indirection at run * time. */ #ifdef ___BIND_LATE #ifdef ___BIND_EARLY @error "Define either ___BIND_LATE or ___BIND_EARLY" #endif #else #ifndef ___BIND_EARLY #define ___BIND_EARLY #endif #endif /* * Size in bytes of characters in Scheme strings. * * ___CS must be 1, 2 or 4, which give respectively an 8 bit, 16 bit, * or 29 bit subset of Unicode (which is a 31 bit code). The 8 bit * subset of Unicode corresponds to LATIN-1 and the 16 bit subset * of Unicode corresponds to UCS-2. */ #ifndef ___CS #define ___CS 2 #endif /* * Default character encoding to use for I/O. * * ___DEFAULT_IO_ENCODING should be one of: * ___IO_CHAR_ENCODING use text mode and native encoding * ___IO_LATIN1_ENCODING use text mode and LATIN-1 encoding * ___IO_UTF8_ENCODING use text mode and UTF-8 encoding (1..6 bytes/char) * ___IO_BYTE_ENCODING use binary mode and LATIN-1 encoding (1 byte/char) * ___IO_UCS2_ENCODING use binary mode and UCS-2 encoding (2 bytes/char) * ___IO_UCS4_ENCODING use binary mode and UCS-4 encoding (4 bytes/char) */ #ifndef ___DEFAULT_IO_ENCODING #define ___DEFAULT_IO_ENCODING ___IO_CHAR_ENCODING #endif /* * Number of registers in the virtual machine. These definitions must * agree with those in the file "gsc/_t-c-1.scm". All Scheme sources * must be recompiled if these definitions are changed. * * ___NB_GVM_REGS = total number of registers available * 3 <= ___NB_GVM_REGS <= 8 * ___NB_ARG_REGS = maximum number of arguments passed in registers * 1 <= ___NB_ARG_REGS <= ___NB_GVM_REGS-2 */ #define ___NB_GVM_REGS 5 #define ___NB_ARG_REGS 3 /*---------------------------------------------------------------------------*/ #ifdef __cplusplus #define ___P(ansi,kr)ansi #define ___PVOID () #define ___BOOL int #define ___BEGIN_C_LINKAGE extern "C" { #define ___END_C_LINKAGE } #else #ifdef __STDC__ #define ___P(ansi,kr)ansi #define ___PVOID (void) #else #define ___P(ansi,kr)kr #define ___PVOID () #endif #define ___BOOL int #define ___BEGIN_C_LINKAGE #define ___END_C_LINKAGE #define ___USE_SETJMP #endif #ifndef ___HIDDEN #define ___HIDDEN static #endif #ifndef ___LOCAL #define ___LOCAL static #endif #ifndef ___EXPORT_FUNC #define ___EXPORT_FUNC(type,name)type name #endif #ifndef ___EXPORT_DATA #define ___EXPORT_DATA(type,name)type name #endif #ifndef ___IMPORT_FUNC #define ___IMPORT_FUNC(type,name)extern type name #endif #ifndef ___IMPORT_DATA #define ___IMPORT_DATA(type,name)extern type name #endif #define ___EXP_FUNC(type,name)type name #define ___EXP_DATA(type,name)type name #define ___IMP_FUNC(type,name)extern type name #define ___IMP_DATA(type,name)extern type name #ifdef ___SHARED #ifdef ___LIBRARY #undef ___EXP_FUNC #define ___EXP_FUNC(type,name)___EXPORT_FUNC(type,name) #undef ___EXP_DATA #define ___EXP_DATA(type,name)___EXPORT_DATA(type,name) #endif #ifndef ___PRIMAL #undef ___IMP_FUNC #define ___IMP_FUNC(type,name)___IMPORT_FUNC(type,name) #undef ___IMP_DATA #define ___IMP_DATA(type,name)___IMPORT_DATA(type,name) #endif #endif #ifdef ___CANT_IMPORT_EXPORTED #ifdef ___SHARED #ifndef ___PRIMAL #undef ___BIND_LATE #define ___BIND_LATE #endif #endif #endif /*---------------------------------------------------------------------------*/ /* * IMPORTANT NOTE * * As a general principle, the macros are written in such a way that all * macros which expand into C expressions yield PRIMARY C expressions. * Also, macros assume that arguments are PRIMARY expressions. A PRIMARY * expression is either: * * an identifier, or * a non-negative constant, or * a parenthesized expression. * * This convention avoids many operator priority problems and helps keep * the number of parentheses down. On the other hand, it is easy to * introduce errors when modifying these macros so be careful. */ /*---------------------------------------------------------------------------*/ /* * GENERAL DEFINITIONS * * ___U8 an unsigned integer type of exactly 8 bits * ___U16 an unsigned integer type of exactly 16 bits * ___U32 an unsigned integer type of exactly 32 bits * ___U64 an unsigned integer type of exactly 64 bits (only if one exists) * ___WORD an integer type able to contain a pointer with no loss * ___LWS is equal to the base 2 logarithm of "sizeof(___WORD)" */ #define ___U8 unsigned char #define ___U16 unsigned ___I16 #define ___U32 unsigned ___I32 #ifdef ___I64 #define ___U64 unsigned ___I64 #else #undef ___FORCE_32 #define ___FORCE_32 #endif #ifdef ___FORCE_32 #define ___WORD ___I32 #define ___LWS 2 #define ___FLONUM_SIZE 2 #else #define ___WORD ___I64 #define ___LWS 3 #define ___FLONUM_SIZE 1 #endif #define ___WS (1<<___LWS) #define ___LATIN1 ___U8 #define ___UCS4 ___U32 #define ___UCS2 ___U16 #define ___LATIN1STRING ___U8* #define ___UCS4STRING ___UCS4* #define ___UCS2STRING ___UCS2* #define ___UTF8STRING char* #if ___CS == 1 #define ___LCS 0 #define ___C ___U8 #else #if ___CS == 2 #define ___LCS 1 #define ___C ___U16 #else #define ___LCS 2 #define ___C ___U32 #endif #endif #ifdef ___WORD_IS_SMALLER_THAN_POINTERS #define ___FAKEWORD ___WORD #define ___CAST_FAKEWORD_TO_WORD(x)x #define ___CAST_WORDSTAR_TO_FAKEWORD(x)((___WORD)x) #define ___FAKEHOST ___WORD #define ___CAST_HOST_TO_FAKEHOST(x)((___WORD)x) #define ___CAST_FAKEHOST_TO_HOST(x)((___host)x) #else #define ___FAKEWORD ___WORD* #define ___CAST_FAKEWORD_TO_WORD(x)((___WORD)x) #define ___CAST_WORDSTAR_TO_FAKEWORD(x)x #define ___FAKEHOST ___host #define ___CAST_HOST_TO_FAKEHOST(x)x #define ___CAST_FAKEHOST_TO_HOST(x)x #endif /* Padding at end of objects so that they can be aligned to an address */ /* multiple of 4 or 8 by moving them up in memory. */ #ifdef ___FORCE_32 #define ___PADDING ,0 #define ___PADDING_LBL ,{0,0,0,0} #define ___PADDING_FLO ,0,0 #else #define ___PADDING #define ___PADDING_LBL #define ___PADDING_FLO #endif /* Utility macro to select code for MULTIPLE/SINGLE host. */ #ifdef ___SINGLE_HOST #define ___SM(s,m)s #else #define ___SM(s,m)m #endif /*---------------------------------------------------------------------------*/ /* OBJECT REPRESENTATION */ /* * For a complete description of the object representation, read the * file "lib/mem.c". These definitions must agree with those in the * file "lib/header.scm". */ /* * Type tag assignment * * Type tags are located in the lower 2 bits of a ___WORD. * * ___TB = number of tag bits * ___tFIXNUM = tag for fixnums (small integers), must be 0 * ___tSPECIAL = tag for other immediates (#f, #t, (), chars, ...) * ___tPAIR = tag for pairs * ___tSUBTYPED = tag for other memory allocated objects */ #define ___TB 2 #define ___tFIXNUM 0 #define ___tSPECIAL 2 #define ___tPAIR 3 #define ___tSUBTYPED 1 #define ___MEM_ALLOCATED(obj)(obj&1) /* * Subtype tag assignment * * These tags are stored in the head of memory allocated objects * (including pairs). * * ___SB = number of subtype tag bits * ___sVECTOR = tag for vectors * ___sPAIR = tag for pairs * ___sRATNUM = tag for ratnums * ___sCPXNUM = tag for cpxnums * ___sSTRUCTURE = tag for structures * ___sMEROON = tag for Meroon objects * ___sSYMBOL = tag for symbols * ___sKEYWORD = tag for keywords * ___sFRAME = tag for continuation frames * ___sCONTINUATION = tag for continuation descriptors * ___sPROMISE = tag for promises * ___sPROCEDURE = tag for procedures * ___sWILL = tag for wills * ___sSTRING = tag for strings * ___sBIGNUM = tag for bignums * ___sU8VECTOR = tag for 8-bit unsigned integer vectors * ___sU16VECTOR = tag for 16-bit unsigned integer vectors * ___sU32VECTOR = tag for 32-bit unsigned integer vectors * ___sF32VECTOR = tag for 32-bit floating point number vectors * ___sF64VECTOR = tag for 64-bit floating point number vectors * ___sFLONUM = tag for flonums * ___sPOINTER = tag for C pointers * * The three subtype tags ___sF64VECTOR, ___sFLONUM, ___sPOINTER must * come last. These object types are aligned on a multiple of 8. */ #define ___SB 5 #define ___sVECTOR 0 #define ___sPAIR 1 #define ___sRATNUM 2 #define ___sCPXNUM 3 #define ___sSTRUCTURE 4 #define ___sMEROON 6 #define ___sSYMBOL 8 #define ___sKEYWORD 9 #define ___sFRAME 10 #define ___sCONTINUATION 11 #define ___sPROMISE 12 #define ___sPROCEDURE 13 #define ___sWILL 14 #define ___sSTRING 16 #define ___sBIGNUM 17 #define ___sU8VECTOR 25 #define ___sU16VECTOR 26 #define ___sU32VECTOR 27 #define ___sF32VECTOR 28 #define ___sF64VECTOR 29 #define ___sFLONUM 30 #define ___sPOINTER 31 /* * Head type tag assignment * * Head type tags are stored in the lower 3 bits of the head of memory * allocated objects. * * ___HTB = number of head tag bits * ___MOVABLE0 = tag for movable objects in generation 0 * ___FORW = tag for movable objects that have been forwarded * ___STILL = tag for still objects * ___PERM = tag for permanent objects * * note: the tag ___FORW+(1<<___TB) is also used */ #define ___HTB 3 #define ___MOVABLE0 0 #define ___STILL 1 #define ___FORW 3 #define ___PERM 6 /* * Miscellaneous masks. */ #define ___LF (___HTB+___SB) #define ___TMASK ((1<<___TB)-1) #define ___HTMASK ((1<<___HTB)-1) #define ___SMASK (((1<<___SB)-1)<<___HTB) #define ___LMASK (~(___U32)0<<___LF) /* * Value constructors for object references inside executable code. */ #define ___FAL (((___WORD)-1<<___TB)+___tSPECIAL) #define ___TRU (((___WORD)-2<<___TB)+___tSPECIAL) #define ___NUL (((___WORD)-3<<___TB)+___tSPECIAL) #define ___EOF (((___WORD)-4<<___TB)+___tSPECIAL) #define ___VOID (((___WORD)-5<<___TB)+___tSPECIAL) #define ___ABSENT (((___WORD)-6<<___TB)+___tSPECIAL) #define ___UNB1 (((___WORD)-7<<___TB)+___tSPECIAL) #define ___UNB2 (((___WORD)-8<<___TB)+___tSPECIAL) #define ___SCRIPT (((___WORD)-10<<___TB)+___tSPECIAL) #define ___OPTIONAL (((___WORD)-11<<___TB)+___tSPECIAL) #define ___KEY_OBJ (((___WORD)-12<<___TB)+___tSPECIAL) #define ___REST (((___WORD)-13<<___TB)+___tSPECIAL) #define ___FIX(x)((___WORD)((___I32)x<<___TB)) #define ___CHR(x)(((___WORD)(___C)x<<___TB)+___tSPECIAL) #define ___SYM(i,id)___CAST_FAKEWORD_TO_WORD(___sym_tbl[i]) #define ___KEY(i,id)___CAST_FAKEWORD_TO_WORD(___key_tbl[i]) #define ___CNS(i)___TAG((___ALIGNUP(___cns_tbl,___WS)+i*(___PAIR_SIZE+1)),___tPAIR) #define ___SUB(i)___CAST_FAKEWORD_TO_WORD(___sub_tbl[i]) /* * Value constructors for object references inside constant * memory allocated objects. */ #define ___REF_FAL ___FAL #define ___REF_TRU ___TRU #define ___REF_NUL ___NUL #define ___REF_EOF ___EOF #define ___REF_VOID ___VOID #define ___REF_ABSENT ___ABSENT #define ___REF_SCRIPT ___SCRIPT #define ___REF_OPTIONAL ___OPTIONAL #define ___REF_KEY_OBJ ___KEY_OBJ #define ___REF_REST ___REST #define ___REF_FIX(x)___FIX(x) #define ___REF_CHR(x)___CHR(x) #define ___REF_SYM(i,id)(((___WORD)(-1-i)<<___TB)+___tPAIR) #define ___REF_KEY(i,id)(((___WORD)(-1-i)<<___TB)+___tSUBTYPED) #define ___REF_CNS(i)(((___WORD)i<<___TB)+___tPAIR) #define ___REF_SUB(i)(((___WORD)i<<___TB)+___tSUBTYPED) /*---------------------------------------------------------------------------*/ /* Miscellaneous macros */ #define ___NOTHING #define ___INT(x)(x>>___TB) #define ___U32UNBOX(x)((___TYP((___temp=x))==___tFIXNUM)?___INT(___temp): \ ((((((___I32)((___U16*)___BODY_AS(___temp,___tSUBTYPED))[3]<<___RADIX_WIDTH)+ \ (___I32)((___U16*)___BODY_AS(___temp,___tSUBTYPED))[2])<<___RADIX_WIDTH)+ \ (___I32)((___U16*)___BODY_AS(___temp,___tSUBTYPED))[1])* \ (((___U16*)___BODY_AS(___temp,___tSUBTYPED))[0]==0?-1:1))) #define ___RADIX_WIDTH 14 #define ___MIN_FIX (-((___I32)1<<(32-___TB-1))) #define ___MAX_FIX (((___I32)1<<(32-___TB-1))-1) #if ___CS == 4 #define ___MAX_CHR ___MAX_FIX #else #define ___MAX_CHR (((___I32)1<<(8*___CS))-1) #endif /* * Module prefix and C id prefix must match the definitions * in the file "gsc/_parms.scm". */ #define ___MODULE_PREFIX " " #define ___C_ID_PREFIX "___" /*---------------------------------------------------------------------------*/ #define ___ALIGNUP(x,mult)((___WORD*)(((___WORD)x+mult-1)&(-mult))) /* Type tests */ #define ___TAG(ptr,tag)((___WORD)ptr+tag) #define ___UNTAG(obj)((___WORD*)(obj&-(1<<___TB))) #define ___UNTAG_AS(obj,tag)((___WORD*)(obj-tag)) #define ___TYP(x)(x&___TMASK) #define ___TESTTYPE(x,typ)(___TYP(x)==typ) #define ___TESTSUBTYPE(x,s)(___TYP((___temp=x))==___tSUBTYPED&&___SUBTYPE(___temp)==s<<___TB) #define ___HEADER(x)(*___UNTAG_AS(x,___tSUBTYPED)) #define ___BODY_OFS 1 #ifdef ___USE_HANDLES #define ___PAIR_OVERHEAD 2 #define ___SUBTYPED_OVERHEAD 2 #define ___BODY(obj)((___WORD*)(*(___UNTAG(obj)+___BODY_OFS)+___BODY_OFS)) #define ___BODY_AS(obj,tag)((___WORD*)*(___UNTAG_AS(obj,tag)+___BODY_OFS)+___BODY_OFS) #else #define ___PAIR_OVERHEAD 1 #define ___SUBTYPED_OVERHEAD 1 #define ___BODY(obj)(___UNTAG(obj)+___BODY_OFS) #define ___BODY_AS(obj,tag)(___UNTAG_AS(obj,tag)+___BODY_OFS) #endif #define ___MAKE_HD(bytes,subtype,tag)((bytes<<___LF)+(subtype<<___HTB)+tag) #define ___HD_TYP(head)((___U32)head&___HTMASK) #define ___HD_BYTES(head)((___U32)head>>___LF) #define ___HD_WORDS(head)((((___U32)head+((___WS-1)<<___LF)))>>(___LF+___LWS)) #define ___HD_FIELDS(head)((___U32)head>>(___LF+___LWS)) #define ___HD_SUBTYPE(head)((___U32)head>>___HTB&((1<<___SB)-1)) #define ___FIELD(obj,i)(*(___BODY_AS(obj,___tSUBTYPED)+i)) #define ___WORDS(bytes)((bytes+___WS-1)>>___LWS) #define ___MAKE_HD_BYTES(bytes,subtype)___MAKE_HD(bytes,subtype,___MOVABLE0) #define ___MAKE_HD_WORDS(words,subtype)___MAKE_HD((words<<___LWS),subtype,___MOVABLE0) #define ___SYMBOL_SIZE 3 #define ___KEYWORD_SIZE 2 #define ___WILL1_SIZE 2 #define ___WILL2_SIZE 3 #define ___PROMISE_SIZE 2 #define ___RATNUM_SIZE 2 #define ___CPXNUM_SIZE 2 #define ___CONTINUATION_SIZE 3 #define ___INTRO_SIZE 3 #define ___U32BOX(x) \ (___temp=(x), \ ((___U32)___temp<=(___U32)___MAX_FIX)?___FIX(___temp): \ (___hp[0]=___MAKE_HD_BYTES((4<<1),___sBIGNUM), \ ((___U16*)(___hp+1))[0]=1, \ ((___U16*)(___hp+1))[1]=(___U32)___temp&((1<<___RADIX_WIDTH)-1), \ ((___U16*)(___hp+1))[2]=((___U32)___temp>>___RADIX_WIDTH)&((1<<___RADIX_WIDTH)-1), \ ((___U16*)(___hp+1))[3]=((___U32)___temp>>(2*___RADIX_WIDTH))&((1<<___RADIX_WIDTH)-1), \ ___hp+=___WORDS((4<<1))+1, \ ___TAG((___hp-___WORDS((4<<1))-1),___tSUBTYPED))) /* Flonum boxing and unboxing */ #define ___FLONUM_VAL(obj)(*(___F64*)(___BODY_AS(obj,___tSUBTYPED))) #define ___FLONUM_SETUP(ptr,x) \ (*ptr=___MAKE_HD_WORDS(___FLONUM_SIZE,___sFLONUM),*(___F64*)(ptr+1)=x, \ ___TAG(ptr,___tSUBTYPED)) #if ___WS == 4 #define ___F64BOX(x) \ (___hp+=___FLONUM_SIZE+2,((___WORD)___hp&7)==0 \ ?___FLONUM_SETUP((___hp-___FLONUM_SIZE-1),x) \ :___FLONUM_SETUP((___hp-___FLONUM_SIZE-2),x)) #else #define ___F64BOX(x) \ (___hp+=___FLONUM_SIZE+1,___FLONUM_SETUP((___hp-___FLONUM_SIZE-1),x)) #endif #define ___F64UNBOX(x)___FLONUM_VAL(x) #define ___D_F64(x)___F64 x; #define ___SET_F64(x,y)x=y; #define ___IF(x)if (x) { #define ___END_IF } /*---------------------------------------------------------------------------*/ /* Inlinable operations (for 'apply' and 'ifjump' GVM instructions) */ /* APPLY-able operations */ #define ___TYPE(x)___FIX(___TYP(x)) #define ___TYPECAST(x,y)((x&~___TMASK)+___INT(y)) #define ___SUBTYPE(x)((___HEADER(x)&___SMASK)>>(___HTB-___TB)) #define ___SUBTYPESET(x,y)___temp=x;___HEADER(___temp)=(___HEADER(___temp)&~___SMASK)+((y)<<(___HTB-___TB)); /* IFJUMP-able operations */ #define ___FALSEP(x)(x==___FAL) #define ___NULLP(x)(x==___NUL) #define ___UNBOUNDP(x)(((___temp=x)==___UNB1)||(___temp==___UNB2)) #define ___EQP(x,y)(x==y) #define ___EOFP(x)(x==___EOF) /* IFJUMP-able operations */ #define ___FIXNUMP(x)___TESTTYPE(x,___tFIXNUM) #define ___FLONUMP(x)___TESTSUBTYPE(x,___sFLONUM) #define ___SPECIALP(x)___TESTTYPE(x,___tSPECIAL) #define ___PAIRP(x)___TESTTYPE(x,___tPAIR) #define ___SUBTYPEDP(x)___TESTTYPE(x,___tSUBTYPED) #define ___PROCEDUREP(x)___TESTSUBTYPE(x,___sPROCEDURE) #define ___PROMISEP(x)___TESTSUBTYPE(x,___sPROMISE) #define ___VECTORP(x)___TESTSUBTYPE(x,___sVECTOR) #define ___SYMBOLP(x)___TESTSUBTYPE(x,___sSYMBOL) #define ___KEYWORDP(x)___TESTSUBTYPE(x,___sKEYWORD) #define ___RATNUMP(x)___TESTSUBTYPE(x,___sRATNUM) #define ___CPXNUMP(x)___TESTSUBTYPE(x,___sCPXNUM) #define ___STRINGP(x)___TESTSUBTYPE(x,___sSTRING) #define ___STRUCTUREP(x)___TESTSUBTYPE(x,___sSTRUCTURE) #define ___BIGNUMP(x)___TESTSUBTYPE(x,___sBIGNUM) #define ___U8VECTORP(x)___TESTSUBTYPE(x,___sU8VECTOR) #define ___U16VECTORP(x)___TESTSUBTYPE(x,___sU16VECTOR) #define ___U32VECTORP(x)___TESTSUBTYPE(x,___sU32VECTOR) #define ___F32VECTORP(x)___TESTSUBTYPE(x,___sF32VECTOR) #define ___F64VECTORP(x)___TESTSUBTYPE(x,___sF64VECTOR) #define ___CHARP(x)(___TYP((___temp=x))==___tSPECIAL&&___temp>=0) /* APPLY-able operations */ #define ___FIX_0 ___FIX(0) #define ___FIXPOS(x)((___WORD)((___I32)x)) #define ___FIXMAX(x,y)((xtemp1=x),(___ps->temp2=y)))==0?___FIX(0):((___ps->temp1<0)==(___ps->temp2<0)?(___I32)___temp:___FIXADD(___temp,___ps->temp2))) #define ___FIXIOR(x,y)((___WORD)((___I32)x|(___I32)y)) #define ___FIXXOR(x,y)((___WORD)((___I32)x^(___I32)y)) #define ___FIX_M1 ___FIX(-1) #define ___FIXAND(x,y)((___WORD)((___I32)x&(___I32)y)) #define ___FIXNOT(x)((___WORD)((___I32)x^(___I32)~___TMASK)) #define ___FIXASHR(x,y)(((___I32)x>>___INT(y))&~___TMASK) #define ___FIXLSHR(x,y)((___I32)(((___U32)x>>___INT(y))&~___TMASK)) #define ___FIXSHL(x,y)((___I32)x<<___INT(y)) #define ___FIXTOCHR(x)((x&~___TMASK)+___tSPECIAL) #define ___FIXFROMCHR(x)(x&~___TMASK) /* IFJUMP-able operations */ #define ___FIXZEROP(x)(x==0) #define ___FIXPOSITIVEP(x)(x>0) #define ___FIXNEGATIVEP(x)(x<0) #define ___FIXODDP(x)(x&___FIX(1)) #define ___FIXEVENP(x)!(x&___FIX(1)) #define ___FIXEQ(x,y)(x==y) #define ___FIXLT(x,y)(xy) #define ___FIXLE(x,y)(x<=y) #define ___FIXGE(x,y)(x>=y) /* APPLY-able operations */ #define ___F64TOFIX(x)___FIX(x) #define ___F64FROMFIX(x)___INT(x) #define ___F64_0 0.0 #define ___F64POS(x)x #define ___F64MAX(x,y)(___F64NANP(x)?x:((x>y)?x:y)) #define ___F64MIN(x,y)(___F64NANP(x)?x:((x0.0) #define ___F64NEGATIVEP(x)(x<0.0) #define ___F64FINITEP(x)___EXT(___isfinite)(x) #ifdef ___USE_ISNAN #define ___F64NANP(x)___EXT(___isnan)(x) #else #define ___F64NANP(x)(x!=x) #endif #define ___F64EQ(x,y)(x==y) #define ___F64LT(x,y)(xy) #define ___F64LE(x,y)(x<=y) #define ___F64GE(x,y)(x>=y) /* IFJUMP-able operations */ #define ___CHAREQP(x,y)(x==y) #define ___CHARLTP(x,y)(xy) #define ___CHARLEP(x,y)(x<=y) #define ___CHARGEP(x,y)(x>=y) /* APPLY-able operations */ #define ___PAIR_SIZE 2 #define ___PAIR_CDR_OFS 0 #define ___PAIR_CAR_OFS 1 #define ___PAIR_CAR(obj)(*(___BODY_AS(obj,___tPAIR)+___PAIR_CAR_OFS)) #define ___PAIR_CDR(obj)(*(___BODY_AS(obj,___tPAIR)+___PAIR_CDR_OFS)) #define ___CONS(x,y)(___hp[0]=___MAKE_HD_WORDS(___PAIR_SIZE,___sPAIR), \ ___hp[___PAIR_CAR_OFS+1]=x,___hp[___PAIR_CDR_OFS+1]=y,___hp+=___PAIR_SIZE+1,___TAG((___hp-___PAIR_SIZE-1),___tPAIR)) #define ___SETCAR(obj,car)___PAIR_CAR(obj)=car; #define ___SETCDR(obj,cdr)___PAIR_CDR(obj)=cdr; #define ___CAR(obj)___PAIR_CAR(obj) #define ___CDR(obj)___PAIR_CDR(obj) #define ___CAAR(obj)___CAR(___CAR(obj)) #define ___CADR(obj)___CAR(___CDR(obj)) #define ___CDAR(obj)___CDR(___CAR(obj)) #define ___CDDR(obj)___CDR(___CDR(obj)) #define ___CAAAR(obj)___CAR(___CAR(___CAR(obj))) #define ___CAADR(obj)___CAR(___CAR(___CDR(obj))) #define ___CADAR(obj)___CAR(___CDR(___CAR(obj))) #define ___CADDR(obj)___CAR(___CDR(___CDR(obj))) #define ___CDAAR(obj)___CDR(___CAR(___CAR(obj))) #define ___CDADR(obj)___CDR(___CAR(___CDR(obj))) #define ___CDDAR(obj)___CDR(___CDR(___CAR(obj))) #define ___CDDDR(obj)___CDR(___CDR(___CDR(obj))) #define ___CAAAAR(obj)___CAR(___CAR(___CAR(___CAR(obj)))) #define ___CAAADR(obj)___CAR(___CAR(___CAR(___CDR(obj)))) #define ___CAADAR(obj)___CAR(___CAR(___CDR(___CAR(obj)))) #define ___CAADDR(obj)___CAR(___CAR(___CDR(___CDR(obj)))) #define ___CADAAR(obj)___CAR(___CDR(___CAR(___CAR(obj)))) #define ___CADADR(obj)___CAR(___CDR(___CAR(___CDR(obj)))) #define ___CADDAR(obj)___CAR(___CDR(___CDR(___CAR(obj)))) #define ___CADDDR(obj)___CAR(___CDR(___CDR(___CDR(obj)))) #define ___CDAAAR(obj)___CDR(___CAR(___CAR(___CAR(obj)))) #define ___CDAADR(obj)___CDR(___CAR(___CAR(___CDR(obj)))) #define ___CDADAR(obj)___CDR(___CAR(___CDR(___CAR(obj)))) #define ___CDADDR(obj)___CDR(___CAR(___CDR(___CDR(obj)))) #define ___CDDAAR(obj)___CDR(___CDR(___CAR(___CAR(obj)))) #define ___CDDADR(obj)___CDR(___CDR(___CAR(___CDR(obj)))) #define ___CDDDAR(obj)___CDR(___CDR(___CDR(___CAR(obj)))) #define ___CDDDDR(obj)___CDR(___CDR(___CDR(___CDR(obj)))) /* APPLY-able operations */ #define ___MAKECELL(x)(___hp+=2,___hp[-2]=___MAKE_HD_WORDS(1,___sVECTOR), \ ___hp[-1]=x,___TAG((___hp-2),___tSUBTYPED)) #define ___CELLREF(x)___BODY_AS(x,___tSUBTYPED)[0] #define ___CELLSET(x,y)___BODY_AS(x,___tSUBTYPED)[0]=y; #define ___VECTORLENGTH(x)___FIX(___HD_FIELDS(___HEADER(x))) #define ___VECTORREF(x,y)*(___WORD*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)<<(___LWS-___TB))) #define ___VECTORSET(x,y,z)*(___WORD*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)<<(___LWS-___TB)))=z; #define ___VECTORSHRINK(x,y)___temp=x;___HEADER(___temp)=(___HEADER(___temp)&~___LMASK)+((y)<<(___LF-___TB+___LWS)); #define ___STRINGLENGTH(x)___FIX((___HD_BYTES(___HEADER(x))>>___LCS)) #define ___STRINGREF(x,y)___CHR(*(___C*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)>>(___TB-___LCS)))) #define ___STRINGSET(x,y,z)*(___C*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)>>(___TB-___LCS)))=___INT(z); #define ___STRINGSHRINK(x,y)___temp=x;___HEADER(___temp)=(___HEADER(___temp)&~___LMASK)+((y)<<(___LF-___TB+___LCS)); #define ___U8VECTORLENGTH(x)___FIX(___HD_BYTES(___HEADER(x))) #define ___U8VECTORREF(x,y)___FIX(*(___U8*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)>>___TB))) #define ___U8VECTORSET(x,y,z)*(___U8*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)>>___TB))=___INT(z); #define ___U8VECTORSHRINK(x,y)___temp=x;___HEADER(___temp)=(___HEADER(___temp)&~___LMASK)+((y)<<(___LF-___TB)); #define ___U16VECTORLENGTH(x)___FIX((___HD_BYTES(___HEADER(x))>>1)) #define ___U16VECTORREF(x,y)___FIX(*(___U16*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)>>(___TB-1)))) #define ___U16VECTORSET(x,y,z)*(___U16*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)>>(___TB-1)))=___INT(z); #define ___U16VECTORSHRINK(x,y)___temp=x;___HEADER(___temp)=(___HEADER(___temp)&~___LMASK)+((y)<<(___LF-___TB+1)); #define ___U32VECTORLENGTH(x)___FIX((___HD_BYTES(___HEADER(x))>>2)) #define ___U32VECTORREF(x,y)___U32BOX(*(___U32*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)<<(2-___TB)))) #define ___U32VECTORSET(x,y,z)*(___U32*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)<<(2-___TB)))=___U32UNBOX(z); #define ___U32VECTORSHRINK(x,y)___temp=x;___HEADER(___temp)=(___HEADER(___temp)&~___LMASK)+((y)<<(___LF-___TB+2)); #define ___F32VECTORLENGTH(x)___FIX((___HD_BYTES(___HEADER(x))>>2)) #define ___F32VECTORREF(x,y)*(___F32*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)<<(2-___TB))) #define ___F32VECTORSET(x,y,z)*(___F32*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)<<(2-___TB)))=z; #define ___F32VECTORSHRINK(x,y)___temp=x;___HEADER(___temp)=(___HEADER(___temp)&~___LMASK)+((y)<<(___LF-___TB+2)); #define ___F64VECTORLENGTH(x)___FIX((___HD_BYTES(___HEADER(x))>>3)) #define ___F64VECTORREF(x,y)*(___F64*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)<<(3-___TB))) #define ___F64VECTORSET(x,y,z)*(___F64*)(((___WORD)___BODY_AS(x,___tSUBTYPED))+((y)<<(3-___TB)))=z; #define ___F64VECTORSHRINK(x,y)___temp=x;___HEADER(___temp)=(___HEADER(___temp)&~___LMASK)+((y)<<(___LF-___TB+3)); #define ___STRUCTREF(x,y,tag)___VECTORREF(x,y) #define ___STRUCTSET(x,y,z,tag)___VECTORSET(x,y,z) #define ___SYMBOLTOSTR(x)___VECTORREF(x,___FIX(0)) #define ___KEYWORDTOSTR(x)___VECTORREF(x,___FIX(0)) #define ___CLOSURECODE(x)___CLO(x,0) #define ___CLOSUREREF(x,y)___CLO(x,___INT(y)) #define ___CLOSURESET(x,y,z)___SET_CLO(x,___INT(y),z) #define ___GLOBALVARREF(gv)((___glo_struct*)___VECTORREF(gv,___FIX(2)))->val #define ___GLOBALVARSET(gv,x)((___glo_struct*)___VECTORREF(gv,___FIX(2)))->val = x; #define ___MAKEPROMISE(x) \ (___hp+=___PROMISE_SIZE+1, \ ___hp[-3]=___MAKE_HD_WORDS(___PROMISE_SIZE,___sPROMISE), \ ___hp[-2]=x, ___hp[-1]=___TAG((___hp-___PROMISE_SIZE-1),___tSUBTYPED)) #define ___WILLP(x)___TESTSUBTYPE(x,___sWILL) #define ___MAKEWILL1(testator) \ (___hp[0]=___MAKE_HD_WORDS(___WILL1_SIZE,___sWILL), \ ___hp[1]=___FLOATING_WILL, \ ___hp[2]=testator, \ ___hp+=___WILL1_SIZE+1, \ ___TAG((___hp-___WILL1_SIZE-1),___tSUBTYPED)) #define ___MAKEWILL2(testator,action) \ (___hp[0]=___MAKE_HD_WORDS(___WILL2_SIZE,___sWILL), \ ___hp[1]=___ps->non_executable_wills, \ ___hp[2]=testator, \ ___hp[3]=action, \ ___ps->non_executable_wills=___TAG(___hp,0), \ ___hp+=___WILL2_SIZE+1, \ ___TAG((___hp-___WILL2_SIZE-1),___tSUBTYPED)) #define ___WILLTESTATOR(x)___BODY_AS(x,___tSUBTYPED)[1] #define ___EXEC_WILL 1 #define ___REACH_WILL 2 #define ___FLOATING_WILL -1 /*---------------------------------------------------------------------------*/ /* Stack manipulation */ #define ___PUSH(val)*--___fp=(val); #define ___POP *___fp++ #define ___PSSTK(fpo)___PSFP[-(fpo)] #define ___PSADJFP(fpa)___PSFP-=(fpa); #define ___STK(fpo)___fp[-(fpo)] #define ___SET_STK(fpo,val)___fp[-(fpo)]=(val); #define ___ADJFP(fpa)___fp-=(fpa); #define ___PRM(i,glo)___GLOSTRUCT(i,glo).prm #define ___GLO(i,glo)___GLOSTRUCT(i,glo).val #define ___SET_GLO(i,glo,x)___GLOSTRUCT(i,glo).val=x; #ifdef ___BIND_LATE #define ___GLOSTRUCT(i,glo)(*(___glo_struct*)___glo_tbl[i]) #else #define ___GLOSTRUCT(i,glo)glo #endif #define ___HOST_PROC ___SM(___MH_PROC,___PH_PROC) #define ___HOST_LBL0 ___SM(1,___PH_LBL0) #define ___BEGIN_M_COD ___SM(___BEGIN_COD,___NOTHING) #define ___END_M_COD ___SM(___END_COD,___NOTHING) #define ___BEGIN_P_COD ___SM(___NOTHING,___BEGIN_COD) #define ___END_P_COD ___SM(___NOTHING,___END_COD) #define ___BEGIN_P_SLBL #define ___DEF_P_SLBL(id) #define ___END_P_SLBL #define ___D_ALL ___SM(___MD_ALL,___PD_ALL) #define ___R_ALL ___SM(___MR_ALL,___PR_ALL) #define ___W_ALL ___SM(___MW_ALL,___PW_ALL) #define ___BEGIN_COD \ ___HIDDEN ___WORD ___HOST_PROC ___P((___processor_state ___ps),(___ps) \ ___processor_state ___ps;){ \ register ___WORD ___pc, ___temp; \ register ___WORD ___start=___MLBL(___HOST_LBL0); \ ___D_ALL ___R_ALL #define ___END_COD \ ___ps->pc=___pc; ___W_ALL return ___pc; } #define ___LS 4 #define ___PSHEAP ___ps->hp #define ___D_HEAP register ___WORD *___hp; #define ___R_HEAP ___hp=___PSHEAP; #define ___W_HEAP ___PSHEAP=___hp; #define ___PSFP ___ps->fp #define ___D_FP register ___WORD *___fp; #define ___R_FP ___fp=___PSFP; #define ___W_FP ___PSFP=___fp; /*---------------------------------------------------------------------------*/ /* GVM registers */ #define ___MAX_LOCAL_GVM_REGS 8 #define ___PSR0 ___ps->r[0] #if ___MAX_LOCAL_GVM_REGS > 0 #define ___D_R0 register ___WORD ___r0; #define ___R_R0 ___r0=___PSR0; #define ___W_R0 ___PSR0=___r0; #define ___R0 ___r0 #else #define ___D_R0 #define ___R_R0 #define ___W_R0 #define ___R0 ___PSR0 #endif #define ___SET_R0(val)___R0=val; #define ___PUSH_R0 ___PUSH(___R0) #define ___POP_R0 ___SET_R0(___POP) #if ___NB_ARG_REGS == 0 #define ___PUSH_ARGS_IN_REGS(na) #define ___POP_ARGS_IN_REGS(na) #define ___PSSELF ___PSR1 #define ___SELF ___R1 #define ___LD_ARG_REGS #define ___ST_ARG_REGS #endif #define ___PSR1 ___ps->r[1] #if ___MAX_LOCAL_GVM_REGS > 1 #define ___D_R1 register ___WORD ___r1; #define ___R_R1 ___r1=___PSR1; #define ___W_R1 ___PSR1=___r1; #define ___R1 ___r1 #else #define ___D_R1 #define ___R_R1 #define ___W_R1 #define ___R1 ___PSR1 #endif #define ___SET_R1(val)___R1=(val); #define ___PUSH_R1_TO_R1 ___PUSH(___R1) #define ___POP_R1_TO_R1 ___SET_R1(___POP) #define ___LD_R1_TO_R1 ___D_R1 ___R_R1 #define ___ST_R1_TO_R1 ___W_R1 #if ___NB_ARG_REGS == 1 #define ___PUSH_ARGS_IN_REGS(na) \ if ((na)>0) ___PUSH_R1_TO_R1 #define ___POP_ARGS_IN_REGS(na) \ if ((na)>0) ___POP_R1_TO_R1 #define ___PSSELF ___PSR2 #define ___SELF ___R2 #define ___LD_ARG_REGS ___LD_R1_TO_R1 #define ___ST_ARG_REGS ___ST_R1_TO_R1 #endif #if ___NB_GVM_REGS == 2 #define ___PUSH_REGS ___PUSH_R0 ___PUSH_R1_TO_R1 #define ___POP_REGS ___POP_R1_TO_R1 ___POP_R0 #else #define ___PSR2 ___ps->r[2] #if ___MAX_LOCAL_GVM_REGS > 2 #define ___D_R2 register ___WORD ___r2; #define ___R_R2 ___r2=___PSR2; #define ___W_R2 ___PSR2=___r2; #define ___R2 ___r2 #else #define ___D_R2 #define ___R_R2 #define ___W_R2 #define ___R2 ___PSR2 #endif #define ___SET_R2(val)___R2=(val); #define ___PUSH_R1_TO_R2 ___PUSH_R1_TO_R1 ___PUSH(___R2) #define ___POP_R2_TO_R1 ___SET_R2(___POP)___POP_R1_TO_R1 #define ___LD_R1_TO_R2 ___D_R2 ___LD_R1_TO_R1 ___R_R2 #define ___ST_R1_TO_R2 ___ST_R1_TO_R1 ___W_R2 #if ___NB_ARG_REGS == 2 #define ___PUSH_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___PUSH_R1_TO_R1 break; \ default: ___PUSH_R1_TO_R2 \ } #define ___POP_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___POP_R1_TO_R1 break; \ default: ___POP_R2_TO_R1 \ } #define ___PSSELF ___PSR3 #define ___SELF ___R3 #define ___LD_ARG_REGS ___LD_R1_TO_R2 #define ___ST_ARG_REGS ___ST_R1_TO_R2 #endif #if ___NB_GVM_REGS == 3 #define ___PUSH_REGS ___PUSH_R0 ___PUSH_R1_TO_R2 #define ___POP_REGS ___POP_R2_TO_R1 ___POP_R0 #else #define ___PSR3 ___ps->r[3] #if ___MAX_LOCAL_GVM_REGS > 3 #define ___D_R3 register ___WORD ___r3; #define ___R_R3 ___r3=___PSR3; #define ___W_R3 ___PSR3=___r3; #define ___R3 ___r3 #else #define ___D_R3 #define ___R_R3 #define ___W_R3 #define ___R3 ___PSR3 #endif #define ___SET_R3(val)___R3=(val); #define ___PUSH_R1_TO_R3 ___PUSH_R1_TO_R2 ___PUSH(___R3) #define ___POP_R3_TO_R1 ___SET_R3(___POP)___POP_R2_TO_R1 #define ___LD_R1_TO_R3 ___D_R3 ___LD_R1_TO_R2 ___R_R3 #define ___ST_R1_TO_R3 ___ST_R1_TO_R2 ___W_R3 #if ___NB_ARG_REGS == 3 #define ___PUSH_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___PUSH_R1_TO_R1 break; \ case 2: ___PUSH_R1_TO_R2 break; \ default: ___PUSH_R1_TO_R3 \ } #define ___POP_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___POP_R1_TO_R1 break; \ case 2: ___POP_R2_TO_R1 break; \ default: ___POP_R3_TO_R1 \ } #define ___PSSELF ___PSR4 #define ___SELF ___R4 #define ___LD_ARG_REGS ___LD_R1_TO_R3 #define ___ST_ARG_REGS ___ST_R1_TO_R3 #endif #if ___NB_GVM_REGS == 4 #define ___PUSH_REGS ___PUSH_R0 ___PUSH_R1_TO_R3 #define ___POP_REGS ___POP_R3_TO_R1 ___POP_R0 #else #define ___PSR4 ___ps->r[4] #if ___MAX_LOCAL_GVM_REGS > 4 #define ___D_R4 register ___WORD ___r4; #define ___R_R4 ___r4=___PSR4; #define ___W_R4 ___PSR4=___r4; #define ___R4 ___r4 #else #define ___D_R4 #define ___R_R4 #define ___W_R4 #define ___R4 ___PSR4 #endif #define ___SET_R4(val)___R4=(val); #define ___PUSH_R1_TO_R4 ___PUSH_R1_TO_R3 ___PUSH(___R4) #define ___POP_R4_TO_R1 ___SET_R4(___POP)___POP_R3_TO_R1 #define ___LD_R1_TO_R4 ___D_R4 ___LD_R1_TO_R3 ___R_R4 #define ___ST_R1_TO_R4 ___ST_R1_TO_R3 ___W_R4 #if ___NB_ARG_REGS == 4 #define ___PUSH_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___PUSH_R1_TO_R1 break; \ case 2: ___PUSH_R1_TO_R2 break; \ case 3: ___PUSH_R1_TO_R3 break; \ default: ___PUSH_R1_TO_R4 \ } #define ___POP_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___POP_R1_TO_R1 break; \ case 2: ___POP_R2_TO_R1 break; \ case 3: ___POP_R3_TO_R1 break; \ default: ___POP_R4_TO_R1 \ } #define ___PSSELF ___PSR5 #define ___SELF ___R5 #define ___LD_ARG_REGS ___LD_R1_TO_R4 #define ___ST_ARG_REGS ___ST_R1_TO_R4 #endif #if ___NB_GVM_REGS == 5 #define ___PUSH_REGS ___PUSH_R0 ___PUSH_R1_TO_R4 #define ___POP_REGS ___POP_R4_TO_R1 ___POP_R0 #else #define ___PSR5 ___ps->r[5] #if ___MAX_LOCAL_GVM_REGS > 5 #define ___D_R5 register ___WORD ___r5; #define ___R_R5 ___r5=___PSR5; #define ___W_R5 ___PSR5=___r5; #define ___R5 ___r5 #else #define ___D_R5 #define ___R_R5 #define ___W_R5 #define ___R5 ___PSR5 #endif #define ___SET_R5(val)___R5=(val); #define ___PUSH_R1_TO_R5 ___PUSH_R1_TO_R4 ___PUSH(___R5) #define ___POP_R5_TO_R1 ___SET_R5(___POP)___POP_R4_TO_R1 #define ___LD_R1_TO_R5 ___D_R5 ___LD_R1_TO_R4 ___R_R5 #define ___ST_R1_TO_R5 ___ST_R1_TO_R4 ___W_R5 #if ___NB_ARG_REGS == 5 #define ___PUSH_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___PUSH_R1_TO_R1 break; \ case 2: ___PUSH_R1_TO_R2 break; \ case 3: ___PUSH_R1_TO_R3 break; \ case 4: ___PUSH_R1_TO_R4 break; \ default: ___PUSH_R1_TO_R5 \ } #define ___POP_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___POP_R1_TO_R1 break; \ case 2: ___POP_R2_TO_R1 break; \ case 3: ___POP_R3_TO_R1 break; \ case 4: ___POP_R4_TO_R1 break; \ default: ___POP_R5_TO_R1 \ } #define ___PSSELF ___PSR6 #define ___SELF ___R6 #define ___LD_ARG_REGS ___LD_R1_TO_R5 #define ___ST_ARG_REGS ___ST_R1_TO_R5 #endif #if ___NB_GVM_REGS == 6 #define ___PUSH_REGS ___PUSH_R0 ___PUSH_R1_TO_R5 #define ___POP_REGS ___POP_R5_TO_R1 ___POP_R0 #else #define ___PSR6 ___ps->r[6] #if ___MAX_LOCAL_GVM_REGS > 6 #define ___D_R6 register ___WORD ___r6; #define ___R_R6 ___r6=___PSR6; #define ___W_R6 ___PSR6=___r6; #define ___R6 ___r6 #else #define ___D_R6 #define ___R_R6 #define ___W_R6 #define ___R6 ___PSR6 #endif #define ___SET_R6(val)___R6=(val); #define ___PUSH_R1_TO_R6 ___PUSH_R1_TO_R5 ___PUSH(___R6) #define ___POP_R6_TO_R1 ___SET_R6(___POP)___POP_R5_TO_R1 #define ___LD_R1_TO_R6 ___D_R6 ___LD_R1_TO_R5 ___R_R6 #define ___ST_R1_TO_R6 ___ST_R1_TO_R5 ___W_R6 #if ___NB_ARG_REGS == 6 #define ___PUSH_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___PUSH_R1_TO_R1 break; \ case 2: ___PUSH_R1_TO_R2 break; \ case 3: ___PUSH_R1_TO_R3 break; \ case 4: ___PUSH_R1_TO_R4 break; \ case 5: ___PUSH_R1_TO_R5 break; \ default: ___PUSH_R1_TO_R6 \ } #define ___POP_ARGS_IN_REGS(na) \ switch (na) \ { \ case 0: break; \ case 1: ___POP_R1_TO_R1 break; \ case 2: ___POP_R2_TO_R1 break; \ case 3: ___POP_R3_TO_R1 break; \ case 4: ___POP_R4_TO_R1 break; \ case 5: ___POP_R5_TO_R1 break; \ default: ___POP_R6_TO_R1 \ } #define ___PSSELF ___PSR7 #define ___SELF ___R7 #define ___LD_ARG_REGS ___LD_R1_TO_R6 #define ___ST_ARG_REGS ___ST_R1_TO_R6 #endif #if ___NB_GVM_REGS == 7 #define ___PUSH_REGS ___PUSH_R0 ___PUSH_R1_TO_R6 #define ___POP_REGS ___POP_R6_TO_R1 ___POP_R0 #else #define ___PSR7 ___ps->r[7] #if ___MAX_LOCAL_GVM_REGS > 7 #define ___D_R7 register ___WORD ___r7; #define ___R_R7 ___r7=___PSR7; #define ___W_R7 ___PSR7=___r7; #define ___R7 ___r7 #else #define ___D_R7 #define ___R_R7 #define ___W_R7 #define ___R7 ___PSR7 #endif #define ___SET_R7(val)___R7=(val); #define ___PUSH_R1_TO_R7 ___PUSH_R1_TO_R6 ___PUSH(___R7) #define ___POP_R7_TO_R1 ___SET_R7(___POP)___POP_R6_TO_R1 #define ___LD_R1_TO_R7 ___D_R7 ___LD_R1_TO_R6 ___R_R7 #define ___ST_R1_TO_R7 ___ST_R1_TO_R6 ___W_R7 #if ___NB_GVM_REGS == 8 #define ___PUSH_REGS ___PUSH_R0 ___PUSH_R1_TO_R7 #define ___POP_REGS ___POP_R7_TO_R1 ___POP_R0 #endif #endif #endif #endif #endif #endif #endif /*---------------------------------------------------------------------------*/ /* Labels and switches */ #define ___NOT(x)!x #define ___AND(x,y)(x&&y) #define ___MLBL(n)___lp+((n)*___LS*___WS) #define ___LBL(n)___start+((___PH_LBL0-___HOST_LBL0+n)*___LS*___WS) #define ___DEF_SLBL(n,lbl)case ___PH_LBL0-___HOST_LBL0+n:___DEF_GLBL(lbl) #define ___DEF_GLBL(lbl)lbl: #define ___GOTO(lbl)goto lbl; #define ___IF_GOTO(test,lbl)if(test)___GOTO(lbl) #define ___JUMPINT(nargs,prc,lbl)___SM(___GOTO(lbl),{nargs ___pc=prc;goto ___jump;}) #define ___JUMPEXTPRM(nargs,val){nargs ___pc=val;goto ___jumpext;} #define ___JUMPEXT(nargs,val) \ {nargs ___SELF=val; \ ___pc=((___label_struct*)(___SELF-___tSUBTYPED))->entry;goto ___jumpext;} #define ___JUMPPRM(nargs,val){nargs ___pc=val;goto ___jump;} #define ___JUMP(nargs,val) \ {nargs ___SELF=val; \ ___pc=((___label_struct*)(___SELF-___tSUBTYPED))->entry;goto ___jump;} #define ___JUMPGENNOTSAFE(nargs,val)___JUMP(nargs,val) #define ___JUMPGLONOTSAFE(nargs,i,glo)___JUMP(nargs,___GLO(i,glo)) #define ___JUMPGENSAFE(nargs,val) \ {nargs ___SELF=val; \ if (___PROCEDUREP(___SELF)) \ {___pc=((___label_struct*)(___SELF-___tSUBTYPED))->entry;goto ___jump;} \ ___ps->temp1=___SELF;___JUMPEXTPRM(___NOTHING,___ps->handler_not_proc)} #define ___JUMPGLOSAFE(nargs,i,glo) \ {nargs ___SELF=___GLO(i,glo); \ if (___PROCEDUREP(___SELF)) \ {___pc=((___label_struct*)(___SELF-___tSUBTYPED))->entry;goto ___jump;} \ ___ps->temp4=(___WORD)&___GLOSTRUCT(i,glo);___JUMPEXTPRM(___NOTHING,___ps->handler_not_proc_glo)} #ifdef ___NOT_SAFE_CALLS #undef ___JUMPGENSAFE #undef ___JUMPGLOSAFE #define ___JUMPGENSAFE(nargs,val)___JUMPGENNOTSAFE(nargs,val) #define ___JUMPGLOSAFE(nargs,i,glo)___JUMPGLONOTSAFE(nargs,i,glo) #endif #ifdef ___SAFE_CALLS #undef ___JUMPGENNOTSAFE #undef ___JUMPGLONOTSAFE #define ___JUMPGENNOTSAFE(nargs,val)___JUMPGENSAFE(nargs,val) #define ___JUMPGLONOTSAFE(nargs,i,glo)___JUMPGLOSAFE(nargs,i,glo) #endif #ifdef ___SINGLE_HOST #define ___BEGIN_M_SW ___BEGIN_SW #define ___END_M_SW ___END_SW #define ___BEGIN_P_SW #define ___END_P_SW #else #define ___BEGIN_M_SW #define ___END_M_SW #define ___BEGIN_P_SW ___BEGIN_SW #define ___END_P_SW ___END_SW #endif #define ___BEGIN_SW \ ___pc=___ps->pc; \ ___jump: \ switch((___pc-=___start)/(___LS*___WS)) \ { #define ___END_SW \ }___pc+=___start;___jumpext: /*---------------------------------------------------------------------------*/ #define ___PRC(i)___start+((i-___HOST_LBL0)*___LS*___WS) #define ___SET_NARGS(n)___ps->na=n; #define ___IF_NARGS_EQ(n,code)if(___ps->na==n){code}else #define ___WRONG_NARGS(lbl,nb_req,nb_opt,nb_key) \ {___ps->temp1=___LBL(lbl); \ ___JUMPEXTPRM(___NOTHING,___ps->handler_wrong_nargs)} #define ___GET_REST(lbl,nb_req,nb_opt,nb_key) \ if(___ps->na>=0){___ps->temp1=___LBL(lbl); \ ___JUMPEXTPRM(___NOTHING,___ps->handler_get_rest)} #define ___GET_KEY(lbl,nb_req,nb_opt,nb_key,key_descr) \ if(___ps->na>=0){___ps->temp1=___LBL(lbl);___ps->temp2=nb_req+nb_opt; \ ___ps->temp3=key_descr;___JUMPEXTPRM(___NOTHING,___ps->handler_get_key)} #define ___GET_KEY_REST(lbl,nb_req,nb_opt,nb_key,key_descr) \ if(___ps->na>=0){___ps->temp1=___LBL(lbl);___ps->temp2=nb_req+nb_opt; \ ___ps->temp3=key_descr;___JUMPEXTPRM(___NOTHING,___ps->handler_get_key_rest)} #define ___BOOLEAN(x)(x)?___TRU:___FAL #define ___EXPR(x)x; #define ___ALLOC_CLO(n)(___hp+=n+2,___TAG((___hp-n-2),___tSUBTYPED)) #define ___BEGIN_SETUP_CLO(n,clo,lbl) \ {___WORD *___ptr=___UNTAG_AS(clo,___tSUBTYPED); \ ___ptr[0]=___MAKE_HD_WORDS((n+1),___sPROCEDURE); ___ptr[1]=___LBL(lbl); #define ___ADD_CLO_ELEM(i,val)___ptr[i+2]=(val); #define ___END_SETUP_CLO(n) } #define ___CLO(x,y)___BODY_AS(x,___tSUBTYPED)[y] #define ___SET_CLO(x,y,z)___BODY_AS(x,___tSUBTYPED)[y]=z; #define ___BEGIN_ALLOC_LIST(n,last)___CONS(last,___NUL); #define ___ADD_LIST_ELEM(i,val)___CONS(val,___TAG((___hp-3),___tPAIR)); #define ___END_ALLOC_LIST(n) #define ___GET_LIST(n) ___TAG((___hp-3),___tPAIR) #define ___BEGIN_ALLOC_STRING(n) \ ___hp[0]=___MAKE_HD_BYTES((n<<___LCS),___sSTRING); #define ___ADD_STRING_ELEM(i,val)((___C*)(___hp+1))[i]=___INT(val); #define ___END_ALLOC_STRING(n)___hp+=___WORDS((n<<___LCS))+1; #define ___GET_STRING(n)___TAG((___hp-___WORDS((n<<___LCS))-1),___tSUBTYPED) #define ___BEGIN_ALLOC_U8VECTOR(n) \ ___hp[0]=___MAKE_HD_BYTES(n,___sU8VECTOR); #define ___ADD_U8VECTOR_ELEM(i,val)((___U8*)(___hp+1))[i]=___INT(val); #define ___END_ALLOC_U8VECTOR(n)___hp+=___WORDS(n)+1; #define ___GET_U8VECTOR(n)___TAG((___hp-___WORDS(n)-1),___tSUBTYPED) #define ___BEGIN_ALLOC_U16VECTOR(n) \ ___hp[0]=___MAKE_HD_BYTES((n<<1),___sU16VECTOR); #define ___ADD_U16VECTOR_ELEM(i,val)((___U16*)(___hp+1))[i]=___INT(val); #define ___END_ALLOC_U16VECTOR(n)___hp+=___WORDS((n<<1))+1; #define ___GET_U16VECTOR(n)___temp=___TAG((___hp-___WORDS((n<<1))-1),___tSUBTYPED) #define ___BEGIN_ALLOC_U32VECTOR(n) \ ___hp[0]=___MAKE_HD_BYTES((n<<2),___sU32VECTOR); #define ___ADD_U32VECTOR_ELEM(i,val)((___U32*)(___hp+1))[i]=___U32UNBOX(val); #define ___END_ALLOC_U32VECTOR(n)___hp+=___WORDS((n<<2))+1; #define ___GET_U32VECTOR(n)___temp=___TAG((___hp-___WORDS((n<<2))-1),___tSUBTYPED) #define ___BEGIN_ALLOC_F32VECTOR(n) \ ___hp[0]=___MAKE_HD_BYTES((n<<2),___sF32VECTOR); #define ___ADD_F32VECTOR_ELEM(i,val)((___F32*)(___hp+1))[i]=(val); #define ___END_ALLOC_F32VECTOR(n)___hp+=___WORDS((n<<2))+1; #define ___GET_F32VECTOR(n)___temp=___TAG((___hp-___WORDS((n<<2))-1),___tSUBTYPED) #if ___WS == 4 #define ___BEGIN_ALLOC_F64VECTOR(n) \ {___WORD *___ptr = (___WORD*)((___WORD)(___hp+2)&~7); \ ___ptr[-1]=___MAKE_HD_BYTES((n<<3),___sF64VECTOR); #define ___ADD_F64VECTOR_ELEM(i,val)((___F64*)___ptr)[i]=(val); #define ___END_ALLOC_F64VECTOR(n)___hp+=___WORDS((n<<3))+2;} #define ___GET_F64VECTOR(n)___temp=___TAG((((___WORD*)((___WORD)(___hp-___WORDS((n<<3)))&~7))-1),___tSUBTYPED) #else #define ___BEGIN_ALLOC_F64VECTOR(n) \ ___hp[0]=___MAKE_HD_BYTES((n<<3),___sF64VECTOR); #define ___ADD_F64VECTOR_ELEM(i,val)((___F64*)(___hp+1))[i]=(val); #define ___END_ALLOC_F64VECTOR(n)___hp+=___WORDS((n<<3))+1; #define ___GET_F64VECTOR(n)___temp=___TAG((___hp-___WORDS((n<<3))-1),___tSUBTYPED) #endif #define ___BEGIN_ALLOC_VECTOR(n)___hp[0]=___MAKE_HD_WORDS(n,___sVECTOR); #define ___ADD_VECTOR_ELEM(i,val)___hp[i+1]=(val); #define ___END_ALLOC_VECTOR(n)___hp+=n+1; #define ___GET_VECTOR(n)___temp=___TAG((___hp-n-1),___tSUBTYPED) #define ___POLL(n)if(___fp<___ps->stack_trip) \ {___ps->temp1=___LBL(n);___JUMPEXTPRM(___NOTHING,___ps->handler_stack_limit)} #define ___TASK_PUSH(i) #define ___TASK_POP(n) #define ___CHECK_HEAP(n,m)if(___hp>___ps->heap_limit) \ {___ps->temp1=___LBL(n);___JUMPEXTPRM(___NOTHING,___ps->handler_heap_limit)} #define ___FORCE1(n,src) \ if (___TYP((___temp=(src)))==___tSUBTYPED&&___SUBTYPE(___temp)==___sPROMISE<<___TB){___ps->temp1=___LBL(n);___ps->temp2=___temp;___JUMPEXTPRM(___NOTHING,___ps->handler_force); #define ___FORCE2 ___temp=___ps->temp2;} #define ___FORCE3 ___temp #define ___NB_INTRS 3 #define ___INTR_USER 0 #define ___INTR_TIMER 1 #define ___INTR_GC 2 #define ___IO_DEFAULT_ENCODING 0 #define ___IO_CHAR_ENCODING 1 #define ___IO_LATIN1_ENCODING 2 #define ___IO_UTF8_ENCODING 3 #define ___IO_BYTE_ENCODING 4 #define ___IO_UCS2_ENCODING 5 #define ___IO_UCS4_ENCODING 6 #define ___MODULE_KIND 0 #define ___LINKFILE_KIND 1 #define ___CLIBEXT(f)f #define ___SETJMP(x)setjmp(x) #define ___EXT(f)f #ifdef ___BIND_LATE #ifdef ___CANT_IMPORT_CLIB_DYNAMICALLY #undef ___CLIBEXT #define ___CLIBEXT(f)___GSTATE->f #undef ___LOCAL_GSTATE #define ___LOCAL_GSTATE #endif #ifdef ___CANT_IMPORT_SETJMP_DYNAMICALLY #undef ___SETJMP #define ___SETJMP(x)___GSTATE->setjmp(x) #endif #ifdef ___CANT_IMPORT_DYNAMICALLY #undef ___EXT #define ___EXT(f)___GSTATE->f #undef ___LOCAL_GSTATE #define ___LOCAL_GSTATE #endif #endif #ifdef ___LOCAL_GSTATE #define ___GSTATE ___local_gstate #define ___GSTATE_DECL ___LOCAL ___global_state_struct *___local_gstate; #define ___SET_LOCAL_GSTATE(gs) ___local_gstate = gs; #else #define ___GSTATE (&___gstate) #define ___GSTATE_DECL ___IMP_DATA(___global_state_struct,___gstate); #define ___SET_LOCAL_GSTATE(gs) #endif #define ___PSTATE (&___GSTATE->pstate) #ifdef ___BIND_LATE #define ___NEED_SYM(sym) #define ___NEED_KEY(key) #define ___NEED_GLO(glo) #define ___BEGIN_SYM1 ___LOCAL ___UTF8STRING ___sym_names[]={ #define ___DEF_SYM1(i,sym,str)str, #define ___END_SYM1 0}; #define ___DEF_SYM2(i,sym,str) #define ___BEGIN_KEY1 ___LOCAL ___UTF8STRING ___key_names[]={ #define ___DEF_KEY1(i,key,str)str, #define ___END_KEY1 0}; #define ___DEF_KEY2(i,key,str) #define ___BEGIN_GLO ___LOCAL ___UTF8STRING ___glo_names[]={ #define ___DEF_GLO(i,str)str, #define ___END_GLO 0}; #define ___BEGIN_OLD_KEY #define ___DEF_OLD_KEY(key) #define ___END_OLD_KEY #define ___BEGIN_OLD_SYM_GLO #define ___DEF_OLD_SYM_GLO(sym,glo) #define ___END_OLD_SYM_GLO #define ___BEGIN_NEW_KEY #define ___DEF_NEW_KEY(prevkey,key,str,hash) #define ___END_NEW_KEY #define ___BEGIN_NEW_SYM_GLO #define ___DEF_NEW_SYM_GLO_SUP(prevsym,sym,str,hash,glo) #define ___DEF_NEW_SYM_GLO(prevsym,sym,str,hash,glo) #define ___END_NEW_SYM_GLO(prevsym,prevkey)___LINKFILE_DESCR(0,0) #define ___DEF_SUB_NSTR(id,n) #define ___NSTR0 #define ___NSTR1(a) #define ___NSTR2(a,b) #define ___NSTR3(a,b,c) #define ___NSTR4(a,b,c,d) #define ___NSTR5(a,b,c,d,e) #define ___NSTR6(a,b,c,d,e,f) #define ___NSTR7(a,b,c,d,e,f,g) #define ___NSTR8(a,b,c,d,e,f,g,h) #else #define ___NEED_SYM(sym)___IMP_DATA(___symkey_struct,sym); #define ___NEED_KEY(key)___IMP_DATA(___symkey_struct,key); #define ___NEED_GLO(glo)___IMP_DATA(___glo_struct,glo); #ifdef ___IMPORTED_ADR_NOT_CONST #define ___BEGIN_SYM1 ___LOCAL ___FAKEWORD ___sym_tbl[___SYM_COUNT]; #define ___DEF_SYM1(i,sym,str) #define ___END_SYM1 #define ___DEF_SYM2(i,sym,str)___sym_tbl[i]=(___FAKEWORD)(sym); #define ___BEGIN_KEY1 ___LOCAL ___FAKEWORD ___key_tbl[___KEY_COUNT]; #define ___DEF_KEY1(i,key,str) #define ___END_KEY1 #define ___DEF_KEY2(i,key,str)___key_tbl[i]=(___FAKEWORD)(key); #else #define ___BEGIN_SYM1 ___LOCAL ___FAKEWORD ___sym_tbl[]={ #define ___DEF_SYM1(i,sym,str)(___FAKEWORD)(sym), #define ___END_SYM1 0}; #define ___DEF_SYM2(i,sym,str) #define ___BEGIN_KEY1 ___LOCAL ___FAKEWORD ___key_tbl[]={ #define ___DEF_KEY1(i,key,str)(___FAKEWORD)(key), #define ___END_KEY1 0}; #define ___DEF_KEY2(i,key,str) #endif #define ___BEGIN_GLO #define ___DEF_GLO(i,str) #define ___END_GLO #define ___BEGIN_OLD_KEY #define ___DEF_OLD_KEY(key) #define ___END_OLD_KEY #define ___BEGIN_OLD_SYM_GLO #define ___DEF_OLD_SYM_GLO(sym,glo) #define ___END_OLD_SYM_GLO #define ___BEGIN_NEW_KEY #define ___DEF_NEW_KEY(prevkey,key,str,hash) \ ___EXP_DATA(___symkey_struct,key)={(___FAKEWORD)prevkey,(___FAKEWORD)str,0 ___PADDING}; #define ___END_NEW_KEY #define ___BEGIN_NEW_SYM_GLO #define ___DEF_NEW_SYM_GLO_SUP(prevsym,sym,str,hash,glo) \ ___EXP_DATA(___glo_struct,glo) = {___UNB2, ___FIX(hash), 0}; \ ___EXP_DATA(___symkey_struct,sym)={(___FAKEWORD)prevsym,(___FAKEWORD)str,0,(___FAKEWORD)&glo ___PADDING}; #define ___DEF_NEW_SYM_GLO(prevsym,sym,str,hash,glo) \ ___EXP_DATA(___glo_struct,glo) = {___UNB1, ___FIX(hash), 0}; \ ___EXP_DATA(___symkey_struct,sym)={(___FAKEWORD)prevsym,(___FAKEWORD)str,0,(___FAKEWORD)&glo ___PADDING}; #define ___END_NEW_SYM_GLO(prevsym,prevkey)___LINKFILE_DESCR(prevsym,prevkey) #define ___DEF_SUB_NSTR(id,n) ___DEF_SUB_STR(id,n) #define ___NSTR0 ___STR0 #define ___NSTR1(a) ___STR1(a) #define ___NSTR2(a,b) ___STR2(a,b) #define ___NSTR3(a,b,c) ___STR3(a,b,c) #define ___NSTR4(a,b,c,d) ___STR4(a,b,c,d) #define ___NSTR5(a,b,c,d,e) ___STR5(a,b,c,d,e) #define ___NSTR6(a,b,c,d,e,f) ___STR6(a,b,c,d,e,f) #define ___NSTR7(a,b,c,d,e,f,g) ___STR7(a,b,c,d,e,f,g) #define ___NSTR8(a,b,c,d,e,f,g,h) ___STR8(a,b,c,d,e,f,g,h) #endif #define ___BEGIN_CNS \ ___LOCAL ___WORD ___cns_tbl[]={ #define ___DEF_CNS(car,cdr)___MAKE_HD((___PAIR_SIZE<<___LWS),___sPAIR,___PERM),cdr,car #define ___END_CNS ___PADDING}; #define ___BEGIN_SUB \ ___LOCAL ___FAKEWORD ___sub_tbl[]={ #define ___DEF_SUB(id)___CAST_WORDSTAR_TO_FAKEWORD(id) #define ___END_SUB }; #define ___DEF_SUB_VEC(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD((n<<___LWS),___sVECTOR,___PERM) #define ___DEF_SUB_STR(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD((n<<___LCS),___sSTRING,___PERM) #define ___DEF_SUB_BIG(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD((n<<1),___sBIGNUM,___PERM) #define ___DEF_SUB_BIGFIX(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD((n<<1),___sBIGNUM,___PERM) #define ___DEF_SUB_RAT(id,num,den) \ ___LOCAL ___WORD id[]={___MAKE_HD((___RATNUM_SIZE<<___LWS),___sRATNUM,___PERM),num,den ___PADDING}; #define ___DEF_SUB_FLO(id,hi,lo) \ ___LOCAL ___WORD id[]={___MAKE_HD((___FLONUM_SIZE<<___LWS),___sFLONUM,___PERM), \ ___FLO2(hi,lo) ___PADDING_FLO}; #if ___FLONUM_SIZE == 1 #define ___FLO2(hi,lo)((___WORD)hi<<32)+(___U32)lo #else #ifdef ___CPU_BIGEND #define ___FLO2(hi,lo)hi,lo #else #define ___FLO2(hi,lo)lo,hi #endif #endif #define ___DEF_SUB_CPX(id,real,imag) \ ___LOCAL ___WORD id[]={___MAKE_HD((___CPXNUM_SIZE<<___LWS),___sCPXNUM,___PERM),real,imag ___PADDING}; #define ___DEF_SUB_U8VEC(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD(n,___sU8VECTOR,___PERM) #define ___DEF_SUB_U16VEC(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD((n<<1),___sU16VECTOR,___PERM) #define ___DEF_SUB_U32VEC(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD((n<<2),___sU32VECTOR,___PERM) #define ___DEF_SUB_F32VEC(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD((n<<2),___sF32VECTOR,___PERM) #define ___DEF_SUB_F64VEC(id,n) \ ___LOCAL ___WORD id[]={___MAKE_HD((n<<3),___sF64VECTOR,___PERM) #if ___WS == 4 #if ___CS == 1 #ifdef ___CPU_BIGEND #define ___S4(a,b,c,d)((((___WORD)(___C)a<<8)+(___WORD)(___C)b<<8)+(___WORD)(___C)c<<8)+(___WORD)(___C)d #else #define ___S4(d,c,b,a)((((___WORD)(___C)a<<8)+(___WORD)(___C)b<<8)+(___WORD)(___C)c<<8)+(___WORD)(___C)d #endif #else #if ___CS == 2 #ifdef ___CPU_BIGEND #define ___S4(a,b,c,d)((___WORD)(___C)a<<16)+(___WORD)(___C)b,((___WORD)(___C)c<<16)+(___WORD)(___C)d #else #define ___S4(b,a,d,c)((___WORD)(___C)a<<16)+(___WORD)(___C)b,((___WORD)(___C)c<<16)+(___WORD)(___C)d #endif #else #define ___S4(a,b,c,d)a,b,c,d #endif #endif #define ___STR0 ___PADDING}; #define ___STR1(a),___S4(a,0,0,0) ___PADDING}; #define ___STR2(a,b),___S4(a,b,0,0) ___PADDING}; #define ___STR3(a,b,c),___S4(a,b,c,0) ___PADDING}; #define ___STR4(a,b,c,d),___S4(a,b,c,d) ___PADDING}; #define ___STR5(a,b,c,d,e),___S4(a,b,c,d),___S4(e,0,0,0) ___PADDING}; #define ___STR6(a,b,c,d,e,f),___S4(a,b,c,d),___S4(e,f,0,0) ___PADDING}; #define ___STR7(a,b,c,d,e,f,g),___S4(a,b,c,d),___S4(e,f,g,0) ___PADDING}; #define ___STR8(a,b,c,d,e,f,g,h),___S4(a,b,c,d),___S4(e,f,g,h) #ifdef ___CPU_BIGEND #define ___B2(a,b)((___WORD)(___U16)a<<16)+(___WORD)(___U16)b #else #define ___B2(b,a)((___WORD)(___U16)a<<16)+(___WORD)(___U16)b #endif #define ___BIG0 ___PADDING}; #define ___BIG1(a),___B2(a,0) ___PADDING}; #define ___BIG2(a,b),___B2(a,b) ___PADDING}; #define ___BIG3(a,b,c),___B2(a,b),___B2(c,0) ___PADDING}; #define ___BIG4(a,b,c,d),___B2(a,b),___B2(c,d) #define ___BIGFIX0 ___PADDING}; #define ___BIGFIX1(a),___B2(a,0) ___PADDING}; #define ___BIGFIX2(a,b),___B2(a,b) ___PADDING}; #define ___BIGFIX3(a,b,c),___B2(a,b),___B2(c,0) ___PADDING}; #define ___BIGFIX4(a,b,c,d),___B2(a,b),___B2(c,d) #ifdef ___CPU_BIGEND #define ___P8(a,b,c,d)((((___WORD)(___U8)a<<8)+(___WORD)(___U8)b<<8)+(___WORD)(___U8)c<<8)+(___WORD)(___U8)d #else #define ___P8(d,c,b,a)((((___WORD)(___U8)a<<8)+(___WORD)(___U8)b<<8)+(___WORD)(___U8)c<<8)+(___WORD)(___U8)d #endif #define ___U8VEC0 ___PADDING}; #define ___U8VEC1(a),___P8(a,0,0,0) ___PADDING}; #define ___U8VEC2(a,b),___P8(a,b,0,0) ___PADDING}; #define ___U8VEC3(a,b,c),___P8(a,b,c,0) ___PADDING}; #define ___U8VEC4(a,b,c,d),___P8(a,b,c,d) ___PADDING}; #define ___U8VEC5(a,b,c,d,e),___P8(a,b,c,d),___P8(e,0,0,0) ___PADDING}; #define ___U8VEC6(a,b,c,d,e,f),___P8(a,b,c,d),___P8(e,f,0,0) ___PADDING}; #define ___U8VEC7(a,b,c,d,e,f,g),___P8(a,b,c,d),___P8(e,f,g,0) ___PADDING}; #define ___U8VEC8(a,b,c,d,e,f,g,h),___P8(a,b,c,d),___P8(e,f,g,h) #ifdef ___CPU_BIGEND #define ___P16(a,b)((___WORD)(___U16)a<<16)+(___WORD)(___U16)b #else #define ___P16(b,a)((___WORD)(___U16)a<<16)+(___WORD)(___U16)b #endif #define ___U16VEC0 ___PADDING}; #define ___U16VEC1(a),___P16(a,0) ___PADDING}; #define ___U16VEC2(a,b),___P16(a,b) ___PADDING}; #define ___U16VEC3(a,b,c),___P16(a,b),___P16(c,0) ___PADDING}; #define ___U16VEC4(a,b,c,d),___P16(a,b),___P16(c,d) #define ___U32VEC0 ___PADDING}; #define ___U32VEC1(a),a ___PADDING}; #define ___U32VEC2(a,b),a,b #define ___F32VEC0 ___PADDING}; #define ___F32VEC1(a),a ___PADDING}; #define ___F32VEC2(a,b),a,b #else #if ___CS == 1 #ifdef ___CPU_BIGEND #define ___S8(a,b,c,d,e,f,g,h)(((((((((___WORD)(___C)a<<8)+(___WORD)(___C)b<<8)+(___WORD)(___C)c<<8)+(___WORD)(___C)d<<8)+(___WORD)(___C)e<<8)+(___WORD)(___C)f<<8)+(___WORD)(___C)g<<8)+(___WORD)(___C)h) #else #define ___S8(h,g,f,e,d,c,b,a)(((((((((___WORD)(___C)a<<8)+(___WORD)(___C)b<<8)+(___WORD)(___C)c<<8)+(___WORD)(___C)d<<8)+(___WORD)(___C)e<<8)+(___WORD)(___C)f<<8)+(___WORD)(___C)g<<8)+(___WORD)(___C)h) #endif #else #if ___CS == 2 #ifdef ___CPU_BIGEND #define ___S8(a,b,c,d,e,f,g,h)((((___WORD)(___C)a<<16)+(___WORD)(___C)b<<16)+(___WORD)(___C)c<<16)+(___WORD)(___C)d,((((___WORD)(___C)e<<16)+(___WORD)(___C)f<<16)+(___WORD)(___C)g<<16)+(___WORD)(___C)h #else #define ___S8(d,c,b,a,h,g,f,e)((((___WORD)(___C)a<<16)+(___WORD)(___C)b<<16)+(___WORD)(___C)c<<16)+(___WORD)(___C)d,((((___WORD)(___C)e<<16)+(___WORD)(___C)f<<16)+(___WORD)(___C)g<<16)+(___WORD)(___C)h #endif #else #ifdef ___CPU_BIGEND #define ___S8(a,b,c,d,e,f,g,h)((___WORD)(___C)a<<32)+(___WORD)(___C)b,((___WORD)(___C)c<<32)+(___WORD)(___C)d,((___WORD)(___C)e<<32)+(___WORD)(___C)f,((___WORD)(___C)g<<32)+(___WORD)(___C)h #else #define ___S8(b,a,d,c,f,e,h,g)((___WORD)(___C)a<<32)+(___WORD)(___C)b,((___WORD)(___C)c<<32)+(___WORD)(___C)d,((___WORD)(___C)e<<32)+(___WORD)(___C)f,((___WORD)(___C)g<<32)+(___WORD)(___C)h #endif #endif #endif #define ___STR0 ___PADDING}; #define ___STR1(a),___S8(a,0,0,0,0,0,0,0) ___PADDING}; #define ___STR2(a,b),___S8(a,b,0,0,0,0,0,0) ___PADDING}; #define ___STR3(a,b,c),___S8(a,b,c,0,0,0,0,0) ___PADDING}; #define ___STR4(a,b,c,d),___S8(a,b,c,d,0,0,0,0) ___PADDING}; #define ___STR5(a,b,c,d,e),___S8(a,b,c,d,e,0,0,0) ___PADDING}; #define ___STR6(a,b,c,d,e,f),___S8(a,b,c,d,e,f,0,0) ___PADDING}; #define ___STR7(a,b,c,d,e,f,g),___S8(a,b,c,d,e,f,g,0) ___PADDING}; #define ___STR8(a,b,c,d,e,f,g,h),___S8(a,b,c,d,e,f,g,h) #ifdef ___CPU_BIGEND #define ___B4(a,b,c,d)((((___WORD)(___U16)a<<16)+(___WORD)(___U16)b<<16)+(___WORD)(___U16)c<<16)+(___WORD)(___U16)d #else #define ___B4(d,c,b,a)((((___WORD)(___U16)a<<16)+(___WORD)(___U16)b<<16)+(___WORD)(___U16)c<<16)+(___WORD)(___U16)d #endif #define ___BIG0 ___PADDING}; #define ___BIG1(a),___B4(a,0,0,0) ___PADDING}; #define ___BIG2(a,b),___B4(a,b,0,0) ___PADDING}; #define ___BIG3(a,b,c),___B4(a,b,c,0) ___PADDING}; #define ___BIG4(a,b,c,d),___B4(a,b,c,d) #define ___BIGEND0 ___PADDING}; #define ___BIGEND1(a),___B4(a,0,0,0) ___PADDING}; #define ___BIGEND2(a,b),___B4(a,b,0,0) ___PADDING}; #define ___BIGEND3(a,b,c),___B4(a,b,c,0) ___PADDING}; #define ___BIGEND4(a,b,c,d),___B4(a,b,c,d) #ifdef ___CPU_BIGEND #define ___P8(a,b,c,d,e,f,g,h)((((((((___WORD)(___U8)a<<8)+(___WORD)(___U8)b<<8)+(___WORD)(___U8)c<<8)+(___WORD)(___U8)d<<8)+(___WORD)(___U8)e<<8)+(___WORD)(___U8)f<<8)+(___WORD)(___U8)g<<8)+(___WORD)(___U8)h #else #define ___P8(h,g,f,e,d,c,b,a)((((((((___WORD)(___U8)a<<8)+(___WORD)(___U8)b<<8)+(___WORD)(___U8)c<<8)+(___WORD)(___U8)d<<8)+(___WORD)(___U8)e<<8)+(___WORD)(___U8)f<<8)+(___WORD)(___U8)g<<8)+(___WORD)(___U8)h #endif #define ___U8VEC0 ___PADDING}; #define ___U8VEC1(a),___P8(a,0,0,0,0,0,0,0) ___PADDING}; #define ___U8VEC2(a,b),___P8(a,b,0,0,0,0,0,0) ___PADDING}; #define ___U8VEC3(a,b,c),___P8(a,b,c,0,0,0,0,0) ___PADDING}; #define ___U8VEC4(a,b,c,d),___P8(a,b,c,d,0,0,0,0) ___PADDING}; #define ___U8VEC5(a,b,c,d,e),___P8(a,b,c,d,e,0,0,0) ___PADDING}; #define ___U8VEC6(a,b,c,d,e,f),___P8(a,b,c,d,e,f,0,0) ___PADDING}; #define ___U8VEC7(a,b,c,d,e,f,g),___P8(a,b,c,d,e,f,g,0) ___PADDING}; #define ___U8VEC8(a,b,c,d,e,f,g,h),___P8(a,b,c,d,e,f,g,h) #ifdef ___CPU_BIGEND #define ___P16(a,b,c,d)((((___WORD)(___U16)a<<16)+(___WORD)(___U16)b<<16)+(___WORD)(___U16)c<<16)+(___WORD)(___U16)d #else #define ___P16(d,c,b,a)((((___WORD)(___U16)a<<16)+(___WORD)(___U16)b<<16)+(___WORD)(___U16)c<<16)+(___WORD)(___U16)d #endif #define ___U16VEC0 ___PADDING}; #define ___U16VEC1(a),___P16(a,0,0,0) ___PADDING}; #define ___U16VEC2(a,b),___P16(a,b,0,0) ___PADDING}; #define ___U16VEC3(a,b,c),___P16(a,b,c,0) ___PADDING}; #define ___U16VEC4(a,b,c,d),___P16(a,b,c,d) #ifdef ___CPU_BIGEND #define ___P32(a,b)((___WORD)(___U32)a<<32)+(___WORD)(___U32)b #else #define ___P32(b,a)((___WORD)(___U32)a<<32)+(___WORD)(___U32)b #endif #define ___U32VEC0 ___PADDING}; #define ___U32VEC1(a),___P32(a,0) ___PADDING}; #define ___U32VEC2(a,b),___P32(a,b) #define ___F32VEC0 ___PADDING}; #define ___F32VEC1(a),___P32(a,0) ___PADDING}; #define ___F32VEC2(a,b),___P32(a,b) #endif #define ___F64VEC0 ___PADDING_FLO}; #define ___F64VEC1(hi,lo),___FLO2(hi,lo) #define ___VEC0 ___PADDING}; #define ___VEC1(a),a #define ___MAKE_PROC_INFO(nbparms,nbclosed)(nbclosed<<17)+(nbparms<<3)+1 #define ___PROC_INFO_NBPARMS(x)(((x)>>3)&((1<<14)-1)) #define ___PROC_INFO_NBCLOSED(x)(((x)>>17)&((1<<14)-1)) #define ___MAKE_RETN_INFO(fs,link)(link<<17)+(fs<<3)+3 #define ___RETN_INFO_FS(x)(((x)>>3)&((1<<14)-1)) #define ___RETN_INFO_LINK(x)(((x)>>17)&((1<<14)-1)) #define ___MAKE_RETT_INFO(fs,link)(link<<17)+(fs<<3)+4 #define ___RETT_INFO_FS(x)(((x)>>3)&((1<<14)-1)) #define ___RETT_INFO_LINK(x)(((x)>>17)&((1<<14)-1)) #define ___MAKE_RETI_INFO(fs,link)(link<<17)+((fs+___NB_GVM_REGS+1)<<3)+7 #define ___RETI_INFO_FS(x)(((x)>>3)&((1<<14)-1)) #define ___RETI_INFO_LINK(x)(((x)>>17)&((1<<14)-1)) #define ___BEGIN_LBL \ ___LOCAL ___label_struct ___lbl_tbl[]={ #define ___DEF_LBL_INTRO(id,info,cproc){___MAKE_HD((___INTRO_SIZE<<___LWS),___sVECTOR,___PERM),info,0,___CAST_HOST_TO_FAKEHOST((___host)cproc)} #define ___DEF_LBL_PROC(id,nbp,nbc){___MAKE_HD((3<<___LWS),___sPROCEDURE,___PERM),0,___MAKE_PROC_INFO(nbp,nbc),___CAST_HOST_TO_FAKEHOST(___SM(___MH_PROC,id))} #define ___DEF_LBL_RETN(id,fs,link){___MAKE_HD((3<<___LWS),___sPROCEDURE,___PERM),0,___MAKE_RETN_INFO(fs,link),___CAST_HOST_TO_FAKEHOST(___SM(___MH_PROC,id))} #define ___DEF_LBL_RETT(id,fs,link){___MAKE_HD((3<<___LWS),___sPROCEDURE,___PERM),0,___MAKE_RETT_INFO(fs,link),___CAST_HOST_TO_FAKEHOST(___SM(___MH_PROC,id))} #define ___DEF_LBL_RETI(id,fs,link){___MAKE_HD((3<<___LWS),___sPROCEDURE,___PERM),0,___MAKE_RETI_INFO(fs,link),___CAST_HOST_TO_FAKEHOST(___SM(___MH_PROC,id))} #define ___END_LBL ___PADDING_LBL}; #ifdef ___GLO_COUNT #ifdef ___BIND_LATE #define ___GLO_DECL ___LOCAL ___FAKEWORD ___glo_tbl[___GLO_COUNT]; #define ___GLO_TBL ___glo_tbl,___GLO_COUNT,___SUP_COUNT,___glo_names #else #define ___GLO_DECL #define ___GLO_TBL 0,0,0,0 #endif #else #define ___GLO_DECL #define ___GLO_TBL 0,0,0,0 #endif #ifdef ___SYM_COUNT #ifdef ___BIND_LATE #define ___SYM_DECL ___LOCAL ___FAKEWORD ___sym_tbl[___SYM_COUNT]; #define ___SYM_TBL ___sym_tbl,___SYM_COUNT,___sym_names #else #define ___SYM_DECL #define ___SYM_TBL ___sym_tbl,___SYM_COUNT,0 #endif #else #define ___SYM_DECL #define ___SYM_TBL 0,0,0 #endif #ifdef ___KEY_COUNT #ifdef ___BIND_LATE #define ___KEY_DECL ___LOCAL ___FAKEWORD ___key_tbl[___KEY_COUNT]; #define ___KEY_TBL ___key_tbl,___KEY_COUNT,___key_names #else #define ___KEY_DECL #define ___KEY_TBL ___key_tbl,___KEY_COUNT,0 #endif #else #define ___KEY_DECL #define ___KEY_TBL 0,0,0 #endif #ifdef ___LBL_COUNT #define ___LBL_TBL &___lp,___lbl_tbl,___LBL_COUNT #else #define ___LBL_TBL 0,0,0 #endif #ifdef ___CNS_COUNT #define ___CNS_TBL ___cns_tbl,___CNS_COUNT #else #define ___CNS_TBL 0,0 #endif #ifdef ___SUB_COUNT #define ___SUB_TBL ___sub_tbl,___SUB_COUNT #else #define ___SUB_TBL 0,0 #endif #define ___BEGIN_MOD1 ___LOCAL void ___init_proc ___PVOID{ #define ___DEF_PRM(i,glo,n)___PRM(i,glo)=___GLO(i,glo)=___MLBL(n); #define ___END_MOD1 } #define ___BEGIN_MOD2 ___LOCAL ___module_struct ___module_descr={ \ ___VERSION,___MODULE_KIND,___MODULE_NAME, \ ___GLO_TBL,___SYM_TBL,___KEY_TBL,___LBL_TBL,___CNS_TBL,___SUB_TBL, \ ___init_proc,0}; \ ___BEGIN_C_LINKAGE ___EXP_FUNC(___mod_or_lnk,___LINKER_ID) \ ___P((___global_state_struct *___gs),(___gs) \ ___global_state_struct *___gs;) \ { ___SET_LOCAL_GSTATE(___gs) #define ___END_MOD2 return (___mod_or_lnk)&___module_descr;} ___END_C_LINKAGE #ifndef ___LIBRARY #define ___MAIN_PROC \ ___IMP_FUNC(int,___main) \ ___P((int argc, \ char **argv, \ ___mod_or_lnk (*linker)(___global_state_struct*)), \ ()); \ int main ___P((int argc, char **argv),(argc, argv) \ int argc; char **argv;) \ { return ___main (argc, argv, ___LINKER_ID); } #else #define ___MAIN_PROC #endif #define ___LINKFILE_DESCR(sym_list,key_list) \ ___LOCAL ___linkfile_struct ___linkfile_descr={ \ ___VERSION,___LINKFILE_KIND,___LINKFILE_NAME, \ sym_list,key_list,___linker_tbl}; \ ___BEGIN_C_LINKAGE ___EXP_FUNC(___mod_or_lnk,___LINKER_ID) \ ___P((___global_state_struct *___gs),(___gs) \ ___global_state_struct *___gs;) \ { ___SET_LOCAL_GSTATE(___gs) return (___mod_or_lnk)&___linkfile_descr;} \ ___END_C_LINKAGE ___MAIN_PROC #define ___BEGIN_OLD_LNK #define ___DEF_OLD_LNK(id)___BEGIN_C_LINKAGE ___IMP_FUNC(___mod_or_lnk,id) \ ___P((___global_state_struct *___gs),()); ___END_C_LINKAGE #define ___END_OLD_LNK #define ___BEGIN_NEW_LNK #define ___DEF_NEW_LNK(id)___BEGIN_C_LINKAGE ___mod_or_lnk id \ ___P((___global_state_struct *___gs),()); ___END_C_LINKAGE #define ___END_NEW_LNK #define ___BEGIN_LNK ___LOCAL void *___linker_tbl[]={ #define ___DEF_LNK(id)(void*)id #define ___END_LNK ,0}; /* * ___NO_ERR must be 0. */ #define ___NO_ERR 0 #define ___UNWIND_C_STACK ((3<<13)+0) #define ___CDEF_HEAP_OVERFLOW_ERR ((3<<13)+1) #define ___FIRST_C_CONV_ERR ___STOC_CHAR_ERR #define ___STOC_CHAR_ERR ((3<<13)+(1<<7)) #define ___STOC_SCHAR_ERR ((3<<13)+(2<<7)) #define ___STOC_UCHAR_ERR ((3<<13)+(3<<7)) #define ___STOC_LATIN1_ERR ((3<<13)+(4<<7)) #define ___STOC_UCS4_ERR ((3<<13)+(5<<7)) #define ___STOC_UCS2_ERR ((3<<13)+(6<<7)) #define ___STOC_SHORT_ERR ((3<<13)+(7<<7)) #define ___STOC_USHORT_ERR ((3<<13)+(8<<7)) #define ___STOC_INT_ERR ((3<<13)+(9<<7)) #define ___STOC_UINT_ERR ((3<<13)+(10<<7)) #define ___STOC_LONG_ERR ((3<<13)+(11<<7)) #define ___STOC_ULONG_ERR ((3<<13)+(12<<7)) #define ___STOC_FLOAT_ERR ((3<<13)+(13<<7)) #define ___STOC_DOUBLE_ERR ((3<<13)+(14<<7)) #define ___STOC_POINTER_ERR ((3<<13)+(15<<7)) #define ___STOC_FUNCTION_ERR ((3<<13)+(16<<7)) #define ___STOC_BOOL_ERR ((3<<13)+(17<<7)) #define ___STOC_CHARSTRING_ERR ((3<<13)+(18<<7)) #define ___STOC_LATIN1STRING_ERR ((3<<13)+(19<<7)) #define ___STOC_UCS4STRING_ERR ((3<<13)+(20<<7)) #define ___STOC_UCS2STRING_ERR ((3<<13)+(21<<7)) #define ___STOC_UTF8STRING_ERR ((3<<13)+(22<<7)) #define ___STOC_HEAP_OVERFLOW_ERR ((3<<13)+(23<<7)) #define ___CTOS_CHAR_ERR ((3<<13)+(31<<7)) #define ___CTOS_SCHAR_ERR ((3<<13)+(32<<7)) #define ___CTOS_UCHAR_ERR ((3<<13)+(33<<7)) #define ___CTOS_LATIN1_ERR ((3<<13)+(34<<7)) #define ___CTOS_UCS4_ERR ((3<<13)+(35<<7)) #define ___CTOS_UCS2_ERR ((3<<13)+(36<<7)) #define ___CTOS_SHORT_ERR ((3<<13)+(37<<7)) #define ___CTOS_USHORT_ERR ((3<<13)+(38<<7)) #define ___CTOS_INT_ERR ((3<<13)+(39<<7)) #define ___CTOS_UINT_ERR ((3<<13)+(40<<7)) #define ___CTOS_LONG_ERR ((3<<13)+(41<<7)) #define ___CTOS_ULONG_ERR ((3<<13)+(42<<7)) #define ___CTOS_FLOAT_ERR ((3<<13)+(43<<7)) #define ___CTOS_DOUBLE_ERR ((3<<13)+(44<<7)) #define ___CTOS_POINTER_ERR ((3<<13)+(45<<7)) #define ___CTOS_FUNCTION_ERR ((3<<13)+(46<<7)) #define ___CTOS_BOOL_ERR ((3<<13)+(47<<7)) #define ___CTOS_CHARSTRING_ERR ((3<<13)+(48<<7)) #define ___CTOS_LATIN1STRING_ERR ((3<<13)+(49<<7)) #define ___CTOS_UCS4STRING_ERR ((3<<13)+(50<<7)) #define ___CTOS_UCS2STRING_ERR ((3<<13)+(51<<7)) #define ___CTOS_UTF8STRING_ERR ((3<<13)+(52<<7)) #define ___CTOS_HEAP_OVERFLOW_ERR ((3<<13)+(53<<7)) #ifdef ___USE_SETJMP #define ___BEGIN_CATCH \ ___jmpbuf_struct ___jbuf, *___old_catcher = ___ps->catcher; \ ___ps->catcher = &___jbuf; ___err = ___SETJMP(___jbuf.buf); \ if (___err==___NO_ERR) { #define ___END_CATCH } ___ps->catcher = ___old_catcher; #define ___THROW(err)longjmp (___ps->catcher->buf, err) #else #define ___BEGIN_CATCH ___err = ___NO_ERR; try { #define ___END_CATCH } catch (int err) { ___err = err; } #define ___THROW(err)throw (err) #endif #define ___CLAM_CONV_ERROR if (___err>=___FIRST_C_CONV_ERR) {___ps->temp1=___LBL(0);___ps->temp2=___FIX(___err);___JUMPEXTPRM(___SET_NARGS(___NARGS),___ps->handler_clam_conv_error)} #define ___STOC(f,s,c,i)___err=___EXT(f)(s,c,i) #define ___CTOS(f,c,s,i)___err=___EXT(f)(c,s,i) #define ___IF_STOC(f,s,c,i)if ((___STOC(f,s,c,i))==___NO_ERR) #define ___IF_CTOS(f,c,s,i)if ((___CTOS(f,c,s,i))==___NO_ERR) #define ___BEGIN_CDEF_BODY #define ___END_CDEF_BODY #define ___BEGIN_CDEF_VOID ___processor_state ___ps=___PSTATE;___WORD ___marker;int ___err;if ((___err=___EXT(___make_cdef_stack_marker) (&___marker))==___NO_ERR) { #define ___CDEF_CALL_VOID(nargs,lbl)___err=___EXT(___call) (nargs,lbl); #define ___CDEF_SET_RESULT_VOID /* no result to set */ #define ___CDEF_ERROR_VOID(lbl) while (___err>=___FIRST_C_CONV_ERR) {___ps->temp1=___FIX(___err);___ps->temp2=lbl;___CDEF_CALL_VOID(0,___ps->handler_cdef_conv_error) #define ___END_CDEF_VOID } ___EXT(___kill_cdef_stack_marker) (___marker); } ___EXT(___propagate_error) (___err); #define ___BEGIN_CDEF_SCMOBJ ___processor_state ___ps=___PSTATE;___WORD ___marker;___WORD ___result;int ___err;if ((___err=___EXT(___make_cdef_stack_marker) (&___marker))==___NO_ERR) { #define ___CDEF_CALL_SCMOBJ(nargs,lbl)___err=___EXT(___call) (nargs,lbl); #define ___CDEF_SET_RESULT_SCMOBJ ___result = ___CDEF_RESULT; #define ___CDEF_ERROR_SCMOBJ(lbl) while (___err>=___FIRST_C_CONV_ERR) {___ps->temp1=___FIX(___err);___ps->temp2=lbl;___CDEF_CALL_SCMOBJ(0,___ps->handler_cdef_conv_error) #define ___END_CDEF_SCMOBJ } ___EXT(___kill_cdef_stack_marker) (___marker); } ___EXT(___propagate_error) (___err); #define ___BEGIN_CDEF(decl)___processor_state ___ps=___PSTATE;___WORD ___marker;decl;int ___err;if ((___err=___EXT(___make_cdef_stack_marker) (&___marker))==___NO_ERR) { #define ___CDEF_CALL(nargs,lbl)if ((___err=___EXT(___call) (nargs,lbl))==___NO_ERR) #define ___CDEF_SET_RESULT /* done in conversion function */ #define ___CDEF_ERROR(lbl) while (___err>=___FIRST_C_CONV_ERR) {___ps->temp1=___FIX(___err);___ps->temp2=lbl;___CDEF_CALL(0,___ps->handler_cdef_conv_error) #define ___END_CDEF } ___EXT(___kill_cdef_stack_marker) (___marker); } ___EXT(___propagate_error) (___err); #define ___BEGIN_CDEF_ARG(i,s)___WORD s; #define ___END_CDEF_ARG(i) #define ___BEGIN_CDEF_ARG_SCMOBJ(i) #define ___END_CDEF_ARG_SCMOBJ(i) #define ___CDEF_ARG(i,arg)___PSSTK(i)=arg; #define ___CDEF_RESULT ___PSR1 #define ___BEGIN_CDEF_SCMOBJ_TO_CHAR(s,c)___STOC(___scmobj_to_char,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_CHAR(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_SCHAR(s,c)___STOC(___scmobj_to_schar,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_SCHAR(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_UCHAR(s,c)___STOC(___scmobj_to_uchar,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_UCHAR(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_LATIN1(s,c)___STOC(___scmobj_to_latin1,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_LATIN1(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_UCS4(s,c)___STOC(___scmobj_to_ucs4,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_UCS4(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_UCS2(s,c)___STOC(___scmobj_to_ucs2,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_UCS2(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_SHORT(s,c)___STOC(___scmobj_to_short,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_SHORT(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_USHORT(s,c)___STOC(___scmobj_to_ushort,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_USHORT(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_INT(s,c)___STOC(___scmobj_to_int,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_INT(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_UINT(s,c)___STOC(___scmobj_to_uint,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_UINT(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_LONG(s,c)___STOC(___scmobj_to_long,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_LONG(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_ULONG(s,c)___STOC(___scmobj_to_ulong,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_ULONG(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_FLOAT(s,c)___STOC(___scmobj_to_float,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_FLOAT(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_DOUBLE(s,c)___STOC(___scmobj_to_double,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_DOUBLE(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_POINTER(s,c)___STOC(___scmobj_to_pointer,s,(void**)&c,0); #define ___END_CDEF_SCMOBJ_TO_POINTER(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_FUNCTION(s,c)___STOC(___scmobj_to_function,s,(void**)&c,0); #define ___END_CDEF_SCMOBJ_TO_FUNCTION(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_BOOL(s,c)___STOC(___scmobj_to_bool,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_BOOL(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_CHARSTRING(s,c)___STOC(___scmobj_to_charstring,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_CHARSTRING(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_LATIN1STRING(s,c)___STOC(___scmobj_to_latin1string,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_LATIN1STRING(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_UCS4STRING(s,c)___STOC(___scmobj_to_ucs4string,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_UCS4STRING(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_UCS2STRING(s,c)___STOC(___scmobj_to_ucs2string,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_UCS2STRING(s,c) #define ___BEGIN_CDEF_SCMOBJ_TO_UTF8STRING(s,c)___STOC(___scmobj_to_utf8string,s,&c,0); #define ___END_CDEF_SCMOBJ_TO_UTF8STRING(s,c) #define ___BEGIN_CDEF_CHAR_TO_SCMOBJ(c,s,i)___IF_CTOS(___char_to_scmobj,c,&s,i){ #define ___END_CDEF_CHAR_TO_SCMOBJ(c,s,i)} #define ___BEGIN_CDEF_SCHAR_TO_SCMOBJ(c,s,i)___IF_CTOS(___schar_to_scmobj,c,&s,i){ #define ___END_CDEF_SCHAR_TO_SCMOBJ(c,s,i)} #define ___BEGIN_CDEF_UCHAR_TO_SCMOBJ(c,s,i)___IF_CTOS(___uchar_to_scmobj,c,&s,i){ #define ___END_CDEF_UCHAR_TO_SCMOBJ(c,s,i)} #define ___BEGIN_CDEF_LATIN1_TO_SCMOBJ(c,s,i)___IF_CTOS(___latin1_to_scmobj,c,&s,i){ #define ___END_CDEF_LATIN1_TO_SCMOBJ(c,s,i)} #define ___BEGIN_CDEF_UCS4_TO_SCMOBJ(c,s,i)___IF_CTOS(___ucs4_to_scmobj,c,&s,i){ #define ___END_CDEF_UCS4_TO_SCMOBJ(c,s,i)} #define ___BEGIN_CDEF_UCS2_TO_SCMOBJ(c,s,i)___IF_CTOS(___ucs2_to_scmobj,c,&s,i){ #define ___END_CDEF_UCS2_TO_SCMOBJ(c,s,i)} #define ___BEGIN_CDEF_SHORT_TO_SCMOBJ(c,s,i)___IF_CTOS(___short_to_scmobj,c,&s,i){ #define ___END_CDEF_SHORT_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_USHORT_TO_SCMOBJ(c,s,i)___IF_CTOS(___ushort_to_scmobj,c,&s,i){ #define ___END_CDEF_USHORT_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_INT_TO_SCMOBJ(c,s,i)___IF_CTOS(___int_to_scmobj,c,&s,i){ #define ___END_CDEF_INT_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_UINT_TO_SCMOBJ(c,s,i)___IF_CTOS(___uint_to_scmobj,c,&s,i){ #define ___END_CDEF_UINT_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_LONG_TO_SCMOBJ(c,s,i)___IF_CTOS(___long_to_scmobj,c,&s,i){ #define ___END_CDEF_LONG_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_ULONG_TO_SCMOBJ(c,s,i)___IF_CTOS(___ulong_to_scmobj,c,&s,i){ #define ___END_CDEF_ULONG_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_FLOAT_TO_SCMOBJ(c,s,i)___IF_CTOS(___float_to_scmobj,c,&s,i){ #define ___END_CDEF_FLOAT_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_DOUBLE_TO_SCMOBJ(c,s,i)___IF_CTOS(___double_to_scmobj,c,&s,i){ #define ___END_CDEF_DOUBLE_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_POINTER_TO_SCMOBJ(c,s,i)___IF_CTOS(___pointer_to_scmobj,(void*)c,&s,i){ #define ___END_CDEF_POINTER_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_FUNCTION_TO_SCMOBJ(c,s,i)___IF_CTOS(___function_to_scmobj,(void*)c,&s,i){ #define ___END_CDEF_FUNCTION_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_BOOL_TO_SCMOBJ(c,s,i)___IF_CTOS(___bool_to_scmobj,c,&s,i){ #define ___END_CDEF_BOOL_TO_SCMOBJ(c,s,i)} #define ___BEGIN_CDEF_CHARSTRING_TO_SCMOBJ(c,s,i)___IF_CTOS(___charstring_to_scmobj,c,&s,i){ #define ___END_CDEF_CHARSTRING_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_LATIN1STRING_TO_SCMOBJ(c,s,i)___IF_CTOS(___latin1string_to_scmobj,c,&s,i){ #define ___END_CDEF_LATIN1STRING_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_UCS4STRING_TO_SCMOBJ(c,s,i)___IF_CTOS(___ucs4string_to_scmobj,c,&s,i){ #define ___END_CDEF_UCS4STRING_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_UCS2STRING_TO_SCMOBJ(c,s,i)___IF_CTOS(___ucs2string_to_scmobj,c,&s,i){ #define ___END_CDEF_UCS2STRING_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___BEGIN_CDEF_UTF8STRING_TO_SCMOBJ(c,s,i)___IF_CTOS(___utf8string_to_scmobj,c,&s,i){ #define ___END_CDEF_UTF8STRING_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);} #define ___RETURN_TO_C(n)___SET_R0(___LBL(n)) ___JUMPEXTPRM(___NOTHING,___ps->handler_return_to_c) #define ___BEGIN_CLAM_BODY #define ___END_CLAM_BODY ___AT_END #define ___BEGIN_CLAM_BODY_FREE ___W_ALL {___BEGIN_CATCH #define ___END_CLAM_BODY_FREE ___AT_END ___END_CATCH} ___R_ALL #define ___BEGIN_CLAM_VOID ___W_ALL {int ___err=___NO_ERR; #define ___CLAM_SET_RESULT_VOID ___CLAM_RESULT = ___VOID; #define ___CLAM_ERROR_VOID ___CLAM_CONV_ERROR #define ___CLAM_ERROR_FREE_VOID ___CLAM_CONV_ERROR ___EXT(___propagate_error) (___err); #define ___END_CLAM_VOID } ___R_ALL #define ___BEGIN_CLAM_SCMOBJ ___W_ALL {int ___err=___NO_ERR;___WORD ___result; #define ___CLAM_SET_RESULT_SCMOBJ ___CLAM_RESULT = ___result; #define ___CLAM_ERROR_SCMOBJ ___CLAM_CONV_ERROR #define ___CLAM_ERROR_FREE_SCMOBJ ___CLAM_CONV_ERROR ___EXT(___propagate_error) (___err); #define ___END_CLAM_SCMOBJ } ___R_ALL #define ___BEGIN_CLAM(decl)___W_ALL {int ___err=___NO_ERR;decl; #define ___CLAM_SET_RESULT /* done in conversion function */ #define ___CLAM_ERROR ___CLAM_CONV_ERROR #define ___CLAM_ERROR_FREE ___CLAM_CONV_ERROR ___EXT(___propagate_error) (___err); #define ___END_CLAM } ___R_ALL #define ___BEGIN_CLAM_ARG(i,decl)decl; #define ___END_CLAM_ARG(i) #define ___BEGIN_CLAM_ARG_SCMOBJ(i) #define ___END_CLAM_ARG_SCMOBJ(i) #define ___CLAM_ARG(i)___PSSTK((i-___NARGS-2)) #define ___CLAM_RESULT ___PSR1 #define ___BEGIN_CLAM_SCMOBJ_TO_CHAR(s,c,i)___IF_STOC(___scmobj_to_char,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_CHAR(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_SCHAR(s,c,i)___IF_STOC(___scmobj_to_schar,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_SCHAR(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_UCHAR(s,c,i)___IF_STOC(___scmobj_to_uchar,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_UCHAR(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_LATIN1(s,c,i)___IF_STOC(___scmobj_to_latin1,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_LATIN1(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_UCS4(s,c,i)___IF_STOC(___scmobj_to_ucs4,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_UCS4(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_UCS2(s,c,i)___IF_STOC(___scmobj_to_ucs2,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_UCS2(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_SHORT(s,c,i)___IF_STOC(___scmobj_to_short,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_SHORT(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_USHORT(s,c,i)___IF_STOC(___scmobj_to_ushort,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_USHORT(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_INT(s,c,i)___IF_STOC(___scmobj_to_int,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_INT(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_UINT(s,c,i)___IF_STOC(___scmobj_to_uint,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_UINT(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_LONG(s,c,i)___IF_STOC(___scmobj_to_long,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_LONG(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_ULONG(s,c,i)___IF_STOC(___scmobj_to_ulong,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_ULONG(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_FLOAT(s,c,i)___IF_STOC(___scmobj_to_float,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_FLOAT(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_DOUBLE(s,c,i)___IF_STOC(___scmobj_to_double,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_DOUBLE(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_POINTER(s,c,i)___IF_STOC(___scmobj_to_pointer,s,(void**)&c,i){ #define ___END_CLAM_SCMOBJ_TO_POINTER(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_FUNCTION(s,c,i)___IF_STOC(___scmobj_to_function,s,(void**)&c,i){ #define ___END_CLAM_SCMOBJ_TO_FUNCTION(s,c,i)___EXT(___free_function)(c);} #define ___BEGIN_CLAM_SCMOBJ_TO_BOOL(s,c,i)___IF_STOC(___scmobj_to_bool,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_BOOL(s,c,i)} #define ___BEGIN_CLAM_SCMOBJ_TO_CHARSTRING(s,c,i)___IF_STOC(___scmobj_to_charstring,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_CHARSTRING(s,c,i)___EXT(___free_string)(c);} #define ___BEGIN_CLAM_SCMOBJ_TO_LATIN1STRING(s,c,i)___IF_STOC(___scmobj_to_latin1string,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_LATIN1STRING(s,c,i)___EXT(___free_string)(c);} #define ___BEGIN_CLAM_SCMOBJ_TO_UCS4STRING(s,c,i)___IF_STOC(___scmobj_to_ucs4string,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_UCS4STRING(s,c,i)___EXT(___free_string)(c);} #define ___BEGIN_CLAM_SCMOBJ_TO_UCS2STRING(s,c,i)___IF_STOC(___scmobj_to_ucs2string,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_UCS2STRING(s,c,i)___EXT(___free_string)(c);} #define ___BEGIN_CLAM_SCMOBJ_TO_UTF8STRING(s,c,i)___IF_STOC(___scmobj_to_utf8string,s,&c,i){ #define ___END_CLAM_SCMOBJ_TO_UTF8STRING(s,c,i)___EXT(___free_string)(c);} #define ___BEGIN_CLAM_CHAR_TO_SCMOBJ(c,s)___CTOS(___char_to_scmobj,c,&s,0); #define ___END_CLAM_CHAR_TO_SCMOBJ(c,s) #define ___BEGIN_CLAM_SCHAR_TO_SCMOBJ(c,s)___CTOS(___schar_to_scmobj,c,&s,0); #define ___END_CLAM_SCHAR_TO_SCMOBJ(c,s) #define ___BEGIN_CLAM_UCHAR_TO_SCMOBJ(c,s)___CTOS(___uchar_to_scmobj,c,&s,0); #define ___END_CLAM_UCHAR_TO_SCMOBJ(c,s) #define ___BEGIN_CLAM_LATIN1_TO_SCMOBJ(c,s)___CTOS(___latin1_to_scmobj,c,&s,0); #define ___END_CLAM_LATIN1_TO_SCMOBJ(c,s) #define ___BEGIN_CLAM_UCS4_TO_SCMOBJ(c,s)___CTOS(___ucs4_to_scmobj,c,&s,0); #define ___END_CLAM_UCS4_TO_SCMOBJ(c,s) #define ___BEGIN_CLAM_UCS2_TO_SCMOBJ(c,s)___CTOS(___ucs2_to_scmobj,c,&s,0); #define ___END_CLAM_UCS2_TO_SCMOBJ(c,s) #define ___BEGIN_CLAM_SHORT_TO_SCMOBJ(c,s)___IF_CTOS(___short_to_scmobj,c,&s,0){ #define ___END_CLAM_SHORT_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_USHORT_TO_SCMOBJ(c,s)___IF_CTOS(___ushort_to_scmobj,c,&s,0){ #define ___END_CLAM_USHORT_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_INT_TO_SCMOBJ(c,s)___IF_CTOS(___int_to_scmobj,c,&s,0){ #define ___END_CLAM_INT_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_UINT_TO_SCMOBJ(c,s)___IF_CTOS(___uint_to_scmobj,c,&s,0){ #define ___END_CLAM_UINT_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_LONG_TO_SCMOBJ(c,s)___IF_CTOS(___long_to_scmobj,c,&s,0){ #define ___END_CLAM_LONG_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_ULONG_TO_SCMOBJ(c,s)___IF_CTOS(___ulong_to_scmobj,c,&s,0){ #define ___END_CLAM_ULONG_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_FLOAT_TO_SCMOBJ(c,s)___IF_CTOS(___float_to_scmobj,c,&s,0){ #define ___END_CLAM_FLOAT_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_DOUBLE_TO_SCMOBJ(c,s)___IF_CTOS(___double_to_scmobj,c,&s,0){ #define ___END_CLAM_DOUBLE_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_POINTER_TO_SCMOBJ(c,s)___IF_CTOS(___pointer_to_scmobj,(void**)c,&s,0){ #define ___END_CLAM_POINTER_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_FUNCTION_TO_SCMOBJ(c,s)___IF_CTOS(___function_to_scmobj,(void**)c,&s,0){ #define ___END_CLAM_FUNCTION_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_BOOL_TO_SCMOBJ(c,s)___CTOS(___bool_to_scmobj,c,&s,0); #define ___END_CLAM_BOOL_TO_SCMOBJ(c,s) #define ___BEGIN_CLAM_CHARSTRING_TO_SCMOBJ(c,s)___IF_CTOS(___charstring_to_scmobj,c,&s,0){ #define ___END_CLAM_CHARSTRING_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_LATIN1STRING_TO_SCMOBJ(c,s)___IF_CTOS(___latin1string_to_scmobj,c,&s,0){ #define ___END_CLAM_LATIN1STRING_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_UCS4STRING_TO_SCMOBJ(c,s)___IF_CTOS(___ucs4string_to_scmobj,c,&s,0){ #define ___END_CLAM_UCS4STRING_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_UCS2STRING_TO_SCMOBJ(c,s)___IF_CTOS(___ucs2string_to_scmobj,c,&s,0){ #define ___END_CLAM_UCS2STRING_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #define ___BEGIN_CLAM_UTF8STRING_TO_SCMOBJ(c,s)___IF_CTOS(___utf8string_to_scmobj,c,&s,0){ #define ___END_CLAM_UTF8STRING_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);} #endif /*---------------------------------------------------------------------------*/ #ifndef ___DEFINES_ONLY #ifdef _MSC_VER #ifdef ___DYNAMIC int _fltused; /* needed if floating-point used. */ #endif #endif #ifdef __BORLANDC__ #ifdef ___SHARED #define _RTLDLL #endif #endif #include #ifdef ___USE_SETJMP #include typedef struct ___jmpbuf_struct { jmp_buf buf; } ___jmpbuf_struct; #endif #ifndef ___U64 /* 64 bit unsigned integer structure */ typedef struct { #ifdef ___CPU_BIGEND ___U32 hi32, lo32; #else ___U32 lo32, hi32; #endif } ___U64; #endif /* Symbol/keyword structure */ typedef ___FAKEWORD ___symkey_struct[]; /* Global variable structure */ typedef struct ___glo_struct { ___WORD val, prm, next; } ___glo_struct; /* Processor structure */ typedef struct ___processor_state_struct { ___WORD *stack, *stack_base, *stack_limit, *stack_trip, *stack_break, *fp; ___WORD *heap, *heap_limit, *hp; ___WORD r[___NB_GVM_REGS], pc, temp1, temp2, temp3, temp4; int na, np; int intr_enabled, intr_flag[___NB_INTRS]; ___WORD glo_list_head, glo_list_tail; ___WORD handler_break, handler_stack_limit, handler_heap_limit, handler_not_proc, handler_not_proc_glo, handler_wrong_nargs, handler_get_rest, handler_get_key, handler_get_key_rest, handler_force, handler_clam_conv_error, handler_cdef_conv_error, handler_return_to_c, initial_continuation; ___WORD executable_wills, non_executable_wills; #ifdef ___USE_SETJMP ___jmpbuf_struct *catcher; #endif } ___processor_state_struct, *___processor_state; typedef ___WORD (*___host) ___P((___processor_state),()); typedef struct ___label_struct { ___WORD header, entry, flags; ___FAKEHOST host; } ___label_struct; /* Module structure */ typedef struct ___module_struct { int version; int kind; ___UTF8STRING name; ___FAKEWORD *glo_tbl; int glo_count; int sup_count; ___UTF8STRING *glo_names; ___FAKEWORD *sym_tbl; int sym_count; ___UTF8STRING *sym_names; ___FAKEWORD *key_tbl; int key_count; ___UTF8STRING *key_names; ___WORD *lp; ___label_struct *lbl_tbl; int lbl_count; ___WORD *cns_tbl; int cns_count; ___FAKEWORD *sub_tbl; int sub_count; void (*init_proc) ___PVOID; struct ___module_struct *next; } ___module_struct; /* Linkfile structure */ typedef struct ___linkfile_struct { int version; int kind; ___UTF8STRING name; ___FAKEWORD *sym_list; ___FAKEWORD *key_list; void **linker_tbl; } ___linkfile_struct; /* Module or linkfile structure */ typedef union { ___module_struct module; ___linkfile_struct linkfile; } *___mod_or_lnk; /* Global state structure */ typedef struct ___global_state_struct { ___processor_state_struct pstate; ___U64 nb_gcs, gc_user_nsecs, gc_sys_nsecs; ___U64 bytes_allocated_minus_occupied; #ifdef ___CANT_IMPORT_CLIB_DYNAMICALLY double (*fabs) ___P((double x),()); double (*floor) ___P((double x),()); double (*ceil) ___P((double x),()); double (*exp) ___P((double x),()); double (*log) ___P((double x),()); double (*sin) ___P((double x),()); double (*cos) ___P((double x),()); double (*tan) ___P((double x),()); double (*asin) ___P((double x),()); double (*acos) ___P((double x),()); double (*atan) ___P((double x),()); double (*atan2) ___P((double x, double y),()); double (*sqrt) ___P((double x),()); #endif #ifdef ___USE_SETJMP #ifdef ___CANT_IMPORT_SETJMP_DYNAMICALLY int (*setjmp) ___P((jmp_buf env),()); #endif #endif #ifdef ___CANT_IMPORT_DYNAMICALLY double (*___copysign) ___P((double x, double y),()); int (*___isfinite) ___P((double x),()); int (*___isnan) ___P((double x),()); double (*___round) ___P((double x),()); int (*___scmobj_to_char) ___P((___WORD obj, char *x, int arg_num),()); int (*___scmobj_to_schar) ___P((___WORD obj, ___SCHAR *x, int arg_num),()); int (*___scmobj_to_uchar) ___P((___WORD obj, unsigned char *x, int arg_num),()); int (*___scmobj_to_latin1) ___P((___WORD obj, ___LATIN1 *x, int arg_num),()); int (*___scmobj_to_ucs4) ___P((___WORD obj, ___UCS4 *x, int arg_num),()); int (*___scmobj_to_ucs2) ___P((___WORD obj, ___UCS2 *x, int arg_num),()); int (*___scmobj_to_short) ___P((___WORD obj, short *x, int arg_num),()); int (*___scmobj_to_ushort) ___P((___WORD obj, unsigned short *x, int arg_num),()); int (*___scmobj_to_int) ___P((___WORD obj, int *x, int arg_num),()); int (*___scmobj_to_uint) ___P((___WORD obj, unsigned int *x, int arg_num),()); int (*___scmobj_to_long) ___P((___WORD obj, long *x, int arg_num),()); int (*___scmobj_to_ulong) ___P((___WORD obj, unsigned long *x, int arg_num),()); int (*___scmobj_to_float) ___P((___WORD obj, float *x, int arg_num),()); int (*___scmobj_to_double) ___P((___WORD obj, double *x, int arg_num),()); int (*___scmobj_to_pointer) ___P((___WORD obj, void **x, int arg_num),()); int (*___scmobj_to_function) ___P((___WORD obj, void **x, int arg_num),()); int (*___scmobj_to_bool) ___P((___WORD obj, ___BOOL *x, int arg_num),()); int (*___scmobj_to_charstring) ___P((___WORD obj, char **x, int arg_num),()); int (*___scmobj_to_latin1string) ___P((___WORD obj, ___LATIN1STRING *x, int arg_num),()); int (*___scmobj_to_ucs4string) ___P((___WORD obj, ___UCS4STRING *x, int arg_num),()); int (*___scmobj_to_ucs2string) ___P((___WORD obj, ___UCS2STRING *x, int arg_num),()); int (*___scmobj_to_utf8string) ___P((___WORD obj, ___UTF8STRING *x, int arg_num),()); void (*___free_function) ___P((void *x),()); void (*___free_string) ___P((void *x),()); int (*___char_to_scmobj) ___P((char x, ___WORD *obj, int arg_num),()); int (*___schar_to_scmobj) ___P((___SCHAR x, ___WORD *obj, int arg_num),()); int (*___uchar_to_scmobj) ___P((unsigned char x, ___WORD *obj, int arg_num),()); int (*___latin1_to_scmobj) ___P((___LATIN1 x, ___WORD *obj, int arg_num),()); int (*___ucs4_to_scmobj) ___P((___UCS4 x, ___WORD *obj, int arg_num),()); int (*___ucs2_to_scmobj) ___P((___UCS2 x, ___WORD *obj, int arg_num),()); int (*___short_to_scmobj) ___P((short x, ___WORD *obj, int arg_num),()); int (*___ushort_to_scmobj) ___P((unsigned short x, ___WORD *obj, int arg_num),()); int (*___int_to_scmobj) ___P((int x, ___WORD *obj, int arg_num),()); int (*___uint_to_scmobj) ___P((unsigned int x, ___WORD *obj, int arg_num),()); int (*___long_to_scmobj) ___P((long x, ___WORD *obj, int arg_num),()); int (*___ulong_to_scmobj) ___P((unsigned long x, ___WORD *obj, int arg_num),()); int (*___float_to_scmobj) ___P((float x, ___WORD *obj, int arg_num),()); int (*___double_to_scmobj) ___P((double x, ___WORD *obj, int arg_num),()); int (*___pointer_to_scmobj) ___P((void *x, ___WORD *obj, int arg_num),()); int (*___function_to_scmobj) ___P((void *x, ___WORD *obj, int arg_num),()); int (*___bool_to_scmobj) ___P((___BOOL x, ___WORD *obj, int arg_num),()); int (*___charstring_to_scmobj) ___P((char *x, ___WORD *obj, int arg_num),()); int (*___latin1string_to_scmobj) ___P((___LATIN1STRING x, ___WORD *obj, int arg_num),()); int (*___ucs4string_to_scmobj) ___P((___UCS4STRING x, ___WORD *obj, int arg_num),()); int (*___ucs2string_to_scmobj) ___P((___UCS2STRING x, ___WORD *obj, int arg_num),()); int (*___utf8string_to_scmobj) ___P((___UTF8STRING x, ___WORD *obj, int arg_num),()); int (*___make_cdef_stack_marker) ___P((___WORD *marker),()); void (*___kill_cdef_stack_marker) ___P((___WORD marker),()); void (*___release_scmobj) ___P((___WORD obj),()); ___WORD (*___alloc_scmobj) ___P((unsigned int subtype, unsigned long bytes, unsigned int kind),()); ___WORD (*___make_pair) ___P((___WORD car, ___WORD cdr, unsigned int kind),()); ___WORD (*___make_vector) ___P((unsigned long length, ___WORD init, unsigned int kind),()); ___WORD (*___make_string) ___P((unsigned long length, char init, unsigned int kind),()); void (*___still_obj_refcount_inc) ___P((___WORD obj),()); void (*___still_obj_refcount_dec) ___P((___WORD obj),()); void (*___cleanup) ___PVOID; int (*___call) ___P((int nargs, ___WORD proc),()); void (*___propagate_error) ___P((int err),()); void (*___raise_interrupt) ___P((int code),()); #endif } ___global_state_struct; ___LOCAL ___WORD ___lp; /* Module's label table pointer */ ___GLO_DECL ___SYM_DECL ___KEY_DECL /* Setup parameters structure */ typedef struct ___setup_params_struct { int argc; char **argv; unsigned long stack_cache, min_heap, max_heap; int live_percent; long (*gc_hook) ___P((long avail, long live),()); void (*fatal_error) ___P((char *msg),()); int standard; int debug_level; int default_io_encoding; int force_tty; int force_unbuffered_io; ___mod_or_lnk (*linker) ___P((___global_state_struct*),()); } ___setup_params_struct; #endif #ifndef ___INCLUDED_FROM_C_INTF ___IMP_FUNC(int,___scmobj_to_char) ___P((___WORD obj, char *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_schar) ___P((___WORD obj, ___SCHAR *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_uchar) ___P((___WORD obj, unsigned char *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_latin1) ___P((___WORD obj, ___LATIN1 *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_ucs4) ___P((___WORD obj, ___UCS4 *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_ucs2) ___P((___WORD obj, ___UCS2 *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_short) ___P((___WORD obj, short *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_ushort) ___P((___WORD obj, unsigned short *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_int) ___P((___WORD obj, int *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_uint) ___P((___WORD obj, unsigned int *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_long) ___P((___WORD obj, long *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_ulong) ___P((___WORD obj, unsigned long *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_float) ___P((___WORD obj, float *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_double) ___P((___WORD obj, double *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_pointer) ___P((___WORD obj, void **x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_function) ___P((___WORD obj, void **x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_bool) ___P((___WORD obj, ___BOOL *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_charstring) ___P((___WORD obj, char **x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_latin1string) ___P((___WORD obj, ___LATIN1STRING *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_ucs4string) ___P((___WORD obj, ___UCS4STRING *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_ucs2string) ___P((___WORD obj, ___UCS2STRING *x, int arg_num),()); ___IMP_FUNC(int,___scmobj_to_utf8string) ___P((___WORD obj, ___UTF8STRING *x, int arg_num),()); ___IMP_FUNC(void,___free_function) ___P((void *x),()); ___IMP_FUNC(void,___free_string) ___P((void *x),()); ___IMP_FUNC(int,___char_to_scmobj) ___P((char x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___schar_to_scmobj) ___P((___SCHAR x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___uchar_to_scmobj) ___P((unsigned char x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___latin1_to_scmobj) ___P((___LATIN1 x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___ucs4_to_scmobj) ___P((___UCS4 x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___ucs2_to_scmobj) ___P((___UCS2 x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___short_to_scmobj) ___P((short x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___ushort_to_scmobj) ___P((unsigned short x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___int_to_scmobj) ___P((int x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___uint_to_scmobj) ___P((unsigned int x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___long_to_scmobj) ___P((long x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___ulong_to_scmobj) ___P((unsigned long x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___float_to_scmobj) ___P((float x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___double_to_scmobj) ___P((double x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___pointer_to_scmobj) ___P((void *x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___function_to_scmobj) ___P((void *x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___bool_to_scmobj) ___P((___BOOL x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___charstring_to_scmobj) ___P((char *x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___latin1string_to_scmobj) ___P((___LATIN1STRING x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___ucs4string_to_scmobj) ___P((___UCS4STRING x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___ucs2string_to_scmobj) ___P((___UCS2STRING x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___utf8string_to_scmobj) ___P((___UTF8STRING x, ___WORD *obj, int arg_num),()); ___IMP_FUNC(int,___make_cdef_stack_marker) ___P((___WORD *marker),()); ___IMP_FUNC(void,___kill_cdef_stack_marker) ___P((___WORD marker),()); ___IMP_FUNC(void,___release_scmobj) ___P((___WORD obj),()); #endif #ifndef ___INCLUDED_FROM_MEM ___IMP_FUNC(___WORD,___alloc_scmobj) ___P((unsigned int subtype, unsigned long bytes, unsigned int kind),()); ___IMP_FUNC(___WORD,___make_pair) ___P((___WORD car, ___WORD cdr, unsigned int kind),()); ___IMP_FUNC(___WORD,___make_vector) ___P((unsigned long length, ___WORD init, unsigned int kind),()); ___IMP_FUNC(___WORD,___make_string) ___P((unsigned long length, char init, unsigned int kind),()); ___IMP_FUNC(void,___still_obj_refcount_inc) ___P((___WORD obj),()); ___IMP_FUNC(void,___still_obj_refcount_dec) ___P((___WORD obj),()); #endif #ifndef ___INCLUDED_FROM_SETUP ___GSTATE_DECL ___IMP_FUNC(double,___copysign) ___P((double x, double y),()); ___IMP_FUNC(int,___isfinite) ___P((double x),()); ___IMP_FUNC(int,___isnan) ___P((double x),()); ___IMP_FUNC(double,___round) ___P((double x),()); ___IMP_FUNC(void,___setup) ___P((struct ___setup_params_struct *setup_params),()); ___IMP_FUNC(void,___cleanup) ___PVOID; ___IMP_FUNC(int,___call) ___P((int nargs, ___WORD proc),()); ___IMP_FUNC(void,___propagate_error) ___P((int err),()); ___IMP_FUNC(void,___raise_interrupt) ___P((int code),()); #endif gambc30/lib/header.scm 644 541 730 123000 6522511347 10110 ;============================================================================== ; file: "header.scm" ; Copyright (C) 1994-1998 by Marc Feeley, All Rights Reserved. (##namespace ("" not boolean? eqv? eq? equal? pair? cons car cdr set-car! set-cdr! caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr null? list? list length append reverse list-ref memq memv member assq assv assoc symbol? symbol->string string->symbol number? complex? real? rational? integer? exact? inexact? = < > <= >= zero? positive? negative? odd? even? max min + * - / abs quotient remainder modulo gcd lcm numerator denominator floor ceiling truncate round rationalize exp log sin cos tan asin acos atan sqrt expt make-rectangular make-polar real-part imag-part magnitude angle exact->inexact inexact->exact number->string string->number char? char=? char? char<=? char>=? char-ci=? char-ci? char-ci<=? char-ci>=? char-alphabetic? char-numeric? char-whitespace? char-upper-case? char-lower-case? char->integer integer->char char-upcase char-downcase string? make-string string string-length string-ref string-set! string=? string? string<=? string>=? string-ci=? string-ci? string-ci<=? string-ci>=? substring string-append vector? make-vector vector vector-length vector-ref vector-set! procedure? apply map for-each call-with-current-continuation call-with-input-file call-with-output-file input-port? output-port? current-input-port current-output-port open-input-file open-output-file close-input-port close-output-port eof-object? read read-char peek-char write display newline write-char eval error pp compile-file-to-c compile-file link-incremental link-flat script-arguments )) (##declare (multilisp) (extended-bindings) (not safe) (block) (fixnum) (inlining-limit 134) ) ;------------------------------------------------------------------------------ ; Type tags (##define-macro (type-fixnum) 0) (##define-macro (type-subtyped) 1) (##define-macro (type-special) 2) (##define-macro (type-pair) 3) ; Subtype tags (##define-macro (subtype-vector) 0) (##define-macro (subtype-pair) 1) (##define-macro (subtype-ratnum) 2) (##define-macro (subtype-cpxnum) 3) (##define-macro (subtype-structure) 4) (##define-macro (subtype-meroon) 6) (##define-macro (subtype-symbol) 8) (##define-macro (subtype-keyword) 9) (##define-macro (subtype-frame) 10) (##define-macro (subtype-continuation) 11) (##define-macro (subtype-promise) 12) (##define-macro (subtype-procedure) 13) (##define-macro (subtype-will) 14) (##define-macro (subtype-string) 16) (##define-macro (subtype-bignum) 17) (##define-macro (subtype-u8vector) 25) (##define-macro (subtype-u16vector) 26) (##define-macro (subtype-u32vector) 27) (##define-macro (subtype-f32vector) 28) (##define-macro (subtype-f64vector) 29) ; for alignment these 3 must be last (##define-macro (subtype-flonum) 30) (##define-macro (subtype-pointer) 31) (##define-macro (subtype-ovector? x) `(##fixnum.< ,x 8)) (##define-macro (subtype-bvector? x) `(##fixnum.< 15 ,x)) ; Special objects (##define-macro (absent-obj) (##namespace ("c#" absent-object)) `',absent-object) ; Bignum related constants (##define-macro (max-fixnum32) 536870911) (##define-macro (min-fixnum32) -536870912) (##define-macro (radix) 16384) ; must be <=sqrt(max fixnum)+1 (##define-macro (radix-width) 14) (##define-macro (radix-minus-1) 16383) (##define-macro (minus-radix) -16384) (##define-macro (max-fixnum32-div-radix) 32767) ; truncate(max fixnum / radix) (##define-macro (min-fixnum32-div-radix) -32768) ; truncate(min fixnum / radix) (##define-macro (max-digits-for-fixnum32) 3) ; bignum if > this many digits (##define-macro (max-length-for-64bit) 6) ; 1+ceiling(64 / radix-width) (##define-macro (radix-log-den) 32) (##define-macro (r.2) 16384) (##define-macro (r-log-rad.2) 14) (##define-macro (radix-log-r-num.2) 32) (##define-macro (r.8) 4096) (##define-macro (r-log-rad.8) 4) (##define-macro (radix-log-r-num.8) 38) (##define-macro (r.10) 10000) (##define-macro (r-log-rad.10) 4) (##define-macro (radix-log-r-num.10) 34) (##define-macro (r.16) 4096) (##define-macro (r-log-rad.16) 3) (##define-macro (radix-log-r-num.16) 38) (##define-macro (max-lines) 65536) (##define-macro (max-fixnum32-div-max-lines) 8191) ; Flonum related constants (##define-macro (flonum-m-bits) 52) (##define-macro (flonum-m-bits-plus-1) 53) (##define-macro (flonum-e-bits) 11) (##define-macro (flonum-sign-bit) #x8000000000000000) ; (expt 2 (+ (flonum-e-bits) (flonum-m-bits))) (##define-macro (flonum-m-min) 4503599627370496.0) ; (expt 2.0 (flonum-m-bits)) (##define-macro (flonum-+m-min) 4503599627370496) ; (expt 2 (flonum-m-bits)) (##define-macro (flonum-+m-max) 9007199254740991) ; (- (* flonum-+m-min 2) 1) (##define-macro (flonum--m-min) -4503599627370496) ; (- (flonum-+m-min)) (##define-macro (flonum--m-max) -9007199254740991) ; (- (flonum-+m-max)) (##define-macro (flonum-e-bias) 1023) ; (- (expt 2 (- (flonum-e-bits) 1)) 1) (##define-macro (flonum-e-bias-plus-1) 1024) ; (+ (flonum-e-bias) 1) (##define-macro (flonum-e-bias-minus-1) 1022) ; (- (flonum-e-bias) 1) (##define-macro (flonum-e-min) -1074) ; (- (+ (flonum-e-bias) (flonum-m-bits) -1)) (##define-macro (flonum-max-digits) 17) (##define-macro (inexact-radix) 16384.0) ; (exact->inexact (radix)) ; Dispatch for number representation (##define-macro (number-dispatch num err fix big rat flo cpx) `(cond ((##fixnum? ,num) ,fix) ((##flonum? ,num) ,flo) ((##subtyped? ,num) (let ((##s (##subtype ,num))) (cond ((##fixnum.= ##s (subtype-bignum)) ,big) ((##fixnum.= ##s (subtype-ratnum)) ,rat) ((##fixnum.= ##s (subtype-cpxnum)) ,cpx) (else ,err)))) (else ,err))) ; System procedure classes (##define-macro (define-system form . exprs) (define inlinable-procs '( ##type ##type-cast ##subtype ##subtype-set! ##not ##null? ##unbound? ##eq? ##eof-object? ##fixnum? ##flonum? ##special? ##pair? ##subtyped? ##procedure? ##promise? ##vector? ##symbol? ##keyword? ##ratnum? ##cpxnum? ##string? ##structure? ##bignum? ##char? ;;;; ##closure? ##subprocedure? ##fixnum.max ##fixnum.min ##fixnum.+ ##fixnum.- ##fixnum.* ##fixnum.quotient ##fixnum.remainder ##fixnum.modulo ##fixnum.logior ##fixnum.logxor ##fixnum.logand ##fixnum.lognot ##fixnum.ashr ##fixnum.lshr ##fixnum.shl ##fixnum.zero? ##fixnum.positive? ##fixnum.negative? ##fixnum.odd? ##fixnum.even? ##fixnum.= ##fixnum.< ##fixnum.> ##fixnum.<= ##fixnum.>= ##fixnum.->char ##fixnum.<-char ##flonum.->fixnum ##flonum.<-fixnum ##flonum.max ##flonum.min ##flonum.+ ##flonum.- ##flonum.* ##flonum./ ##flonum.abs ##flonum.floor ##flonum.ceiling ##flonum.round ##flonum.exp ##flonum.log ##flonum.sin ##flonum.cos ##flonum.tan ##flonum.asin ##flonum.acos ##flonum.atan ##flonum.sqrt ##flonum.copysign ##flonum.zero? ##flonum.positive? ##flonum.negative? ##flonum.finite? ##flonum.nan? ##flonum.= ##flonum.< ##flonum.> ##flonum.<= ##flonum.>= ##char=? ##char? ##char<=? ##char>=? ##cons ##set-car! ##set-cdr! ##car ##cdr ##caar ##cadr ##cdar ##cddr ##caaar ##caadr ##cadar ##caddr ##cdaar ##cdadr ##cddar ##cdddr ##caaaar ##caaadr ##caadar ##caaddr ##cadaar ##cadadr ##caddar ##cadddr ##cdaaar ##cdaadr ##cdadar ##cdaddr ##cddaar ##cddadr ##cdddar ##cddddr ##list ##make-cell ##cell-ref ##cell-set! ##vector ##vector-length ##vector-ref ##vector-set! ##vector-shrink! ##string ##string-length ##string-ref ##string-set! ##string-shrink! ##u8vector? ##u8vector ##u8vector-length ##u8vector-ref ##u8vector-set! ##u8vector-shrink! ##u16vector? ##u16vector ##u16vector-length ##u16vector-ref ##u16vector-set! ##u16vector-shrink! ##u32vector? ##u32vector ##u32vector-length ##u32vector-ref ##u32vector-set! ##u32vector-shrink! ##f32vector? ##f32vector ##f32vector-length ##f32vector-ref ##f32vector-set! ##f32vector-shrink! ##f64vector? ##f64vector ##f64vector-length ##f64vector-ref ##f64vector-set! ##f64vector-shrink! ##symbol->string ##keyword->string ##closure-code ##closure-ref ##closure-set! ;;; ##subprocedure-id ##subprocedure-parent ;;; ##procedure-info ##make-promise ##force ##void ##will? ##make-will ##will-owner ##global-var-ref ##global-var-set! )) (define kernel-procs '( ##make-string ##make-vector ##make-u8vector ##make-u16vector ##make-u32vector ##make-f32vector ##make-f64vector ##apply ##call-with-current-continuation ##make-global-var ##closure? ##subprocedure? ##subprocedure-id ##subprocedure-parent ##procedure-info )) (if (memq (car form) kernel-procs) `(begin) (if (and (memq (car form) inlinable-procs) (list? (cdr form))) `(define ,form ,form) `(define ,form ,@exprs)))) ;------------------------------------------------------------------------------ ; Object representation: ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Numbers ; There are 5 internal representations for numbers: ; ; fixnum, bignum, ratnum, flonum, cpxnum ; ; Fixnums and bignums form the class of exact-int. ; Fixnums, bignums and ratnums form the class of exact-real. ; Fixnums, bignums, ratnums and flonums form the class of non-cpxnum. ; The representation has some invariants: ; ; The numerator of a ratnum is a non-zero exact-int. ; The denominator of a ratnum is an exact-int greater than 1. ; The numerator and denominator have no common divisors greater than 1. ; ; The real part of a cpxnum is a non-cpxnum. ; The imaginary part of a cpxnum is a non-cpxnum != fixnum 0 ; The following table gives the mapping of the Scheme exact numbers to their ; internal representation: ; ; type representation ; exact integer = exact-int (fixnum, bignum) ; exact rational = exact-real (fixnum, bignum, ratnum) ; exact real = exact-real (fixnum, bignum, ratnum) ; exact complex = exact-real or cpxnum with exact-real real and imag parts ; For inexact numbers, the representation is not quite as straightforward. ; ; There are 3 "special" classes of inexact representation: ; flonum-int : flonum with integer value ; cpxnum-real: cpxnum with imag part = flonum 0.0 ; cpxnum-int : cpxnum-real with exact-int or flonum-int real part ; ; This gives the following table for Scheme's inexact numbers: ; ; type representation ; inexact integer = flonum-int or cpxnum-int ; inexact rational = flonum or cpxnum-real ; inexact real = flonum or cpxnum-real ; inexact complex = flonum or cpxnum (##define-macro (exact-int? x) ; x can be any object `(or (##fixnum? ,x) (##bignum? ,x))) (##define-macro (exact-real? x) ; x can be any object `(or (exact-int? ,x) (##ratnum? ,x))) (##define-macro (flonum-int? x) ; x must be a flonum `(and (##flonum.finite? ,x) (##flonum.= ,x (##flonum.floor ,x)))) (##define-macro (flonum-rational? x) ; x must be a flonum `(##flonum.finite? ,x)) (##define-macro (non-cpxnum-int? x) ; x must be in fixnum/bignum/ratnum/flonum `(if (##flonum? ,x) (flonum-int? ,x) (##not (##ratnum? ,x)))) (##define-macro (non-cpxnum-rational? x) ; x must be in fixnum/bignum/ratnum/flonum `(or (##not (##flonum? ,x)) (flonum-rational? ,x))) (##define-macro (cpxnum-int? x) ; x must be a cpxnum `(and (cpxnum-real? ,x) (let ((real (cpxnum-real ,x))) (non-cpxnum-int? real)))) (##define-macro (cpxnum-rational? x) ; x must be a cpxnum `(let ((imag (cpxnum-imag ,x))) (and (##flonum? imag) (##flonum.zero? imag) (let ((real (cpxnum-real ,x))) (non-cpxnum-rational? real))))) (##define-macro (cpxnum-real? x) ; x must be a cpxnum `(let ((imag (cpxnum-imag ,x))) (and (##flonum? imag) (##flonum.zero? imag)))) (##define-macro (inexact-+2) 2.0) (##define-macro (inexact--2) -2.0) (##define-macro (inexact-+1) 1.0) (##define-macro (inexact--1) -1.0) (##define-macro (inexact-+1/2) 0.5) (##define-macro (inexact-0) 0.0) (##define-macro (inexact-+pi) 3.141592653589793) (##define-macro (inexact--pi) -3.141592653589793) (##define-macro (inexact-+pi/2) 1.5707963267948966) (##define-macro (inexact--pi/2) -1.5707963267948966) (##define-macro (inexact-+inf) ''+inf.) (##define-macro (inexact--inf) ''-inf.) (##define-macro (inexact-+nan) ''+nan.) (##define-macro (cpxnum-+2i) +2i) (##define-macro (cpxnum--i) -i) (##define-macro (cpxnum-+i) +i) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Symbol objects ; A symbol is represented by an object vector of length 3 ; slot 0 = symbol name (string or symbol) ; slot 1 = hash code (#f or non-negative fixnum) ; slot 2 = pointer to corresponding global variable (0 if none exists) (##define-macro (symbol-name s) `(##vector-ref ,s 0)) (##define-macro (symbol-name-set! s x) `(##vector-set! ,s 0 ,x)) (##define-macro (symbol-hash s) `(##vector-ref ,s 1)) (##define-macro (symbol-hash-set! s x) `(##vector-set! ,s 1 ,x)) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Keyword objects ; A keyword is represented by an object vector of length 2 ; slot 0 = symbol name (string or symbol) not including trailing ':' ; slot 1 = hash code (#f or non-negative fixnum) (##define-macro (keyword-name k) `(##vector-ref ,k 0)) (##define-macro (keyword-name-set! k x) `(##vector-set! ,k 0 ,x)) (##define-macro (keyword-hash k) `(##vector-ref ,k 1)) (##define-macro (keyword-hash-set! k x) `(##vector-set! ,k 1 ,x)) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Bignum objects ; A bignum is represented by a word vector ; slot 0 = sign ; slot 1 = least significant digit ; slot 2... = other digits (##define-macro (bignum-make n) `(##subtype-set! (##make-u16vector ,n 0) (subtype-bignum))) (##define-macro (bignum-length x) `(##u16vector-length ,x)) (##define-macro (bignum-shrink! x n) `(##u16vector-shrink! ,x ,n)) (##define-macro (bignum-digit-ref x i) `(##u16vector-ref ,x ,i)) (##define-macro (bignum-digit-set! x i y) `(##u16vector-set! ,x ,i ,y)) (##define-macro (bignum-sign x) `(##u16vector-ref ,x 0)) (##define-macro (bignum-sign* x) `(##fixnum.- 1 (##u16vector-ref ,x 0))) (##define-macro (bignum-sign-set! x n) `(##u16vector-set! ,x 0 ,n)) (##define-macro (bignum-set-negative! x) `(##u16vector-set! ,x 0 0)) (##define-macro (bignum-negative? x) `(##eq? (##u16vector-ref ,x 0) 0)) (##define-macro (bignum-set-positive! x) `(##u16vector-set! ,x 0 1)) (##define-macro (bignum-positive? x) `(##eq? (##u16vector-ref ,x 0) 1)) (##define-macro (bignum-zero? x) `(##eq? (##u16vector-length ,x) 1)) (##define-macro (bignum-odd? x) `(##fixnum.odd? (##u16vector-ref ,x 1))) (##define-macro (bignum-even? x) `(##fixnum.even? (##u16vector-ref ,x 1))) (##define-macro (bignum-constants) ; create these constants at compile time! (##namespace ("c#" make-u16vect u16vect-set!)) (let ((v (make-vector 33 #f))) (let loop ((i 0) (n -16)) (if (< n 17) (begin (if (= n 0) (let ((b (make-u16vect 1))) (u16vect-set! b 0 1) (vector-set! v i b)) (let ((b (make-u16vect 2))) (u16vect-set! b 0 (if (< n 0) 0 1)) (u16vect-set! b 1 (if (< n 0) (- n) n)) (vector-set! v i b))) (loop (+ i 1) (+ n 1))))) `',v)) (##define-macro (10^-constants) ; create these constants at compile time! (define n 326) (let ((v (make-vector n #f))) (let loop ((i 0) (x 1)) (if (< i n) (begin (vector-set! v i x) (loop (+ i 1) (* x 10))))) `',v)) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Ratnum objects ; A ratnum is represented by an object vector of length 2 ; slot 0 = numerator ; slot 1 = denominator (##define-macro (ratnum-make num den) `(##subtype-set! (##vector ,num ,den) (subtype-ratnum))) (##define-macro (ratnum-numerator x) `(##vector-ref ,x 0)) (##define-macro (ratnum-denominator x) `(##vector-ref ,x 1)) ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ; Cpxnum objects ; A cpxnum is represented by an object vector of length 2 ; slot 0 = real ; slot 1 = imag (##define-macro (cpxnum-make r i) `(##subtype-set! (##vector ,r ,i) (subtype-cpxnum))) (##define-macro (cpxnum-real x) `(##vector-ref ,x 0)) (##define-macro (cpxnum-imag x) `(##vector-ref ,x 1)) ;------------------------------------------------------------------------------ (##define-macro (if-forces forces noforces) (if (memq 'force ##compilation-options) forces noforces)) (##define-macro (force-vars vars expr) (if (memq 'force ##compilation-options) `(let ,(map (lambda (x) `(,x (##force ,x))) vars) ,expr) expr)) (##define-macro (if-checks checks nochecks) (if (memq 'check ##compilation-options) checks nochecks)) (##define-macro (no-force vars expr) expr) (##define-macro (no-check var form expr) expr) (##define-macro (trap-list-lengths form) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) (if (list? form) `(##trap-list-lengths ',(car form) ,@(cdr form)) `(##trap-list-lengths* ',(car form) ,@(flat (cdr form))))) (##define-macro (trap-list form) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) (if (list? form) `(##trap-list ',(car form) ,@(cdr form)) `(##trap-list* ',(car form) ,@(flat (cdr form))))) (##define-macro (trap-open-file form) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) (if (list? form) `(##trap-open-file ',(car form) ,@(cdr form)) `(##trap-open-file* ',(car form) ,@(flat (cdr form))))) (##define-macro (trap-open-pipe form) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) (if (list? form) `(##trap-open-pipe ',(car form) ,@(cdr form)) `(##trap-open-pipe* ',(car form) ,@(flat (cdr form))))) (##define-macro (trap-load form msg) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) (if (list? form) `(##trap-load ,msg ',(car form) ,@(cdr form)) `(##trap-load* ,msg ',(car form) ,@(flat (cdr form))))) (##define-macro (trap-no-transcript form) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) (if (list? form) `(##trap-no-transcript ',(car form) ,@(cdr form)) `(##trap-no-transcript* ',(car form) ,@(flat (cdr form))))) (##define-macro (check-pair var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##pair? ,var) ,expr ,(if (list? form) `(##trap-check-pair ',(car form) ,@(cdr form)) `(##trap-check-pair* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-list-end var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##null? ,var) ,expr ,(if (list? form) `(##trap-list ',(car form) ,@(cdr form)) `(##trap-list* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-will var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##will? ,var) ,expr ,(if (list? form) `(##trap-check-will ',(car form) ,@(cdr form)) `(##trap-check-will* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-char var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##char? ,var) ,expr ,(if (list? form) `(##trap-check-char ',(car form) ,@(cdr form)) `(##trap-check-char* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-symbol var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##symbol? ,var) ,expr ,(if (list? form) `(##trap-check-symbol ',(car form) ,@(cdr form)) `(##trap-check-symbol* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-keyword var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##keyword? ,var) ,expr ,(if (list? form) `(##trap-check-keyword ',(car form) ,@(cdr form)) `(##trap-check-keyword* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-string var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##string? ,var) ,expr ,(if (list? form) `(##trap-check-string ',(car form) ,@(cdr form)) `(##trap-check-string* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-vector var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##vector? ,var) ,expr ,(if (list? form) `(##trap-check-vector ',(car form) ,@(cdr form)) `(##trap-check-vector* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-u8vector var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##u8vector? ,var) ,expr ,(if (list? form) `(##trap-check-u8vector ',(car form) ,@(cdr form)) `(##trap-check-u8vector* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-u16vector var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##u16vector? ,var) ,expr ,(if (list? form) `(##trap-check-u16vector ',(car form) ,@(cdr form)) `(##trap-check-u16vector* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-u32vector var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##u32vector? ,var) ,expr ,(if (list? form) `(##trap-check-u32vector ',(car form) ,@(cdr form)) `(##trap-check-u32vector* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-f32vector var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##f32vector? ,var) ,expr ,(if (list? form) `(##trap-check-f32vector ',(car form) ,@(cdr form)) `(##trap-check-f32vector* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-f64vector var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##f64vector? ,var) ,expr ,(if (list? form) `(##trap-check-f64vector ',(car form) ,@(cdr form)) `(##trap-check-f64vector* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-procedure var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##procedure? ,var) ,expr ,(if (list? form) `(##trap-check-procedure ',(car form) ,@(cdr form)) `(##trap-check-procedure* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-input-port var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (and (##port? ,var) (##input-port? ,var)) ,expr ,(if (list? form) `(##trap-check-input-port ',(car form) ,@(cdr form)) `(##trap-check-input-port* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-output-port var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (and (##port? ,var) (##output-port? ,var)) ,expr ,(if (list? form) `(##trap-check-output-port ',(car form) ,@(cdr form)) `(##trap-check-output-port* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-open-port var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##open-port? ,var) ,expr ,(if (list? form) `(##trap-check-open-port ',(car form) ,@(cdr form)) `(##trap-check-open-port* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-readtable var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##readtable? ,var) ,expr ,(if (list? form) `(##trap-check-readtable ',(car form) ,@(cdr form)) `(##trap-check-readtable* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (check-exact-int-non-neg var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##fixnum? ,var) (if (##not (##fixnum.< ,var 0)) ,expr ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form))))) (if (##bignum? ,var) ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form)))) ,(if (list? form) `(##trap-check-exact-int ',(car form) ,@(cdr form)) `(##trap-check-exact-int* ',(car form) ,@(flat (cdr form)))))) ,expr)) (##define-macro (check-exact-int-range var lo hi form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##fixnum? ,var) (if (and (##not (##fixnum.< ,var ,lo)) (##fixnum.< ,var ,hi)) ,expr ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form))))) (if (##bignum? ,var) ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form)))) ,(if (list? form) `(##trap-check-exact-int ',(car form) ,@(cdr form)) `(##trap-check-exact-int* ',(car form) ,@(flat (cdr form)))))) ,expr)) (##define-macro (check-exact-int-range-incl var lo hi form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##fixnum? ,var) (if (and (##not (##fixnum.< ,var ,lo)) (##not (##fixnum.< ,hi ,var))) ,expr ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form))))) (if (##bignum? ,var) ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form)))) ,(if (list? form) `(##trap-check-exact-int ',(car form) ,@(cdr form)) `(##trap-check-exact-int* ',(car form) ,@(flat (cdr form)))))) ,expr)) (##define-macro (check-exact-int8 var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##fixnum? ,var) (if (and (##not (##fixnum.< ,var -128)) (##not (##fixnum.< 255 ,var))) ,expr ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form))))) (if (##bignum? ,var) ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form)))) ,(if (list? form) `(##trap-check-exact-int ',(car form) ,@(cdr form)) `(##trap-check-exact-int* ',(car form) ,@(flat (cdr form)))))) ,expr)) (##define-macro (check-exact-int16 var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##fixnum? ,var) (if (and (##not (##fixnum.< ,var -32768)) (##not (##fixnum.< 65535 ,var))) ,expr ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form))))) (if (##bignum? ,var) ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form)))) ,(if (list? form) `(##trap-check-exact-int ',(car form) ,@(cdr form)) `(##trap-check-exact-int* ',(car form) ,@(flat (cdr form)))))) ,expr)) (##define-macro (check-exact-int32 var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (or (##fixnum? ,var) (##bignum? ,var)) (if (and (##not (##< ,var -2147483648)) (##not (##< 4294967295 ,var))) ,expr ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form))))) (if (##bignum? ,var) ,(if (list? form) `(##trap-check-range ',(car form) ,@(cdr form)) `(##trap-check-range* ',(car form) ,@(flat (cdr form)))) ,(if (list? form) `(##trap-check-exact-int ',(car form) ,@(cdr form)) `(##trap-check-exact-int* ',(car form) ,@(flat (cdr form)))))) ,expr)) (##define-macro (check-inexact-real var form expr) (define (flat x) (if (pair? x) (cons (car x) (flat (cdr x))) (list x))) `(if-checks (if (##flonum? ,var) ,expr ,(if (list? form) `(##trap-check-inexact-real ',(car form) ,@(cdr form)) `(##trap-check-inexact-real* ',(car form) ,@(flat (cdr form))))) ,expr)) (##define-macro (define-fold bool? form zero one two forcing pre-check . post-checks) (let* ((name-fn (car form)) (name-param1 (cadr form)) (name-param2 (caddr form)) (name-others 'others) (name-result 'result) (name-folded-result 'folded-result) (param-name-map (list (cons name-param1 'param1) (cons name-param2 'param2))) (two-wrap (if (pair? (cadr two)) (car two) #f)) (two-call (if (pair? (cadr two)) (cadr two) two))) (define (param-name sym) (cdr (assq sym param-name-map))) (define (rewrite expr) (let ((x (assq expr param-name-map))) (if x (cdr x) (if (pair? expr) (cons (car expr) (map rewrite (cdr expr))) expr)))) (define (parameter-list) (if (null? zero) ; 1 or more arguments (list (param-name name-param1) '#!optional (list (param-name name-param2) '(absent-obj)) '#!rest name-others) ; 0 or more arguments (list '#!optional (list (param-name name-param1) '(absent-obj)) (list (param-name name-param2) '(absent-obj)) '#!rest name-others))) (define (add-post-checks wrap expr cont) (define (add-wrap x) (if wrap (list wrap x) x)) (define (inside lst) (if (null? lst) (if cont (cont (add-wrap name-result)) (add-wrap name-result)) (let ((check (car lst))) (list 'if (list (car check) name-result) (list (cadr check) (list 'quote name-fn) (param-name name-param1) (param-name name-param2) name-others) (inside (cdr lst)))))) (if (or cont (not (null? post-checks))) (list 'let (list (list name-result expr)) (inside post-checks)) (add-wrap expr))) (define (add-forcing names expr) (list forcing names expr)) (define (add-pre-check name expr) (list pre-check name (cons name-fn (cons (param-name name-param1) (cons (param-name name-param2) name-others))) expr)) (define (exactly-1-arg) (add-forcing (list (param-name name-param1)) (add-pre-check (param-name name-param1) (if (pair? one) (add-post-checks #f (rewrite one) #f) (rewrite one))))) (define (exactly-2-args) (add-post-checks two-wrap (rewrite two-call) #f)) (define (at-least-2-args) (list 'let 'loop (append (if bool? (list (list name-folded-result #t)) '()) (list (list name-param1 (param-name name-param1)) (list name-param2 (param-name name-param2)) (list 'lst name-others))) (add-post-checks two-wrap two-call (lambda (result) (list 'if '(##null? lst) (if bool? (list 'and result name-folded-result) result) (list 'let '((next (##car lst))) (add-forcing '(next) (add-pre-check 'next (if bool? (list 'loop (list 'and result name-folded-result) name-param2 'next '(##cdr lst)) (list 'loop result 'next '(##cdr lst))))))))))) (define (body) (cons 'cond (cons (list (list '##not (list '##eq? (param-name name-param2) '(absent-obj))) (add-forcing (list (param-name name-param1) (param-name name-param2)) (add-pre-check (param-name name-param1) (add-pre-check (param-name name-param2) ; (list 'if ; (list '##null? name-others) ; (exactly-2-args) (at-least-2-args))))) ;) (append (if (null? zero) '() (list (list (list '##eq? (param-name name-param1) '(absent-obj)) zero))) (list (list 'else (exactly-1-arg))))))) (list 'define name-fn (list 'lambda (parameter-list) (body))))) (##define-macro (define-nary form zero one two forcing pre-check . post-checks) `(define-fold #f ,form ,zero ,one ,two ,forcing ,pre-check ,@post-checks)) (##define-macro (define-nary-bool form zero one two forcing pre-check . post-checks) `(define-fold #t ,form ,zero ,one ,two ,forcing ,pre-check ,@post-checks)) ;------------------------------------------------------------------------------ ; Macros for "_eval.scm" and "_repl.scm". (##define-macro (make-global-var id) `(##make-global-var ,id)) (##define-macro (global-var-ref gv) `(##global-var-ref ,gv)) (##define-macro (global-var-set! gv val) `(##global-var-set! ,gv ,val)) (##define-macro (global-var->identifier gv) `(##global-var->identifier ,gv)) (##define-macro (quasi-list->vector x) `(##quasi-list->vector ,x)) (##define-macro (quasi-append x y) `(##quasi-append ,x ,y)) (##define-macro (quasi-cons x y) `(##quasi-cons ,x ,y)) (##define-macro (true? x) x) (##define-macro (unbound? x) `(##unbound? ,x)) (##define-macro (self-var) '##self-var) (##define-macro (selector-var) '##selector-var) (##define-macro (do-loop-var) '##do-loop-var) (##define-macro (rt-error-unbound-global-var code rte) `(##signal '##signal.global-unbound ,code ,rte)) (##define-macro (rt-error-non-procedure-send code rte) `(##signal '##signal.non-procedure-send ,code ,rte)) (##define-macro (rt-error-non-procedure-oper code rte) `(##signal '##signal.non-procedure-operator ,code ,rte)) (##define-macro (rt-error-wrong-nb-args proc args) `(##signal '##signal.wrong-nb-arg ,proc ,args)) (##define-macro (rt-error-unknown-keyword-arg proc args) `(##signal '##signal.unknown-keyword-arg ,proc ,args)) (##define-macro (rt-error-keyword-expected proc args) `(##signal '##signal.keyword-expected ,proc ,args)) (##define-macro (ct-error-global-env-overflow var) `(##signal '##signal.global-env-overflow ,var)) (##define-macro (ct-error-syntax src msg . args) `(##signal '##signal.syntax-error ,src ,msg ,@args)) ; Macro to create a node of executable code. (##define-macro (mk-code code-prc cte src stepper subcodes . lst) `(let (($code (##vector #f ,code-prc ,cte ,src ,stepper ,@subcodes ,@lst))) ,@(let loop ((l subcodes) (i 5) (r '())) (if (pair? l) (loop (cdr l) (+ i 1) (cons `(##vector-set! (##vector-ref $code ,i) 0 $code) r)) (reverse r))) $code)) (##define-macro (code-link c) `(##vector-ref ,c 0)) (##define-macro (code-cprc c) `(##vector-ref ,c 1)) (##define-macro (code-cte c) `(##vector-ref ,c 2)) (##define-macro (code-locat c) `(##vector-ref ,c 3)) (##define-macro (code-locat-set! c l) `(##vector-set! ,c 3 ,l)) (##define-macro (code-stepper c) `(##vector-ref ,c 4)) (##define-macro (code-length c) `(##fixnum.- (##vector-length ,c) 5)) (##define-macro (code-ref c n) `(##vector-ref ,c (##fixnum.+ ,n 5))) (##define-macro (code-set! c n x) `(##vector-set! ,c (##fixnum.+ ,n 5) ,x)) (##define-macro (^ n) `(##vector-ref $code ,(+ n 5))) (##define-macro (is-child-code? child parent) `(let ((child ,child) (parent ,parent)) (and (##vector? child) (##fixnum.< 3 (##vector-length child)) (##eq? (code-link child) parent)))) (##define-macro (code-run c) `(let (($$code ,c)) ((##vector-ref $$code 1) $$code rte))) ; Macro to create the "code procedure" associated with a code node. (##define-macro (mk-cprc . body) `(let () (##declare (not inline) (not interrupts-enabled) (environment-map)) (lambda ($code rte) (let (($$continue (lambda ($code rte) (##declare (inline)) ,@body))) (##declare (interrupts-enabled)) ($$continue $code rte))))) (##define-macro (mk-gen params . def) `(let () (##declare (not inline)) (lambda (cte tail? src ,@params) ,@def))) (##define-macro (gen proc src . args) `(,proc cte tail? ,src ,@args)) (##define-macro (call-step! vars . body) `(step! #t 1 ,vars ,@body)) (##define-macro (future-step! vars . body) `(step! #f 2 ,vars ,@body)) (##define-macro (delay-step! vars . body) `(step! #f 2 ,vars ,@body)) (##define-macro (lambda-step! vars . body) `(step! #f 3 ,vars ,@body)) (##define-macro (define-step! vars . body) `(step! #f 4 ,vars ,@body)) (##define-macro (set!-step! vars . body) `(step! #f 5 ,vars ,@body)) (##define-macro (reference-step! vars . body) `(step! #f 6 ,vars ,@body)) (##define-macro (constant-step! vars . body) `(step! #f 7 ,vars ,@body)) (##define-macro (make-no-stepper) ''#(#(#f #f #f #f #f #f #f) #f #f #f #f #f #f #f)) (##define-macro (make-step-handlers) '(##vector ##step-handler ##step-handler ##step-handler ##step-handler ##step-handler ##step-handler ##step-handler)) (##define-macro (make-main-stepper) '(##vector (##vector-copy ##step-handlers) #f #f #f #f #f #f #f)) (##define-macro (step! leapable? handler-index vars . body) `(let* (($$execute-body (lambda ($code rte ,@vars) ,@body)) ($$handler (##vector-ref (code-stepper $code) ,handler-index))) (if $$handler ($$handler ,leapable? $code rte (lambda ($code rte ,@vars) ($$execute-body $code rte ,@vars)) ,@vars) ($$execute-body $code rte ,@vars)))) ;------------------------------------------------------------------------------ ; Macros to manipulate the runtime environment (##define-macro (mk-rte rte . lst) `(##vector ,rte ,@lst)) (##define-macro (mk-rte* rte ns) `(let (($rte (##make-vector (##fixnum.+ ,ns 1) (##void)))) (##vector-set! $rte 0 ,rte) $rte)) (##define-macro (rte-up rte) `(##vector-ref ,rte 0)) (##define-macro (rte-ref rte i) `(##vector-ref ,rte ,i)) (##define-macro (rte-set! rte i val) `(##vector-set! ,rte ,i ,val)) ;============================================================================== gambc30/lib/main.c 754 541 730 11436 6524323576 7246 /* file: "main.c" */ /* Copyright (C) 1994-1998 by Marc Feeley, All Rights Reserved. */ /* This is the driver of the Gambit-C system */ #define ___INCLUDED_FROM_MAIN #define ___VERSION 21 #include "gambit.h" #include #include #include ___HIDDEN void usage_err ___P((char **argv),(argv) char **argv;) { fprintf (stderr, "Usage: %s [-:OPT,OPT...] ...\n", argv[0]); fprintf (stderr, " where OPT can be one of:\n"); fprintf (stderr, " kSTACK_CACHE_SIZE_IN_KILOBYTES\n"); fprintf (stderr, " mMIN_HEAP_SIZE_IN_KILOBYTES\n"); fprintf (stderr, " hMAX_HEAP_SIZE_IN_KILOBYTES\n"); fprintf (stderr, " lPERCENT_LIVE_AFTER_GC\n"); fprintf (stderr, " s\n"); fprintf (stderr, " d[level]\n"); fprintf (stderr, " t\n"); fprintf (stderr, " u\n"); fprintf (stderr, " c\n"); fprintf (stderr, " 1\n"); fprintf (stderr, " 8\n"); exit (1); } ___EXP_FUNC(int,___main) ___P((int argc, char **argv, ___mod_or_lnk (*linker)(___global_state_struct*)), (argc, argv, linker) int argc; char **argv; ___mod_or_lnk (*linker)();) { unsigned long stack_cache_len, min_heap_len, max_heap_len; int live_percent; int default_io_encoding; int standard; int debug_level; int force_tty; int force_unbuffered_io; /* handle arguments to runtime */ stack_cache_len = 0; min_heap_len = 0; max_heap_len = 0; live_percent = 0; default_io_encoding = ___DEFAULT_IO_ENCODING; standard = 0; debug_level = 0; force_tty = 0; force_unbuffered_io = 0; if (argc > 1) { char *s, *arg = argv[1]; if (*arg++ == '-' && *arg++ == ':') { do { s = arg++; switch (*s) { case 'm': case 'h': case 'k': case 'l': case 'd': { char temp; int argval; while (*arg >= '0' && *arg <= '9') arg++; temp = *arg; *arg = '\0'; if (arg == s+1 && *s == 'd') argval = 1; else argval = atoi (s+1); *arg = temp; switch (*s) { case 'k': stack_cache_len = (unsigned long)argval<<10; break; case 'm': min_heap_len = (unsigned long)argval<<10; break; case 'h': max_heap_len = (unsigned long)argval<<10; break; case 'l': live_percent = argval; break; case 'd': debug_level = argval; break; } break; } case 's': standard = 1; break; case 't': force_tty = 1; break; case 'u': force_unbuffered_io = 1; break; case 'c': default_io_encoding = ___IO_CHAR_ENCODING; break; case '1': default_io_encoding = ___IO_LATIN1_ENCODING; break; case '8': default_io_encoding = ___IO_UTF8_ENCODING; break; default: usage_err (argv); } } while (*arg++ == ','); if (*--arg != '\0') usage_err (argv); argv[1] = argv[0]; argc--; argv++; } } #ifdef FORCE_MAX_HEAP if (max_heap_len == 0 || max_heap_len > FORCE_MAX_HEAP<<10) max_heap_len = FORCE_MAX_HEAP<<10; #endif /* Setup program, run it and perform any cleanup necessary. */ { ___setup_params_struct setup_params; setup_params.argc = argc; setup_params.argv = argv; setup_params.stack_cache = stack_cache_len; setup_params.min_heap = min_heap_len; setup_params.max_heap = max_heap_len; setup_params.live_percent = live_percent; setup_params.gc_hook = 0; setup_params.fatal_error = 0; setup_params.standard = standard; setup_params.debug_level = debug_level; setup_params.default_io_encoding = default_io_encoding; setup_params.force_tty = force_tty; setup_params.force_unbuffered_io = force_unbuffered_io; setup_params.linker = linker; ___setup (&setup_params); ___cleanup (); } /* Exit program. */ exit (0); return 0; /* satisfy some compilers */ } gambc30/lib/setup.c 644 541 730 106273 6523646070 7500 /* file: "setup.c" */ /* Copyright (C) 1994-1998 by Marc Feeley, All Rights Reserved. */ /* * This module contains the routines that setup the Scheme program for * execution. */ #define ___INCLUDED_FROM_SETUP #define ___VERSION 21 #include "gambit.h" #include "os.h" #include "setup.h" #include "mem.h" #include "c_intf.h" #include #include /* * Global state structure. */ ___EXP_DATA(___global_state_struct,___gstate); /*---------------------------------------------------------------------------*/ /* * Global variables needed by this module. */ int ___comply_to_standard_scheme; /* Indicates if in standard Scheme mode. */ ___WORD ___symbol_table; /* Hash table of all interned symbols. */ ___WORD ___keyword_table; /* Hash table of all interned keywords. */ ___WORD ___arguments; /* List of command line arguments. */ ___WORD ___exec_vector; ___WORD ___internal_return; ___NEED_GLO(___G__23__23_initial_2d_continuation) /*---------------------------------------------------------------------------*/ /* * ___debug_level is non-zero if debugging information is requested. */ int ___debug_level = 0; /* * Length of symbol table and keyword table. */ #define SYMKEY_TBL_LENGTH 359 /*---------------------------------------------------------------------------*/ /* * Interrupt handling. * * '___raise_interrupt (code)' is called when an interrupt has * occured. At some later point in time, the Gambit kernel will cause * the Scheme procedure ##interrupt-handler to be called with a single * integer argument indicating which interrupt has been received. * Interrupt codes are defined in "gambit.h". Currently, the * following codes are defined: * * ___INTR_USER user has interrupted the program (e.g. ctrl-C) * ___INTR_TIMER interval timer has elapsed * ___INTR_GC a garbage collection has finished */ ___EXP_FUNC(void,___raise_interrupt) ___P((int code),(code) int code;) { ___processor_state pstate = ___PSTATE; /* * Note: ___raise_interrupt may be called before the processor state * is initialized. As a consequence, the interrupt(s) received * before the initialization of the processor state will be ignored. */ pstate->intr_flag[code] = 1; if (pstate->intr_enabled) pstate->stack_trip = pstate->stack_base; } /*---------------------------------------------------------------------------*/ ___HIDDEN void fatal_heap_overflow ___PVOID { ___fatal_error ("Heap overflow during setup"); } ___HIDDEN ___WORD alloc_perm_vector ___P((unsigned long n),(n) unsigned long n;) { ___WORD result; result = ___alloc_scmobj (___sVECTOR, n<<___LWS, ___PERM); if (result == ___FAL) fatal_heap_overflow (); return result; } /* * 'make_perm_string_from_charstring (str)' converts the * null-terminated C string 'str' to a Scheme string. A permanent * object is allocated. The value ___FAL is returned if the object * can not be allocated. */ ___HIDDEN ___WORD make_perm_string_from_charstring ___P((char *str),(str) char *str;) { ___WORD r; unsigned long i, n = 0; while (str[n] != 0) n++; r = ___alloc_scmobj (___sSTRING, n<<___LCS, ___PERM); if (r == ___FAL) fatal_heap_overflow (); for (i=0; i ___MAX_CHR) ___fatal_error ("Illegal UTF-8 encoding during setup"); ___STRINGSET(r,___FIX(i),___CHR(c)) } return r; } /* * The hashing functions 'hash_utf8string (str)' and 'hash_schemestring (str)' * must compute the same value as the function 'targ-hash' in the file * "gsc/_t-c-3.scm". */ ___HIDDEN ___U32 hash_utf8string ___P((___UTF8STRING str),(str) ___UTF8STRING str;) { ___U32 h = 0; ___UTF8STRING p = str; ___UCS4 c; while (1) { ___UTF8STRING start = p; c = ___utf8_get (&p); if (p == start || c > ___MAX_CHR) ___fatal_error ("Illegal UTF-8 encoding during setup"); if (c == 0) return h & ___MAX_FIX; h = (h<<8) + c; h = h ^ (h>>24); } } ___HIDDEN ___U32 hash_schemestring ___P((___WORD str),(str) ___WORD str;) { unsigned long i, n = ___INT(___STRINGLENGTH(str)); ___U32 h = 0; for (i=0; i>24); } return h & ___MAX_FIX; } ___HIDDEN ___WORD symkey_table ___P((unsigned int subtype),(subtype) unsigned int subtype;) { switch (subtype) { case ___sKEYWORD: return ___keyword_table; default: /* assume ___sSYMBOL */ return ___symbol_table; } } ___HIDDEN ___WORD find_symkey_from_utf8string ___P((char *str, unsigned int subtype),(str, subtype) char *str; unsigned int subtype;) { ___WORD tbl = symkey_table (subtype); ___U32 h = hash_utf8string (str); ___WORD probe = ___FIELD(tbl,h%SYMKEY_TBL_LENGTH); while (probe != ___NUL) { ___WORD obj = ___CAR(probe); ___WORD name = ___FIELD(obj,0); unsigned long i; unsigned long n = ___INT(___STRINGLENGTH(name)); ___UTF8STRING p = str; for (i=0; ival == ___UNB1)) p->val = ___UNB2; return p; } else { ___processor_state pstate = ___PSTATE; p = ___alloc_global_var (); if (p == 0) ___fatal_error ("Can't allocate global var"); p->val = supply?___UNB2:___UNB1; p->prm = ___FAL; p->next = 0; if (pstate->glo_list_head == 0) pstate->glo_list_head = (___WORD)p; else ((___glo_struct*)pstate->glo_list_tail)->next = (___WORD)p; pstate->glo_list_tail = (___WORD)p; ___FIELD(sym,2) = (___WORD)p; return p; } } ___HIDDEN char module_prefix[] = ___MODULE_PREFIX; #define module_prefix_length (sizeof(module_prefix)-1) ___HIDDEN char c_id_prefix[] = #ifdef ___IMPORTED_ID_PREFIX ___IMPORTED_ID_PREFIX #endif ___C_ID_PREFIX; #define c_id_prefix_length (sizeof(c_id_prefix)-1) ___HIDDEN char c_id_suffix[] = #ifdef ___IMPORTED_ID_SUFFIX ___IMPORTED_ID_SUFFIX #endif ""; #define c_id_suffix_length (sizeof(c_id_suffix)-1) ___HIDDEN char hex_digits[] = "0123456789abcdef"; #define c_id_subsequent(unicode) \ (((unicode)>='A'&&(unicode)<='Z') || \ ((unicode)>='a'&&(unicode)<='z') || \ ((unicode)>='0'&&(unicode)<='9') || \ ((unicode)=='_')) ___HIDDEN int scheme_id_to_c_id ___P((char *scm_id, char *c_id, long max_length),(scm_id, c_id, max_length) char *scm_id; char *c_id; long max_length;) { long i = 0; long j = 0; unsigned char c, c2; long k, n; while ((c = scm_id[i++]) != '\0') { if (c == '_') { if (j+2 > max_length) return 0; c_id[j++] = '_'; c_id[j++] = '_'; } else if (c_id_subsequent(c)) { if (j+1 > max_length) return 0; c_id[j++] = c; } else { c2 = c; n = 1; while (c2 > 15) { c2 = c2 >> 4; n++; } if (j+n+2 > max_length) return 0; c_id[j++] = '_'; for (k=n-1; k>=0; k--) { c_id[j+k] = hex_digits[c & 15]; c = c >> 4; } j += n; c_id[j++] = '_'; } } if (j+1 > max_length) return 0; c_id[j++] = '\0'; return 1; } /*---------------------------------------------------------------------------*/ /* Alignment of objects */ ___HIDDEN ___WORD *align ___P((___WORD *from, long words, int flonum),(from, words, flonum) ___WORD *from; long words; int flonum;) { ___WORD *to; #if ___WS == 4 if (flonum) to = ___ALIGNUP((from+1), (___FLONUM_SIZE<<___LWS)) - 1; else #endif to = ___ALIGNUP(from, ___WS); if (from != to) { /* move object up */ int i; for (i=words-1; i>=0; i--) to[i] = from[i]; } return to; } ___HIDDEN ___WORD align_subtyped ___P((___WORD *ptr),(ptr) ___WORD *ptr;) { ___WORD head = ptr[0]; int subtype = ___HD_SUBTYPE(head); int words = ___HD_WORDS(head); return ___TAG(align (ptr, words+1, subtype>=___sF64VECTOR), ___tSUBTYPED); } /*---------------------------------------------------------------------------*/ /* Routines to setup a module for execution */ ___HIDDEN ___mod_or_lnk linker_to_mod_or_lnk ___P((___mod_or_lnk (*linker) (___global_state_struct*)),(linker) ___mod_or_lnk (*linker) ();) { ___mod_or_lnk mol = linker (___GSTATE); if (mol->module.kind == ___LINKFILE_KIND) { void **p = mol->linkfile.linker_tbl; while (*p != 0) { *p = linker_to_mod_or_lnk (*(___mod_or_lnk (**) ___P((___global_state_struct*),()))p); p++; } } return mol; } ___HIDDEN int for_each_module ___P((___mod_or_lnk mol, int (*proc) (___module_struct*)), (mol, proc) ___mod_or_lnk mol; int (*proc) ();) { if (mol->module.kind == ___LINKFILE_KIND) { void **p = mol->linkfile.linker_tbl; while (*p != 0) { int err = for_each_module ((___mod_or_lnk)*p++, proc); if (err != 0) return err; } return 0; /* no error */ } else return proc ((___module_struct*)mol); } ___HIDDEN void fixref ___P((___WORD *p, ___WORD *sym_tbl, ___WORD *key_tbl, ___WORD *cns_tbl, ___WORD *sub_tbl), (p, sym_tbl, key_tbl, cns_tbl, sub_tbl) ___WORD *p; ___WORD *sym_tbl; ___WORD *key_tbl; ___WORD *cns_tbl; ___WORD *sub_tbl;) { ___WORD v = *p; switch (___TYP(v)) { case ___tPAIR: if (___INT(v)<0) *p = sym_tbl[-1-___INT(v)]; else *p = ___TAG(___ALIGNUP(&cns_tbl[(___PAIR_SIZE+1)*___INT(v)],___WS),___tPAIR); break; case ___tSUBTYPED: if (___INT(v)<0) *p = key_tbl[-1-___INT(v)]; else *p = sub_tbl[___INT(v)]; break; } } ___HIDDEN int setup_module_phase1 ___P((___module_struct *module),(module) ___module_struct *module;) { int i, j; ___WORD *cns; char *name = module->name; ___FAKEWORD *glo_tbl= module->glo_tbl; int sup_count = module->sup_count; ___UTF8STRING *glo_names = module->glo_names; ___WORD *sym_tbl = (___WORD*)module->sym_tbl; int sym_count = module->sym_count; ___UTF8STRING *sym_names = module->sym_names; ___WORD *key_tbl = (___WORD*)module->key_tbl; int key_count = module->key_count; ___UTF8STRING *key_names = module->key_names; ___WORD *lp = module->lp; ___WORD *lbl_tbl = (___WORD*)module->lbl_tbl; int lbl_count = module->lbl_count; ___WORD *cns_tbl = module->cns_tbl; int cns_count = module->cns_count; ___WORD *sub_tbl = (___WORD*)module->sub_tbl; int sub_count = module->sub_count; if (___debug_level == 1) fprintf (stderr, "setting up module \"%s\"\n", name+module_prefix_length); if (module->version < ___VERSION) return 1; if (module->version > ___VERSION) return 2; if (cns_tbl != 0) cns = align (cns_tbl, (___PAIR_SIZE+1)*cns_count, 0); if (glo_names != 0) { /* * Create global variables in reverse order so that global variables * bound to c-lambdas are created last. */ i = 0; while (glo_names[i] != 0) i++; while (i-- > 0) glo_tbl[i] = (___FAKEWORD)make_global (glo_names[i], i=0; i--) sym_tbl[i] = ___TAG(___ALIGNUP(sym_tbl[i], ___WS), ___tSUBTYPED); if (key_names != 0) { i = 0; while (key_names[i] != 0) { key_tbl[i] = make_symkey (key_names[i], ___sKEYWORD); i++; } } else for (i=key_count-1; i>=0; i--) key_tbl[i] = ___TAG(___ALIGNUP(key_tbl[i], ___WS), ___tSUBTYPED); for (i=sub_count-1; i>=0; i--) sub_tbl[i] = align_subtyped ((___WORD*)sub_tbl[i]); for (i=cns_count-1; i>=0; i--) { fixref (cns+i*(___PAIR_SIZE+1)+1, sym_tbl, key_tbl, cns_tbl, sub_tbl); fixref (cns+i*(___PAIR_SIZE+1)+2, sym_tbl, key_tbl, cns_tbl, sub_tbl); } for (j=sub_count-1; j>=0; j--) { ___WORD *p = ___UNTAG_AS(sub_tbl[j],___tSUBTYPED); ___WORD head = p[0]; int subtype = ___HD_SUBTYPE(head); int words = ___HD_WORDS(head); switch (subtype) { case ___sSYMBOL: case ___sKEYWORD: case ___sVECTOR: case ___sRATNUM: case ___sCPXNUM: for (i=1; i<=words; i++) fixref (p+i, sym_tbl, key_tbl, cns_tbl, sub_tbl); } } if (lbl_count > 0) { ___label_struct *new_lt; new_lt = (___label_struct*)align (lbl_tbl, lbl_count*___LS, 0); for (i=lbl_count-1; i>=0; i--) if (new_lt[i].header == ___MAKE_HD((___INTRO_SIZE<<___LWS),___sVECTOR,___PERM)) fixref (&new_lt[i].entry, sym_tbl, key_tbl, cns_tbl, sub_tbl); else new_lt[i].entry = ___TAG(&new_lt[i].header,___tSUBTYPED); *lp = ___TAG(new_lt,___tSUBTYPED); } return 0; /* no error */ } ___HIDDEN int setup_module_phase2 ___P((___module_struct *module),(module) ___module_struct *module;) { int i; ___UTF8STRING name = module->name; ___FAKEWORD *glo_tbl = module->glo_tbl; int glo_count = module->glo_count; int sup_count = module->sup_count; ___UTF8STRING *glo_names = module->glo_names; if (glo_names != 0) { for (i=sup_count; ival == ___UNB1) { fprintf (stderr, "*** WARNING -- Variable \"%s\" used in module \"%s\" is undefined\n", glo_names[i], name+module_prefix_length); } } } module->init_proc (); return 0; /* no error */ } ___HIDDEN int setup_modules ___P((___mod_or_lnk mol),(mol) ___mod_or_lnk mol;) { int err; err = for_each_module (mol, setup_module_phase1); if (err != 0) return err; return for_each_module (mol, setup_module_phase2); } ___HIDDEN int module_count; ___HIDDEN int inc_module_count ___P((___module_struct *module),(module) ___module_struct *module;) { if (module->lbl_count > 0) module_count++; return 0; /* no error */ } ___HIDDEN int count_modules ___P((___mod_or_lnk mol),(mol) ___mod_or_lnk mol;) { module_count = 0; for_each_module (mol, inc_module_count); return module_count; } ___HIDDEN ___WORD module_vector; ___HIDDEN int store_in_module_vector ___P((___module_struct *module),(module) ___module_struct *module;) { if (module->lbl_count > 0) { ___FIELD(module_vector,module_count) = *module->lp+___LS*___WS; module_count++; } return 0; /* no error */ } ___HIDDEN void setup_module_vector ___P((___mod_or_lnk mol, ___WORD vect),(mol, vect) ___mod_or_lnk mol; ___WORD vect;) { module_count = 0; module_vector = vect; for_each_module (mol, store_in_module_vector); } ___WORD ___load_object_file ___P((char *path, char **errmsg),(path, errmsg) char *path; char **errmsg;) { int i; char temp1[___PATH_MAX_LENGTH+1]; char temp2[___PATH_MAX_LENGTH+1]; char *p; void *f; ___mod_or_lnk mol; ___WORD ev; for (i=module_prefix_length-1; i>=0; i--) temp2[i] = module_prefix[i]; if (___path_strip_extension (path, temp1, ___PATH_MAX_LENGTH) == 0 || ___path_strip_directory (temp1, temp2+module_prefix_length, ___PATH_MAX_LENGTH - module_prefix_length) == 0 || scheme_id_to_c_id (temp2, temp1+c_id_prefix_length, ___PATH_MAX_LENGTH - (c_id_prefix_length+c_id_suffix_length)) == 0) { *errmsg = "path is too long"; return ___FAL; } p = temp1; for (i=0; ilinkfile.version < 0) /* was it already setup? */ { *errmsg = "can't load a given object file more than once"; return ___FAL; } switch (setup_modules (mol)) { case 1: *errmsg = "object file was compiled with an older version of the compiler"; return ___FAL; case 2: *errmsg = "object file was compiled with a newer version of the compiler"; return ___FAL; } mol->linkfile.version = -1; /* mark link file as 'setup' */ ev = ___alloc_scmobj (___sVECTOR, count_modules (mol)<<___LWS, ___STILL); if (ev == ___FAL) { *errmsg = "heap overflow"; return ___FAL; } setup_module_vector (mol, ev); ___still_obj_refcount_dec (ev); return ev; } /*---------------------------------------------------------------------------*/ double ___round ___P((double x),(x) double x;) { double f, i, t; if (x < 0.0) { f = modf (-x, &i); if (f > 0.5 || (f == 0.5 && modf (i*0.5, &t) != 0.0)) return -(i+1.0); else return -i; } else { f = modf (x, &i); if (f > 0.5 || (f == 0.5 && modf (i*0.5, &t) != 0.0)) return i+1.0; else return i; } } #ifdef ___CPU_BIGEND #define F64_HI8 0 #define F64_HI16 0 #else #define F64_HI8 7 #define F64_HI16 3 #endif double ___copysign ___P((double x, double y),(x, y) double x; double y;) { ___U8 *px = (___U8*)&x; ___U8 *py = (___U8*)&y; px[F64_HI8] = (px[F64_HI8] & 0x7f) | (py[F64_HI8] & 0x80); return x; } int ___isfinite ___P((double x),(x) double x;) { ___U16 *px = (___U16*)&x; return ((px[F64_HI16] ^ 0x7ff0) & 0x7fff) >= 0x10; } int ___isnan ___P((double x),(x) double x;) { ___U16 *px = (___U16*)&x; return (px[F64_HI16] = (px[F64_HI16] ^ 0x7ff0) & 0x7fff) < 0x10 && (((___U32*)&x)[0] | ((___U32*)&x)[1]) != 0; } /*---------------------------------------------------------------------------*/ ___HIDDEN void init_symkey_glo1 ___P((___mod_or_lnk mol),(mol) ___mod_or_lnk mol;) { if (mol->module.kind == ___LINKFILE_KIND) { void **p1 = mol->linkfile.linker_tbl; ___FAKEWORD *p2 = mol->linkfile.sym_list; while (*p1 != 0) init_symkey_glo1 ((___mod_or_lnk)*p1++); while (p2 != 0) { ___WORD *sym_ptr; ___glo_struct *glo; sym_ptr = (___WORD*)p2; p2 = (___FAKEWORD*)sym_ptr[0]; glo = (___glo_struct*)sym_ptr[3]; sym_ptr[2] = glo->prm; /* move symbol's hash value */ } } } ___HIDDEN void init_symkey_glo2 ___P((___mod_or_lnk mol),(mol) ___mod_or_lnk mol;) { if (mol->module.kind == ___LINKFILE_KIND) { void **p1 = mol->linkfile.linker_tbl; ___FAKEWORD *p2 = mol->linkfile.sym_list; ___FAKEWORD *p3 = mol->linkfile.key_list; ___processor_state pstate = ___PSTATE; while (*p1 != 0) init_symkey_glo2 ((___mod_or_lnk)*p1++); while (p2 != 0) { ___U32 h; ___WORD sym, lst, str; ___WORD *sym_ptr; ___glo_struct *glo; sym_ptr = (___WORD*)p2; p2 = (___FAKEWORD*)sym_ptr[0]; str = align_subtyped ((___WORD*)sym_ptr[1]); glo = (___glo_struct*)sym_ptr[3]; glo->next = 0; if (pstate->glo_list_head == 0) pstate->glo_list_head = (___WORD)glo; else ((___glo_struct*)pstate->glo_list_tail)->next = (___WORD)glo; pstate->glo_list_tail = (___WORD)glo; *sym_ptr = ___MAKE_HD((___SYMBOL_SIZE<<___LWS),___sSYMBOL,___PERM); sym = align_subtyped (sym_ptr); h = ___INT(___FIELD(sym,1)); /* symbols are pre-hashed */ ___FIELD(sym,0) = str; ___FIELD(sym,2) = (___WORD)glo; h = h % SYMKEY_TBL_LENGTH; lst = ___make_pair (sym, ___FIELD(___symbol_table,h), ___PERM); if (lst == ___FAL) fatal_heap_overflow (); ___FIELD(___symbol_table,h) = lst; } while (p3 != 0) { ___U32 h; ___WORD key, lst, str; ___WORD *key_ptr; key_ptr = (___WORD*)p3; p3 = (___FAKEWORD*)key_ptr[0]; str = align_subtyped ((___WORD*)key_ptr[1]); *key_ptr = ___MAKE_HD((___KEYWORD_SIZE<<___LWS),___sKEYWORD,___PERM); key = align_subtyped (key_ptr); h = hash_schemestring (str); ___FIELD(key,0) = str; ___FIELD(key,1) = ___FIX(h); h = h % SYMKEY_TBL_LENGTH; lst = ___make_pair (key, ___FIELD(___keyword_table,h), ___PERM); if (lst == ___FAL) fatal_heap_overflow (); ___FIELD(___keyword_table,h) = lst; } } } /*---------------------------------------------------------------------------*/ /* C to Scheme call handler */ ___EXP_FUNC(int,___call) ___P((int nargs, ___WORD proc),(nargs, proc) int nargs; ___WORD proc;) { int ___err; ___processor_state ___ps = ___PSTATE; ___WORD *___fp = ___ps->fp; ___WORD stack_marker = *___fp; /* * The stack marker indicates if the stack frame of the **caller** C * function is still active (i.e. it hasn't returned yet). When the * caller returns, #f will be stored in the stack marker so that any * subsequent attempt to return to that invocation of the caller will * be detected and trigger an error. The stack marker is created by * the caller. */ ___LD_ARG_REGS ___fp -= nargs; ___POP_ARGS_IN_REGS(nargs) ___ST_ARG_REGS ___ps->fp = ___fp; ___ps->na = nargs; ___ps->pc = ((___label_struct*)(proc-___tSUBTYPED))->entry; ___PSSELF = proc; again: { ___BEGIN_CATCH ___WORD ___pc = ___ps->pc; while (___TYP(___pc) == ___tSUBTYPED && ___SUBTYPE(___pc) == ___FIX(___sPROCEDURE)) ___pc = ___CAST_FAKEHOST_TO_HOST(((___label_struct*)(___pc-___tSUBTYPED))->host)(___ps); ___fatal_error ("Jump to illegal PC"); ___END_CATCH } if (___err != ___NO_ERR) if (___err == ___UNWIND_C_STACK) { ___WORD unwind_destination = *___ps->fp; if (stack_marker == unwind_destination) /* unwinding done? */ ___err = ___NO_ERR; } else { ___fatal_error ("unhandled error"); goto again; } return ___err; } ___EXP_FUNC(void,___propagate_error) ___P((int err),(err) int err;) { ___processor_state ___ps = ___PSTATE; if (err != ___NO_ERR) ___THROW (err); } /*---------------------------------------------------------------------------*/ /* * Setup program and execute it. */ ___HIDDEN int setup_state = 0; /* 0=pre-setup, 1=post-setup, 2=post-cleanup */ ___EXP_FUNC(void,___cleanup) ___PVOID { /* * Only do cleanup once after successful setup. */ if (setup_state != 1) return; setup_state = 2; ___cleanup_mem (); ___cleanup_os (); } ___EXP_FUNC(void,___setup) ___P((___setup_params_struct *setup_params),(setup_params) ___setup_params_struct *setup_params;) { ___processor_state ___ps; ___mod_or_lnk mol; int i; /* * Only do setup once. */ if (setup_state != 0) return; setup_state = 2; /* in case setup fails */ /* * Setup debugging level. */ ___debug_level = setup_params->debug_level; /* * Setup the operating system module. */ ___setup_os (setup_params); /* * Setup stack and heap. */ ___setup_mem (setup_params); /* * Setup global state to avoid problems on systems that don't * support the dynamic loading of files that import functions. */ #ifdef ___CANT_IMPORT_CLIB_DYNAMICALLY ___GSTATE->fabs = fabs; ___GSTATE->floor = floor; ___GSTATE->ceil = ceil; ___GSTATE->exp = exp; ___GSTATE->log = log; ___GSTATE->sin = sin; ___GSTATE->cos = cos; ___GSTATE->tan = tan; ___GSTATE->asin = asin; ___GSTATE->acos = acos; ___GSTATE->atan = atan; ___GSTATE->atan2 = atan2; ___GSTATE->sqrt = sqrt; #endif #ifdef ___USE_SETJMP #ifdef ___CANT_IMPORT_SETJMP_DYNAMICALLY ___GSTATE->setjmp = setjmp; #endif #endif #ifdef ___CANT_IMPORT_DYNAMICALLY ___GSTATE->___copysign = ___copysign; ___GSTATE->___isfinite = ___isfinite; ___GSTATE->___isnan = ___isnan; ___GSTATE->___round = ___round; ___GSTATE->___scmobj_to_char = ___scmobj_to_char; ___GSTATE->___scmobj_to_schar = ___scmobj_to_schar; ___GSTATE->___scmobj_to_uchar = ___scmobj_to_uchar; ___GSTATE->___scmobj_to_latin1 = ___scmobj_to_latin1; ___GSTATE->___scmobj_to_ucs4 = ___scmobj_to_ucs4; ___GSTATE->___scmobj_to_ucs2 = ___scmobj_to_ucs2; ___GSTATE->___scmobj_to_short = ___scmobj_to_short; ___GSTATE->___scmobj_to_ushort = ___scmobj_to_ushort; ___GSTATE->___scmobj_to_int = ___scmobj_to_int; ___GSTATE->___scmobj_to_uint = ___scmobj_to_uint; ___GSTATE->___scmobj_to_long = ___scmobj_to_long; ___GSTATE->___scmobj_to_ulong = ___scmobj_to_ulong; ___GSTATE->___scmobj_to_float = ___scmobj_to_float; ___GSTATE->___scmobj_to_double = ___scmobj_to_double; ___GSTATE->___scmobj_to_pointer = ___scmobj_to_pointer; ___GSTATE->___scmobj_to_function = ___scmobj_to_function; ___GSTATE->___scmobj_to_bool = ___scmobj_to_bool; ___GSTATE->___scmobj_to_charstring = ___scmobj_to_charstring; ___GSTATE->___scmobj_to_latin1string = ___scmobj_to_latin1string; ___GSTATE->___scmobj_to_ucs4string = ___scmobj_to_ucs4string; ___GSTATE->___scmobj_to_ucs2string = ___scmobj_to_ucs2string; ___GSTATE->___scmobj_to_utf8string = ___scmobj_to_utf8string; ___GSTATE->___free_function = ___free_function; ___GSTATE->___free_string = ___free_string; ___GSTATE->___char_to_scmobj = ___char_to_scmobj; ___GSTATE->___schar_to_scmobj = ___schar_to_scmobj; ___GSTATE->___uchar_to_scmobj = ___uchar_to_scmobj; ___GSTATE->___latin1_to_scmobj = ___latin1_to_scmobj; ___GSTATE->___ucs4_to_scmobj = ___ucs4_to_scmobj; ___GSTATE->___ucs2_to_scmobj = ___ucs2_to_scmobj; ___GSTATE->___short_to_scmobj = ___short_to_scmobj; ___GSTATE->___ushort_to_scmobj = ___ushort_to_scmobj; ___GSTATE->___int_to_scmobj = ___int_to_scmobj; ___GSTATE->___uint_to_scmobj = ___uint_to_scmobj; ___GSTATE->___long_to_scmobj = ___long_to_scmobj; ___GSTATE->___ulong_to_scmobj = ___ulong_to_scmobj; ___GSTATE->___float_to_scmobj = ___float_to_scmobj; ___GSTATE->___double_to_scmobj = ___double_to_scmobj; ___GSTATE->___pointer_to_scmobj = ___pointer_to_scmobj; ___GSTATE->___function_to_scmobj = ___function_to_scmobj; ___GSTATE->___bool_to_scmobj = ___bool_to_scmobj; ___GSTATE->___charstring_to_scmobj = ___charstring_to_scmobj; ___GSTATE->___latin1string_to_scmobj = ___latin1string_to_scmobj; ___GSTATE->___ucs4string_to_scmobj = ___ucs4string_to_scmobj; ___GSTATE->___ucs2string_to_scmobj = ___ucs2string_to_scmobj; ___GSTATE->___utf8string_to_scmobj = ___utf8string_to_scmobj; ___GSTATE->___make_cdef_stack_marker = ___make_cdef_stack_marker; ___GSTATE->___kill_cdef_stack_marker = ___kill_cdef_stack_marker; ___GSTATE->___release_scmobj = ___release_scmobj; ___GSTATE->___alloc_scmobj = ___alloc_scmobj; ___GSTATE->___make_pair = ___make_pair; ___GSTATE->___make_vector = ___make_vector; ___GSTATE->___make_string = ___make_string; ___GSTATE->___still_obj_refcount_inc = ___still_obj_refcount_inc; ___GSTATE->___still_obj_refcount_dec = ___still_obj_refcount_dec; ___GSTATE->___cleanup = ___cleanup; ___GSTATE->___call = ___call; ___GSTATE->___propagate_error = ___propagate_error; ___GSTATE->___raise_interrupt = ___raise_interrupt; #endif /* * Get processor state. */ ___ps = ___PSTATE; /* * Setup exception handling. */ #ifdef ___USE_SETJMP ___ps->catcher = 0; #endif /* * Setup interrupt system. */ ___ps->stack_trip = ___ps->stack_limit; ___ps->intr_enabled = 0; /* disable interrupts */ for (i=0; i<___NB_INTRS; i++) ___ps->intr_flag[i] = 0; ___ps->intr_enabled = 1; /* enable interrupts */ /* * Setup will lists. */ ___ps->executable_wills = ___TAG(0,___EXEC_WILL); /* tagged empty list */ ___ps->non_executable_wills = ___TAG(0,0); /* tagged empty list */ /* * Setup program's linker structure. */ mol = linker_to_mod_or_lnk (setup_params->linker); /* * Create empty symbol table, keyword table, and global * variable list. */ ___symbol_table = alloc_perm_vector (SYMKEY_TBL_LENGTH); for (i=0; iglo_list_head = 0; ___ps->glo_list_tail = 0; /* * Initialize symbol table, keyword table, global variables * and primitives. */ init_symkey_glo1 (mol); init_symkey_glo2 (mol); /* * Setup each module. */ switch (setup_modules (mol)) { case 1: ___fatal_error ("Module was compiled with an older version of the compiler"); case 2: ___fatal_error ("Module was compiled with a newer version of the compiler"); } /* * Create execution vector. */ ___exec_vector = alloc_perm_vector (count_modules (mol)); setup_module_vector (mol, ___exec_vector); /* * Create list of command line arguments (accessible through ##argv). */ { int argc = setup_params->argc; char **argv = setup_params->argv; char *dummy_argv[2]; if (argc < 1) /* use dummy program name if none supplied */ { dummy_argv[0] = ""; dummy_argv[1] = 0; argc = 1; argv = dummy_argv; } ___arguments = ___NUL; for (i=argc-1; i>=0; i--) { ___WORD arg = make_perm_string_from_charstring (argv[i]); ___WORD x = ___make_pair (arg, ___arguments, ___PERM); if (x == ___FAL) fatal_heap_overflow (); ___arguments = x; } } /* * Setup standard compliance flag. */ ___comply_to_standard_scheme = setup_params->standard; /* * Setup kernel handlers. */ { ___WORD ___start = ___G__23__23_initial_2d_continuation.prm; #define ___PH_LBL0 1 /* * The label numbers must match those in the procedure * "##initial-continuation" in the file "_kernel.scm". */ ___internal_return = ___LBL(1); ___ps->handler_break = ___LBL(2); ___ps->handler_stack_limit = ___LBL(3); ___ps->handler_heap_limit = ___LBL(4); ___ps->handler_not_proc = ___LBL(5); ___ps->handler_not_proc_glo = ___LBL(6); ___ps->handler_wrong_nargs = ___LBL(7); ___ps->handler_get_rest = ___LBL(8); ___ps->handler_get_key = ___LBL(9); ___ps->handler_get_key_rest = ___LBL(10); ___ps->handler_force = ___LBL(11); ___ps->handler_clam_conv_error = ___LBL(12); ___ps->handler_cdef_conv_error = ___LBL(13); ___ps->handler_return_to_c = ___LBL(14); ___ps->initial_continuation = ___LBL(15); } /* * Create "break frame" of initial top section. */ ___ps->fp[-1] = 0; ___ps->fp[-2] = 0; ___ps->fp -= 2; ___ps->stack_break = ___ps->fp; /* * Create continuation frame of initial continuation. */ ___ps->fp[-1] = ___ps->handler_break; /* return address */ ___ps->fp[-2] = ___FAL; /* space for the stack marker */ ___ps->fp -= 2; /* * Call kernel to start executing program. */ { ___WORD marker; if (___make_cdef_stack_marker (&marker) != ___NO_ERR) fatal_heap_overflow (); } for (i=1; i<___NB_GVM_REGS; i++) ___ps->r[i] = ___VOID; ___ps->r[0] = ___ps->initial_continuation; setup_state = 1; /* allow cleanup */ ___call (0, ___FIELD(___exec_vector,0)); } /*---------------------------------------------------------------------------*/ gambc30/lib/mem.c 754 541 730 165464 6523657643 7137 /* file: "mem.c" */ /* Copyright (C) 1994-1998 by Marc Feeley, All Rights Reserved. */ #define ___INCLUDED_FROM_MEM #define ___VERSION 21 #include "gambit.h" #include "os.h" #include "setup.h" #include "mem.h" #include "c_intf.h" #include #include #include /*---------------------------------------------------------------------------*/ /* * Global Scheme variables needed by this module. */ ___NEED_GLO(___G__23__23_gc_2d_report) /*---------------------------------------------------------------------------*/ /* * Defining the symbol CONSISTENCY_CHECKS will cause the GC to perform * checks that detect when the heap is in an inconsistent state. This * is useful to detect bugs in the GC and the rest of the system. * The checks are very extensive and consequently are expensive. They * should only be used for debugging. */ #undef CONSISTENCY_CHECKS /* * Defining the symbol GATHER_STATS will cause the GC to gather * statistics on the objects it encounters in the heap. */ #undef GATHER_STATS #ifdef GATHER_STATS #define MAX_STAT_SIZE 20 ___HIDDEN long movable_pair_objs; ___HIDDEN long movable_subtyped_objs[MAX_STAT_SIZE+2]; #endif /*---------------------------------------------------------------------------*/ /* Allocation and reclamation of aligned blocks of memory. */ /* * 'alloc_mem_aligned (words, multiplier, modulus)' allocates an * aligned block of memory through the '___alloc_mem' function. * 'words' is the size of the block in words and 'multiplier' and * 'modulus' specify its alignment in words. 'multiplier' must be a * power of two and 0<=modulusnb_sections; msection **sections = ms->sections; #ifdef ___ALLOC_MEM_UP if ((ns == 0) || (ptr < (void*)sections[0])) return -1; #else if ((ns == 0) || (ptr < (void*)sections[ns-1])) return ns; #endif else { /* binary search */ unsigned int lo = 0, hi = ns-1; /* loop invariant: lo <= find_msection (ms, ptr) <= hi */ while (lo < hi) { unsigned int mid = (lo+hi)/2; /* lo <= mid < hi */ #ifdef ___ALLOC_MEM_UP if (ptr < (void*)sections[mid+1]) hi = mid; else lo = mid+1; #else if (ptr < (void*)sections[mid]) lo = mid+1; else hi = mid; #endif } return lo; } } /* * 'adjust_msections (msp, n)' contracts or expands the msections * pointed to by 'msp' so that it contains 'n' sections. When the * msections is contracted, the sections at the top of the 'sections' * array will be reclaimed (these are the highest sections if * ___ALLOC_MEM_UP is defined, otherwise they are the lowest * sections). When expanding the msections there may not be enough * memory to allocate new sections so the operation may fail. However * 'adjust_msections' will always leave the msections in a consistent * state and there will be at least as many sections as when the * expansion was started. Failure can be detected by checking the * 'nb_sections' field. */ ___HIDDEN void adjust_msections ___P((msections **msp, unsigned int n),(msp, n) msections **msp; unsigned int n;) { unsigned int max_ns, ns; msections *ms = *msp; msection *hd, *tl; if (ms == 0) { max_ns = 0; ns = 0; hd = 0; tl = 0; } else { max_ns = ms->max_nb_sections; ns = ms->nb_sections; hd = ms->head; tl = ms->tail; } if ((ms == 0) || (n > max_ns)) { /* must allocate a new msections structure */ msections *new_ms; int i; while (n > max_ns) /* grow max_nb_sections until big enough */ max_ns = 2*max_ns + 1; new_ms = (msections*) alloc_mem_aligned (___WORDS(sizeof_msections(max_ns)), 1, 0); if (new_ms == 0) return; new_ms->max_nb_sections = max_ns; new_ms->nb_sections = ns; new_ms->head = hd; new_ms->tail = tl; for (i=ns-1; i>=0; i--) new_ms->sections[i] = ms->sections[i]; if (ms != 0) free_mem_aligned (ms); ms = new_ms; *msp = ms; } if (n < ns) { /* contraction of the msections */ unsigned int j; while (ns > n) { msection *s = tl; tl = tl->prev; if (tl == 0) hd = 0; else tl->next = 0; for (j=s->pos; jsections[j] = ms->sections[j+1]; ms->sections[j]->pos = j; } free_mem_aligned (s); ns--; } ms->nb_sections = ns; ms->head = hd; ms->tail = tl; /* contraction of the msections structure is not implemented */ } else { /* expansion of the msections */ int i, j; while (ns < n) { msection *s = (msection*) alloc_mem_aligned (___WORDS(sizeof_msection(___MSECTION_SIZE)), 1, 0); if (s == 0) return; i = find_msection (ms, (void*)s); #ifdef ___ALLOC_MEM_UP i++; #endif for (j=ns; j>i; j--) { ms->sections[j] = ms->sections[j-1]; ms->sections[j]->pos = j; } ms->sections[i] = s; if (tl == 0) hd = s; else tl->next = s; s->pos = i; s->prev = tl; s->next = 0; tl = s; ms->nb_sections = ++ns; ms->head = hd; ms->tail = tl; } } } /* * 'free_msections (msp)' releases all memory associated with the * msections pointed to by 'msp'. */ ___HIDDEN void free_msections ___P((msections **msp),(msp) msections **msp;) { msections *ms = *msp; if (ms != 0) { int i; for (i=ms->nb_sections-1; i>=0; i--) free_mem_aligned (ms->sections[i]); free_mem_aligned (ms); *msp = 0; } } /*---------------------------------------------------------------------------*/ /* Allocation of permanent objects. */ /* * Permanent objects are allocated in sections called "psections". * Each section contains multiple objects. The sections are kept in a * list so that the storage they occupy can be reclaimed when the * program terminates. */ ___HIDDEN void *psections; /* list of psections */ ___HIDDEN ___WORD *palloc_ptr; /* allocation pointer in current psection */ ___HIDDEN ___WORD *palloc_limit; /* allocation limit in current psection */ /* * 'alloc_mem_aligned_psection (words, multiplier, modulus)' allocates * an aligned block of memory inside a new psection. 'words' is the * size of the block in words and 'multiplier' and 'modulus' specify * its alignment in words. 'multiplier' must be a power of two and * 0<=modulus ___PSECTION_WASTE || words > ___PSECTION_SIZE) return alloc_mem_aligned_psection (words, multiplier, modulus); base = (___WORD*) alloc_mem_aligned_psection (___PSECTION_SIZE, multiplier, modulus); if (base != 0) { palloc_ptr = base+words; palloc_limit = base+___PSECTION_SIZE; } return base; } ___HIDDEN void free_psections ___PVOID { void *base = psections; psections = 0; while (base != 0) { void *link = *(void**)base; free_mem_aligned (base); base = link; } } ___glo_struct *___alloc_global_var ___PVOID { return (___glo_struct*) alloc_mem_aligned_perm (___WORDS(sizeof(___glo_struct)), 1, 0); } /*---------------------------------------------------------------------------*/ /* Constants related to representation of permanent and still objects: */ #ifdef ___USE_HANDLES #define ___PERM_HAND_OFS 0 #define ___PERM_BODY_OFS 2 #else #define ___PERM_HAND_OFS ___PERM_BODY_OFS #define ___PERM_BODY_OFS 1 #endif #define ___STILL_LINK_OFS 0 #define ___STILL_REFCOUNT_OFS 1 #define ___STILL_LENGTH_OFS 2 #define ___STILL_MARK_OFS 3 #ifdef ___USE_HANDLES #define ___STILL_HAND_OFS 4 #define ___STILL_BODY_OFS 6 #else #define ___STILL_HAND_OFS ___STILL_BODY_OFS #define ___STILL_BODY_OFS (5+1)/************/ #endif /* * 'normal_overflow_reserve' is the number of words reserved in the heap * in normal circumstances for handling heap overflows. When the heap * overflows, this space will be made available to the heap overflow * handler. * * 'overflow_reserve' is the number of words currently reserved in the heap * for handling heap overflows. If a heap overflow has occured, and there * has not yet been a GC that at least made 'normal_overflow_reserve' free, * then 'overflow_reserve' will be 0. */ ___HIDDEN long normal_overflow_reserve, overflow_reserve; ___HIDDEN unsigned long stack_cache_size;/* size of stack non-fudge in words */ ___HIDDEN unsigned long min_heap_size;/* size of heap in words (lower bound) */ ___HIDDEN unsigned long max_heap_size;/* size of heap in words (upper bound) */ ___HIDDEN long words_non_movable; /* words occupied by non-movable objs */ ___HIDDEN long words_prev_msections; /* words occupied by movable objs */ /* not including current section */ /* total words occupied in heap including current section */ #define WORDS_MOVABLE ((words_prev_msections+(alloc_ptr-start_ptr))*2) /* total words occupied in heap including current section */ #define WORDS_OCCUPIED (words_non_movable+WORDS_MOVABLE) /* number of words in heap */ #define WORDS_IN_HEAP \ (the_msections->nb_sections*2*((___MSECTION_SIZE>>1)-___MSECTION_FUDGE+1) \ - overflow_reserve * 2) ___HIDDEN ___WORD still_objs; /* list of still objects */ ___HIDDEN ___WORD still_objs_to_scan; /* still objects remaining to scan */ ___HIDDEN msections *the_msections; /* the msections */ ___HIDDEN int tospace_at_top; /* location of tospace in each section */ ___HIDDEN msection *alloc_msection;/* section currently being allocated in */ ___HIDDEN int nb_prev_msections; /* nb of sections filled before current */ ___HIDDEN ___WORD *start_ptr; /* start of allocation in current section */ ___HIDDEN ___WORD *alloc_ptr; /* allocation pointer in current section */ ___HIDDEN ___WORD *alloc_limit; /* allocation limit in current section */ ___HIDDEN msection *scan_msection; /* section currently being scanned */ ___HIDDEN ___WORD *scan_ptr; /* scan pointer in section being scanned */ ___HIDDEN long words_allocated_for_cont; /* for allocation statistics */ /* * '___alloc_scmobj (subtype, bytes, kind)' allocates a permanent * or still Scheme object (depending on 'kind') of subtype * 'subtype' with a body containing 'bytes' bytes, and returns it * as an encoded Scheme object. A permanent object is allocated * when 'kind' = ___PERM and a still object is allocated when * 'kind' = ___STILL. The initialization of the object's body must * be done by the caller. In the case of still objects this * initialization must be done before the next allocation is * requested. The 'refcount' field of still objects is initially * 1. The value ___FAL is returned if the object can not be * allocated. */ ___EXP_FUNC(___WORD,___alloc_scmobj) ___P((unsigned int subtype, unsigned long bytes, unsigned int kind), (subtype, bytes, kind) unsigned int subtype; unsigned long bytes; unsigned int kind;) { void *ptr; ___processor_state pstate = ___PSTATE; unsigned long words = (kind==___PERM ? ___PERM_BODY_OFS : ___STILL_BODY_OFS) + ___WORDS(bytes); alloc_ptr = pstate->hp; /* needed by 'WORDS_OCCUPIED' */ words_non_movable += words; if (WORDS_OCCUPIED > WORDS_IN_HEAP) { int overflow = ___gc (); alloc_ptr = pstate->hp; /* needed by 'WORDS_OCCUPIED' */ if (overflow || WORDS_OCCUPIED > WORDS_IN_HEAP) { words_non_movable -= words; overflow_reserve = normal_overflow_reserve; return ___FAL; } } /* * Some objects, such as ___sF64VECTOR and ___sFLONUM and * ___sPOINTER, must have a body that is aligned on a multiple of 8 * on some machines. Here, we force alignment to a multiple of 8 * even if not necessary in all cases because it is typically more * efficient due to a better utilization of the cache. */ if (kind == ___PERM) ptr = alloc_mem_aligned_perm (words, 8>>___LWS, (-___PERM_BODY_OFS)&((8>>___LWS)-1)); else ptr = alloc_mem_aligned (words, 8>>___LWS, (-___STILL_BODY_OFS)&((8>>___LWS)-1)); if (ptr == 0) { words_non_movable -= words; return ___FAL; } else if (kind == ___PERM) { ___WORD *base = (___WORD*)ptr; #ifdef ___USE_HANDLES base[___PERM_HAND_OFS] = (___WORD)(base+___PERM_BODY_OFS-___BODY_OFS); #endif base[___PERM_BODY_OFS-1] = ___MAKE_HD(bytes, subtype, ___PERM); return ___TAG((base + ___PERM_HAND_OFS - ___BODY_OFS), (subtype == ___sPAIR ? ___tPAIR : ___tSUBTYPED)); } else { ___WORD *base = (___WORD*)ptr; base[___STILL_LINK_OFS] = still_objs; still_objs = (___WORD)base; base[___STILL_REFCOUNT_OFS] = 1; base[___STILL_LENGTH_OFS] = words; #ifdef ___USE_HANDLES base[___STILL_HAND_OFS] = (___WORD)(base+___STILL_BODY_OFS-___BODY_OFS); #endif base[___STILL_BODY_OFS-1] = ___MAKE_HD(bytes, subtype, ___STILL); return ___TAG((base + ___STILL_HAND_OFS - ___BODY_OFS), (subtype == ___sPAIR ? ___tPAIR : ___tSUBTYPED)); } } /* * '___make_pair (car, cdr, kind)' creates a Scheme pair having the * values 'car' and 'cdr' in its CAR and CDR fields. A permanent * or still object is allocated, depending on 'kind' (___PERM for * permanent object, ___STILL for still object). The value ___FAL * is returned if the object can not be allocated. */ ___EXP_FUNC(___WORD,___make_pair) ___P((___WORD car, ___WORD cdr, unsigned int kind), (car, cdr, kind) ___WORD car; ___WORD cdr; unsigned int kind;) { ___WORD obj = ___alloc_scmobj (___sPAIR, ___PAIR_SIZE<<___LWS, kind); if (obj == ___FAL) return ___FAL; else { ___PAIR_CAR(obj) = car; ___PAIR_CDR(obj) = cdr; return obj; } } /* * '___make_vector (length, init, kind)' creates a Scheme vector of * length 'length' and initialized with the value 'init'. A * permanent or still object is allocated, depending on 'kind' * (___PERM for permanent object, ___STILL for still object). The * value ___FAL is returned if the object can not be allocated. */ ___EXP_FUNC(___WORD,___make_vector) ___P((unsigned long length, ___WORD init, unsigned int kind), (length, init, kind) unsigned long length; ___WORD init; unsigned int kind;) { if (length >= (1<<(32-___LF-___LWS))) return ___FAL; else { ___WORD obj = ___alloc_scmobj (___sVECTOR, length<<___LWS, kind); if (obj == ___FAL) return ___FAL; else { unsigned int i; for (i=0; i= (1<<(32-___LF-1))) return ___FAL; else { ___WORD obj = ___alloc_scmobj (___sSTRING, length<<___LCS, kind); if (obj == ___FAL) return ___FAL; else { unsigned int i; for (i=0; i