From 1236dacad01d3d0a1553015515b818d487519436 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Tue, 21 Dec 2010 10:33:34 -0700
Subject: [PATCH] Now builds on x86_64 and via portable C distribution.

The build process now builds FFIs after it build-bands.  An FFI's
"build" target now combines the old "generate" and "build" targets,
and knows from its host whether to compile-liarc-bundle.  The
"install" target also knows whether to install-liarc-bundle.

Building the FFIs after build-bands means we can use src/microcode/
scheme and src/lib.  Compiling the .scm after building the shim
ensures that the .scm's FFI syntax and the shim are consistent.

* doc/gtk/gtk.texinfo (Installation): Updated, with a section about
building the portable C distribution.  Replaced "smallexample" with
"example" because of the former's smaller font.

* src/Makefile.in (build-ffis): This new target is needed in src/etc/
make-liarc.sh, and now appears after build-bands in most contexts.
Moved ffi from LIARC_BOOT_BUNDLES, and FFIS from LIARC_BUNDLES, but
not INSTALLED_SUBDIRS.

* src/configure.ac: Simplified the with-gtk default, which can expect
a host with an FFI after build-bands.  Just test for Gtk 2.0 libraries
via pkg-config.

* src/etc/compile.scm (compile-ffi): Use in-liarc; delay C compilation.

* src/etc/make-liarc.sh: Add build-ffis after build-bands.

* src/gtk/Makefile-fragment: Combine generate and build into one, and
use ../microcode/scheme.

* src/gtk/gtk-shim.h: Replace "ulong" with "unsigned long".

* src/gtk/gtkio.c.stay: Make run_gtk's definition agree with its
declaration, and explicitly cast to select_registry_t.
---
 doc/gtk/gtk.texinfo       | 90 +++++++++++++++++++++------------------
 src/Makefile.in           | 19 ++++-----
 src/configure.ac          | 28 ++++--------
 src/etc/compile.scm       |  4 +-
 src/etc/make-liarc.sh     |  2 +-
 src/gtk/Makefile-fragment | 44 ++++++++++---------
 src/gtk/gtk-shim.h        |  2 +-
 src/gtk/gtkio.c.stay      |  6 ++-
 8 files changed, 98 insertions(+), 97 deletions(-)

diff --git a/doc/gtk/gtk.texinfo b/doc/gtk/gtk.texinfo
index be4d042b5..f320532aa 100644
--- a/doc/gtk/gtk.texinfo
+++ b/doc/gtk/gtk.texinfo
@@ -95,13 +95,13 @@ need the FFI; it uses no FFI syntax.  There is no need to
 To run this program, enter the following command lines in the
 @file{src/gtk} directory of your build tree.
 
