Guile (Bernard URBAN's Hobbit post)

Article: 19068 of comp.lang.scheme
Xref: uchinews comp.lang.scheme:19068
Path: uchinews!news.spss.com!newsrelay.netins.net!mr.net!news.maxwell.syr.edu!howland.erols.net!math.ohio-state.edu!jussieu.fr!unilim.fr!cict.fr!news
From: urban@bastet.cnrm.meteo.fr (Bernard URBAN)
Newsgroups: comp.lang.scheme
Subject: Hobbit compiler for Guile (long)
Date: 05 May 1997 11:03:32 +0200
Organization: Meteo France
Lines: 297
Message-ID: 
References: <5jv4qj$p22$1@agate.berkeley.edu>
	
NNTP-Posting-Host: 137.129.166.4
In-reply-to: urban@bastet.cnrm.meteo.fr's message of 02 May 1997 11:34:07
	+0200
X-Newsreader: Gnus v5.1

Hello!

Here the promised patches to obtain a workable Hobbit for Guile.

1) First, you need a correst version of equal?, which seems buggy in recents snapshots. So, replace file libguile/eq.c by the following, and recompile libguile:

/*	Copyright (C) 1995,1996 Free Software Foundation, Inc.
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.  
 */

#include 
#include "_scm.h"
#include "ramap.h"
#include "stackchk.h"
#include "strorder.h"
#include "smob.h"
#include "unif.h"

#include "eq.h"

SCM_PROC1 (s_eq_p, "eq?", scm_tc7_rpsubr, scm_eq_p);

SCM
scm_eq_p (x, y)
     SCM x;
     SCM y;
{
  return ((x==y)
	  ? SCM_BOOL_T
	  : SCM_BOOL_F);
}


SCM_PROC1 (s_eqv_p, "eqv?", scm_tc7_rpsubr, scm_eqv_p);