-@smallexample
+@example
   ../microcode/scheme --library ../lib
   (load-option 'Gtk)
   (ge '(gtk))
   (load "hello")
   (hello)
-@end smallexample
+@end example
 
 @unnumberedsec Gtk Event Viewer
 
@@ -112,11 +112,11 @@ straightforward translation of Havoc Pennington's GtkEv (from
 widget, enter the following command lines in the @file{src/gtk}
 directory of your build tree.
 
-@smallexample
+@example
   ../microcode/scheme --library ../lib
   (load-option 'GTK)
   (make-gtk-event-viewer-demo)
-@end smallexample
+@end example
 
 The code can be found in @file{gtk-ev.scm}.
 
@@ -134,11 +134,11 @@ reporting the inks under a click).  To see these widgets in action,
 enter the following command lines in the @file{src/gtk} directory of
 your build tree.
 
-@smallexample
+@example
   ../microcode/scheme --library ../lib
   (load-option 'Gtk)
   (make-fix-layout-demo)
-@end smallexample
+@end example
 
 The code can be found in @file{fix-demo.scm}.
 
@@ -153,11 +153,11 @@ options, and is @emph{just} sufficient to run Pole Zero.
 To see the Pole Zero application, enter the following command lines in
 the @file{src/gtk} directory of your build tree.
 
-@smallexample
+@example
   ../microcode/scheme --library ../lib
   (load-option 'Gtk)
   (make-pole-zero)
-@end smallexample
+@end example
 
 @unnumberedsec The Gtk Package
 
@@ -174,9 +174,9 @@ The Scheme machine can be configured (via the
 facilities, like a time slice counter.  Evaluating the following
 expression should cause a small window to pop up.
 
-@smallexample
+@example
   (gtk-time-slice-window! #t)
-@end smallexample
+@end example
 
 The window is created and updated on the toolkit side of the
 interface, and shows a running count of the number of times the
@@ -184,10 +184,10 @@ toolkit has yielded to Scheme (or vice versa), and the channels
 currently being polled by Scheme.  The count can be slowed and stopped
 by evaluating the first and second expressions below, respectively.
 
-@smallexample
+@example
   (set-thread-timer-interval! 1000)
   (set-thread-timer-interval! #f)
-@end smallexample
+@end example
 
 @xref{Debugging Facilities}.
 
@@ -267,9 +267,9 @@ arguments whenever @var{gobject} emits the signal with the same name
 as @var{alien-function}.  @var{alien-function} should be a callback
 trampoline, as in this example:
 
-@smallexample
+@example
   (g-signal-connect window (C-callback "delete_event") delete-callback)
-@end smallexample
+@end example
 
 Note that @var{delete-callback} should reference @var{window} via
 parameter @emph{only} (per discussion above).
@@ -277,9 +277,9 @@ parameter @emph{only} (per discussion above).
 
 @deffn Procedure g-signal-disconnect gobject name
 @var{name} should be a string, e.g.:
-@smallexample
+@example
   (g-signal-disconnect window "delete_event")
-@end smallexample
+@end example
 @end deffn
 
 The @bref{gobject-get-property} and @bref{gobject-set-properties}
@@ -1804,38 +1804,44 @@ If @var{trace?} is #t, turns on tracing of Scheme's GSource.
 @node Installation, Implementation Notes, API Reference, Top
 @chapter Installation
 
-If you have a recent version of MIT Scheme (with C/Unix FFI)
-installed, you can build and install the snapshot (in
-@file{$HOME/}) with these three commands.
+The Gtk system comes as a source snapshot or as a portable C
+distribution.
 
-@smallexample
+@section Source Snapshot
+
+If you downloaded the source snapshot, unpack it and change to its
+@file{src/} subdirectory.  Build and install it in @file{$HOME}
+with the following commands.
+
+@example
   ./configure --prefix=$HOME
   make
   make install
-@end smallexample
+@end example
 
-If your MIT Scheme does not include the FFI, you will need to install
-a version that does.  Use the same three commands (above) and you will
-have built and installed the requisite MIT Scheme, in @file{$HOME}.
+Note that you must have a binary distribution of MIT Scheme already
+installed.  MIT Scheme is used to build itself.
 
-To verify your install, check that your @code{mit-scheme} command
-invokes a Scheme with FFI.  If you used a configure option like
-@code{--prefix=$HOME}, you might use these commands:
+To test before installing, use the following command.
 
-@smallexample
-  export MIT_SCHEME_EXE=$HOME/bin/mit-scheme
-  echo "(load-option 'FFI)" | $MIT_SCHEME_EXE --batch-mode
-@end smallexample
+@example
+  echo "(load-option 'Gtk)" | microcode/scheme --library lib
+@end example
 
-If that command completes without complaint, you have a host for the
-Gtk system, which can now be built and installed like this:
+@section Portable C Distribution
 
-@smallexample
-  export MIT_SCHEME_EXE=$HOME/bin/mit-scheme
-  (cd src && make && make install)
-@end smallexample
+If you downloaded the portable C distribution, you do not need MIT
+Scheme already installed.  Unpack the distribution and change to its
+@file{src/} subdirectory, then use the following commands to build and
+install it.
+
+@example
+  etc/make-liarc.sh --prefix=$HOME
+  make install
+@end example
 
-If you have trouble, please feel free to contact the author.
+It should be as simple as that.  If not, please feel free to contact
+the author.
 
 @node Implementation Notes, GNU Free Documentation License, Installation, Top
 @chapter Implementation Notes
@@ -1850,19 +1856,19 @@ the details of the C API.  For example, a GtkLabel's text is retrieved
 in two steps: a toolkit function returns an alien address, and the C
 string at that address is copied into the heap.
 
-@smallexample
+@example
   (let ((retval (make-alien '|gchar|)))
     (C-call "gtk_label_get_text" retval (gobject-alien label))
     (c-peek-cstring retval))
 @result{} "!dlrow ,olleH"
-@end smallexample
+@end example
 
 The @code{gtk-label-get-text} wrapper procedure hides these details.
 
-@smallexample
+@example
   (gtk-label-get-text label)
 @result{} "!dlrow ,olleH"
-@end smallexample
+@end example
 
 In the example call to @code{gtk-label-get-text} above, a Scheme
 object represents the GtkLabel.  It is a gtk-label instance, whose
diff --git a/src/Makefile.in b/src/Makefile.in
index 8b98d676a..4e5b719cf 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -60,12 +60,12 @@ mkinstalldirs = $(SHELL) $(top_srcdir)/microcode/mkinstalldirs
 
 # **** END BOILERPLATE ****
 
-LIARC_BOOT_BUNDLES = compiler cref sf star-parser ffi
-LIARC_BUNDLES = $(LIARC_BOOT_BUNDLES) edwin imail sos ssp xml $(FFIS)
+LIARC_BOOT_BUNDLES = compiler cref sf star-parser
+LIARC_BUNDLES = $(LIARC_BOOT_BUNDLES) edwin imail sos ssp xml ffi
 FFIS = @FFIS@
 
 SUBDIRS = $(INSTALLED_SUBDIRS) 6001 compiler rcs win32 xdoc
-INSTALLED_SUBDIRS = microcode runtime $(LIARC_BUNDLES)
+INSTALLED_SUBDIRS = microcode runtime $(LIARC_BUNDLES) $(FFIS)
 
 MIT_SCHEME_EXE = @MIT_SCHEME_EXE@
 AUXDIR_NAME = @AUXDIR_NAME@
@@ -75,18 +75,14 @@ EDDIR = $(AUXDIR)/edwin
 all: @ALL_TARGET@
 
 all-native: compile-microcode
-	etc/make-in-subdirs.sh generate $(FFIS)
 	@$(top_srcdir)/etc/compile.sh "$(MIT_SCHEME_EXE)" \
 					--compiler --batch-mode
-	$(MAKE) build-bands
-	etc/make-in-subdirs.sh build $(FFIS)
+	$(MAKE) build-bands build-ffis
 
 all-svm: microcode/svm1-defns.h
-	etc/make-in-subdirs.sh generate $(FFIS)
 	$(MAKE) compile-microcode
 	@$(top_srcdir)/etc/compile-svm.sh "$(MIT_SCHEME_EXE)"
-	$(MAKE) build-bands
-	etc/make-in-subdirs.sh build $(FFIS)
+	$(MAKE) build-bands build-ffis
 
 microcode/svm1-defns.h: compiler/machines/svm/svm1-defns.h
 	if cmp compiler/machines/svm/svm1-defns.h microcode/svm1-defns.h; \
@@ -103,10 +99,11 @@ compiler/machines/svm/svm1-defns.h: \
 		</dev/null )
 
 all-liarc:
-	etc/make-in-subdirs.sh generate $(FFIS)
 	@$(top_srcdir)/etc/c-compile.sh "$(MIT_SCHEME_EXE)" \
 						--compiler --batch-mode
-	$(MAKE) compile-liarc-bundles build-bands
+	$(MAKE) compile-liarc-bundles build-bands build-ffis
+
+build-ffis:
 	etc/make-in-subdirs.sh build $(FFIS)
 
 macosx-app: stamp_macosx-app
diff --git a/src/configure.ac b/src/configure.ac
index 172e5f56c..364b6e87a 100644
--- a/src/configure.ac
+++ b/src/configure.ac
@@ -106,26 +106,15 @@ fi
 AC_CHECK_PROG([PKG_CONFIG], [pkg-config], [yes])
 AC_MSG_CHECKING([for gtk])
 if test "${with_gtk}" = "yes"; then
-    AC_MSG_RESULT([by request: yes])
-fi
-if test "${with_gtk}" = "auto"; then
-    if test "${PKG_CONFIG}" != yes; then
-	AC_MSG_RESULT([no pkg-config: no])
-	with_gtk=no
-    elif ! pkg-config --exists gtk+-2.0; then
-	AC_MSG_RESULT([! pkg-config --exists gtk+-2.0: no])
-	with_gtk=no
-    elif test "${mit_scheme_native_code}" == "c" \
-		-a -f ffi/syntax.c; then
-	# The LIARC boot compiler will have an FFI.
-	AC_MSG_RESULT([FFI in liarc boot: yes])
-	with_gtk=yes
-    elif "${MIT_SCHEME_EXE}" --eval "(load-option'FFI)" \
-		</dev/null >/dev/null 2>&1; then
-	AC_MSG_RESULT([FFI in host: yes])
+    AC_MSG_RESULT([by request... yes])
+elif test "${with_gtk}" = "no"; then
+    AC_MSG_RESULT([by request... no])
+elif test "${with_gtk}" = "auto"; then
+    if pkg-config --exists gtk+-2.0 2>/dev/null; then
+	AC_MSG_RESULT([yes])
 	with_gtk=yes
     else
-	AC_MSG_RESULT([no FFI: no])
+	AC_MSG_RESULT([no Gtk 2.0... no])
 	with_gtk=no
     fi
 fi
@@ -193,8 +182,7 @@ if test x"${mit_scheme_native_code}" = xc; then
         (cd lib; rm -f ${BN}; ${LN_S} ../${BN} .)
     done
     BUNDLES="6001 compiler cref edwin ffi imail sf sos ssp star-parser xdoc xml"
-    if test "${with_gtk}" = yes; then BUNDLES="$BUNDLES gtk"; fi
-    for BUNDLE in $BUNDLES; do
+    for BUNDLE in $BUNDLES $FFIS; do
     	SO=${BUNDLE}.so
 	(cd lib/lib; rm -f ${SO}; ${LN_S} ../../${BUNDLE}/${SO} .)
     done
diff --git a/src/etc/compile.scm b/src/etc/compile.scm
index d357af6f0..1c1d2ad79 100644
--- a/src/etc/compile.scm
+++ b/src/etc/compile.scm
@@ -41,7 +41,9 @@ USA.
 
 (define (compile-ffi dir)
   (if (eq? microcode-id/compiled-code-type 'C)
-      (c-compile-dir dir)
+      (in-liarc
+       (lambda ()
+	 (c-compile-dir dir)))
       (compile-dir dir)))
 
 (define (compile-boot-dirs compile-dir)
diff --git a/src/etc/make-liarc.sh b/src/etc/make-liarc.sh
index 4b89fc6b5..fbcff508c 100755
--- a/src/etc/make-liarc.sh
+++ b/src/etc/make-liarc.sh
@@ -56,4 +56,4 @@ run_configure --prefix=`pwd`/boot-root --enable-native-code=c \
 run_make stamp_install-liarc-boot-compiler c-clean distclean
 
 run_configure --enable-native-code=c --disable-host-scheme-test "${@}"
-run_make stamp_compile-liarc-bundles build-bands clean-boot-root
+run_make stamp_compile-liarc-bundles build-bands clean-boot-root build-ffis
diff --git a/src/gtk/Makefile-fragment b/src/gtk/Makefile-fragment
index b4399242e..12ec48b77 100644
--- a/src/gtk/Makefile-fragment
+++ b/src/gtk/Makefile-fragment
@@ -3,10 +3,15 @@
 
 TARGET_DIR = $(AUXDIR)/gtk
 
-MIT_SCHEME_EXE = @MIT_SCHEME_EXE@
-
-generate: ../lib/gtk-shim.so ../lib/gtk-types.bin ../lib/gtk-const.bin	\
-	  ../lib/conses.png
+build: compile
+	if test `echo "(pp microcode-id/compiled-code-type)"		\
+		 | ../microcode/scheme --library ../lib --batch-mode` = "c"; \
+	then $(MAKE) compile-liarc-bundle; fi
+
+compile: ../lib/gtk-shim.so ../lib/gtk-types.bin ../lib/gtk-const.bin	\
+	  ../lib/conses.png swat-pole-zero.scm
+	cd ../ && echo '(load "etc/compile.scm")(compile-ffi "gtk")'	\
+	| microcode/scheme --library lib --batch-mode
 
 ../lib/gtk-shim.so: gtk-shim.so
 	$(INSTALL_DATA) gtk-shim.so $@
@@ -20,14 +25,8 @@ generate: ../lib/gtk-shim.so ../lib/gtk-types.bin ../lib/gtk-const.bin	\
 ../lib/conses.png: conses.png
 	$(INSTALL_DATA) conses.png $@
 
-build:
-	if [ ! -e swat-pole-zero.scm ]; then \
-	    ln -sf ../swat/scheme/other/pole-zero.scm swat-pole-zero.scm; fi
-	cd ../; echo '(load "etc/compile.scm")(compile-ffi "gtk")' \
-	| microcode/scheme --library lib --batch-mode
-
-liarc-build:
-	$(MAKE) compile-liarc-bundle gtk
+swat-pole-zero.scm:
+	ln -sf ../swat/scheme/other/pole-zero.scm swat-pole-zero.scm
 
 install:
 	rm -rf $(DESTDIR)$(TARGET_DIR)
@@ -39,6 +38,9 @@ install:
 	$(INSTALL_DATA) gtk-shim.so $(DESTDIR)$(AUXDIR)/.
 	$(INSTALL_DATA) gtk-types.bin $(DESTDIR)$(AUXDIR)/.
 	$(INSTALL_DATA) gtk-const.bin $(DESTDIR)$(AUXDIR)/.
+	if test `echo "(pp microcode-id/compiled-code-type)"		\
+		 | ../microcode/scheme --library ../lib --batch-mode` = "c"; \
+	then $(MAKE) install-liarc-bundle; fi
 
 gtk-shim.so: gtk-shim.o scmwidget.o gtkio.o
 	$(LINK_SHIM) $^ `pkg-config --libs gtk+-2.0`
@@ -49,10 +51,11 @@ scmwidget.o: scmwidget.c
 scmwidget.c: scmwidget.c.stay
 	cp -p scmwidget.c.stay scmwidget.c
 
-# $(COMPILE) will not do.  Its DEFS conflict (cause warnings) with config.h.
+# COMPILE_SHIM will not do.  COMPILE's DEFS conflict (cause warnings)
+# with config.h.  This is COMPILE_SHIM without DEFS.
 gtkio.o: gtkio.c
-	$(CC) $(CPPFLAGS) $(CFLAGS) `pkg-config --cflags gtk+-2.0` \
-		-I../microcode -c $<
+	$(CC) $(CPPFLAGS) $(CFLAGS) $(SHIM_CFLAGS) \
+		`pkg-config --cflags gtk+-2.0` -I../microcode -c $<
 
 gtkio.c: gtkio.c.stay
 	cp -p gtkio.c.stay gtkio.c
@@ -61,12 +64,13 @@ gtk-shim.o: gtk-shim.c gtk-shim.h ../lib/mit-scheme.h
 	$(COMPILE_SHIM) `pkg-config --cflags gtk+-2.0` -o $@ -c $<
 
 gtk-shim.c gtk-const.c gtk-types.bin: gtk.cdecl Includes/*.cdecl
-	(echo "(load-option 'FFI)"; \
-	 echo '(C-generate "gtk" "#include \"gtk-shim.h\"")') \
-	| $(MIT_SCHEME_EXE) --batch-mode
+	( echo "(load-option 'FFI)"; \
+	  echo '(C-generate "gtk" "#include \"gtk-shim.h\"")' ) \
+	| ../microcode/scheme --library ../lib --batch-mode
 
 gtk-const.bin: gtk-const.scm
-	echo '(sf "gtk-const")' | $(MIT_SCHEME_EXE) --batch-mode
+	echo '(sf "gtk-const")' \
+	| ../microcode/scheme --library ../lib --batch-mode
 
 gtk-const.scm: gtk-const
 	./gtk-const
@@ -77,3 +81,5 @@ gtk-const: gtk-const.o
 
 gtk-const.o: gtk-const.c
 	$(CC) $(CFLAGS) `pkg-config --cflags gtk+-2.0` -o $@ -c $<
+
+.PHONY: build compile
diff --git a/src/gtk/gtk-shim.h b/src/gtk/gtk-shim.h
index 5c94c3b18..a96333f68 100644
--- a/src/gtk/gtk-shim.h
+++ b/src/gtk/gtk-shim.h
@@ -50,7 +50,7 @@ extern GtkWidget* scm_widget_new (void);
 
 extern void     gtk_main_plus (void);
 extern void     gtk_main_plus_quit (void);
-extern void     run_gtk (ulong registry, double time);
+extern void     run_gtk (unsigned long registry, double time);
 extern gboolean gtk_time_slice_window_p (void);
 extern void     gtk_time_slice_window (gboolean open_p);
 extern gboolean gtk_select_trace_p (void);
diff --git a/src/gtk/gtkio.c.stay b/src/gtk/gtkio.c.stay
index 7f58d017e..259c06cbf 100644
--- a/src/gtk/gtkio.c.stay
+++ b/src/gtk/gtkio.c.stay
@@ -329,7 +329,7 @@ gtk_main_plus_quit (void)
 }
 
 void
-run_gtk (select_registry_t r, double time)
+run_gtk (unsigned long registry, double time)
 {
   /* Return to the toolkit with the scheme_source set up to dispatch
      to Scheme again when I/O is ready, or a certain TIME has passed.
@@ -337,7 +337,9 @@ run_gtk (select_registry_t r, double time)
      Scheme is ready to run again immediately.  If I/O is empty, the
      simulated poll should not re-enter Scheme until TIME. */
 
-  set_registry (scheme_source, gtk_registry (r), time);
+  set_registry (scheme_source,
+		gtk_registry ((select_registry_t)registry),
+		time);
   if (tracing_gtk_select)
     {
       GSList * gpollfds = scheme_source->gpollfds;
-- 
2.25.1