SCM
scm_eqv_p (x, y)
     SCM x;
     SCM y;
{
  if (x==y) return SCM_BOOL_T;
  if SCM_IMP(x) return SCM_BOOL_F;
  if SCM_IMP(y) return SCM_BOOL_F;
  /* this ensures that types and scm_length are the same. */
  if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;
  if SCM_NUMP(x) {
# ifdef SCM_BIGDIG
    if SCM_BIGP(x) return (0==scm_bigcomp(x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
# endif
#ifdef SCM_FLOATS
    if (SCM_REALPART(x) != SCM_REALPART(y)) return SCM_BOOL_F;
    if (SCM_CPLXP(x) && (SCM_IMAG(x) != SCM_IMAG(y))) return SCM_BOOL_F;
#endif
    return SCM_BOOL_T;
  }
  return SCM_BOOL_F;
}


SCM_PROC1 (s_equal_p, "equal?", scm_tc7_rpsubr, scm_equal_p);

SCM
scm_equal_p (x, y)
     SCM x;
     SCM y;
{
  SCM_CHECK_STACK;
 tailrecurse: SCM_ASYNC_TICK;
	if (x==y) return SCM_BOOL_T;
	if (SCM_IMP(x)) return SCM_BOOL_F;
	if (SCM_IMP(y)) return SCM_BOOL_F;
	if (SCM_CONSP(x) && SCM_CONSP(y)) {
		if SCM_FALSEP(scm_equal_p(SCM_CAR(x), SCM_CAR(y))) return SCM_BOOL_F;
		x = SCM_CDR(x);
		y = SCM_CDR(y);
		goto tailrecurse;
	}
	/* this ensures that types and scm_length are the same. */
	if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;
	switch (SCM_TYP7(x)) {
        default: return SCM_BOOL_F;
	case scm_tc7_substring:
	case scm_tc7_mb_substring:
	case scm_tc7_mb_string:
	case scm_tc7_string: return scm_string_equal_p(x, y);
	case scm_tc7_vector:
	case scm_tc7_wvect:
	  return scm_vector_equal_p(x, y);
	case scm_tc7_smob: {
	        int i = SCM_SMOBNUM(x);
	        if (!(i < scm_numsmob)) return SCM_BOOL_F;
	        if (scm_smobs[i].equalp)
		  return (scm_smobs[i].equalp)(x, y);
		else
		  return SCM_BOOL_F;
	      }
	case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
	case scm_tc7_fvect:	case scm_tc7_cvect: case scm_tc7_dvect:
	case scm_tc7_svect:
#ifdef LONGLONGS
	case scm_tc7_llvect:
#endif
	case scm_tc7_byvect:
	  if (   scm_tc16_array
	      && scm_smobs[0x0ff & (scm_tc16_array >> 8)].equalp)
	    return scm_array_equal_p(x, y);
	}
	return SCM_BOOL_F;
}


void
scm_init_eq ()
{
#include "eq.x"
}

2) Now apply the following diffs to file hobbit.scm from the hobbit4d release:

diff -C 2 ~/floppy/newhobbit.scm ~/src/gnu/Scheme/hobbit4d/scm/hobbit.scm 
*** /users/aad/urban/floppy/newhobbit.scm	Mon May  5 04:55:34 1997
--- /users/aad/urban/src/gnu/Scheme/hobbit4d/scm/hobbit.scm	Mon Jun 12 16:34:27 1995
***************
*** 342,346 ****
  ;;; function for your file.
  
! (define *init-fun-prefix* "scm_init_")
  
  ;;; The following is a string which is prepended to the name of your
--- 342,346 ----
  ;;; function for your file.
  
! (define *init-fun-prefix* "init_")
  
  ;;; The following is a string which is prepended to the name of your
***************
*** 1886,1893 ****
  (define (display-c-lst lst par prefix)
   (let ((separator #\,))
!   (cond ((and par (char=? par #\())
  	    (set! separator #\,)
  	    (display-c #\() )
! 	((and par (char=? par #\{))
  	    (set! separator #\;)
  	    (display-c #\{) )
--- 1886,1893 ----
  (define (display-c-lst lst par prefix)
   (let ((separator #\,))
!   (cond ((char=? par #\()
  	    (set! separator #\,)
  	    (display-c #\() )
! 	((char=? par #\{)
  	    (set! separator #\;)
  	    (display-c #\{) )
***************
*** 1923,1929 ****
  	      (else
  		 (display-c-expression (car (my-last-pair lst)) #t) ))))
!   (cond ((and par (char=? par #\())
  	    (display-c #\)) )
! 	((and par (char=? par #\{))
  	    (display-c #\;)
  	    (display-c #\}) ))))
--- 1923,1929 ----
  	      (else
  		 (display-c-expression (car (my-last-pair lst)) #t) ))))
!   (cond ((char=? par #\()
  	    (display-c #\)) )
! 	((char=? par #\{)
  	    (display-c #\;)
  	    (display-c #\}) ))))





3) Remove from your compiling path existing scmhob.h files (there is
one in the libguile directory and of course in the hobbit4d
directory), and use the following:

#include 

/* Specifique a hobbit */
#define GLOBAL(x) (*(x))
#define VECTOR_SET(v,k,o) (SCM_VELTS(v)[((long)SCM_INUM(k))] = o)
#define VECTOR_REF(v,k) (SCM_VELTS(v)[((long)SCM_INUM(k))])
#define VECTOR_LENGTH(v)  SCM_MAKINUM(SCM_LENGTH(v))

/* Pourrait etre mis dans le noyau de hobbit */
/*#define vector_fill_excl_ scm_vector_fill_x*/

/* Passage scm --> guile */
#define EOL SCM_EOL
#define CAR SCM_CAR
#define CDR SCM_CDR
#define NFALSEP SCM_NFALSEP
#define BOOL_F SCM_BOOL_F
#define BOOL_T SCM_BOOL_T
#define MAKINUM SCM_MAKINUM
#define listofnull scm_listofnull
#define tc7_subr_1 scm_tc7_subr_1
#define tc7_subr_2 scm_tc7_subr_2
#define tc7_subr_3 scm_tc7_subr_3
#define tc7_lsubr scm_tc7_lsubr
#define apply scm_apply
#define cons scm_cons
#define divide scm_divide
#define eqp scm_eq_p
#define evenp scm_even_p
#define greaterp scm_gr_p
#define lessp scm_less_p
#define lremainder scm_remainder
#define makrect scm_make_rectangular
#define product scm_product
#define sum scm_sum
#define difference scm_difference
#define intern scm_intern
#define make_subr scm_make_subr
#define make_vector(vec,fill) scm_make_vector((vec),(fill),SCM_BOOL_F)
#define absval scm_magnitude
#define string2number scm_string_to_number
#define makfromstr(x,y) scm_makfromstr((x),(y),0)
#define list_ref scm_list_ref


IMPORTANT!!!

This above file scmhob.h was created from an empty version by correcting the
compiler and linker errors which resulted in compiling some numerical
tests programs. IT IS FAR FROM COMPLETE. You will certainly need to
add more #define. File libguile/scmhob.h will give you a taste of the
size of a complete scmhob.h.


4) To compile foo.scm, run the guile interpreter, switch to module
(ice-9 slib) and load hobbit.scm. Then run (hobbit "foo.scm"). If all
went well, files foo.c and foo.h are created.

Then compile foo.c, and make sure foo.h and scmhob.h are in the search
path. You can then link the resulting foo.o in the guile interpreter
or in a standalone executable. You must of course call scm_init_foo()
during initialization.

And a remark to conclude: the above procedure will work
as long as the semantic of the internal Guile functions, the GC
mechanisms and probably some other aspects of Guile 
stay similar to these of SCM.
If this is no more the case, deep interventions on hobbit.scm will be necessary.

B. Urban


 2 Aug 2000 spacey