/*******************************************************************

                    Le-Lisp (r) version 15.22

		 Bibliothe`que d'Exe'cution en C
	 utilisable sur syste`me d`exploitation "a` la UN*X"

 *****************************************************************
 (r) Le-Lisp est une marque de'pose'e de l'INRIA
 *****************************************************************
 Ce fichier est en lecture seule.  Il est maintenu par :
       ILOG S.A.
       2 Avenue Gallie'ni
       BP 85
       94253 Gentilly Cedex
 *****************************************************************

$Header: lelisp.c,v 4.43 89/01/16 19:53:14 kuczynsk Exp $

 *******************************************************************/

/*      Liste des conditionnelles de compilation C :
        ============================================

  Les types et sous-types de syste`mes UNIX :

        S5                 : System V
             SPS9          :       sous-type Ridge SPS9
             SPS7          :       sous-type SPS7 SMX 5.1
             CADMUS        :       sous-type Cadmus
             HP9300        :       sous-type HP9000 se'rie 300
             LEWS          :       enleve les ← devant les defextern
             UNIGRAPH      :       enleve les ← devant les defextern
             IBMRT         :
        BSD4x              : Syste`me Berkeley
             BSD41         :    de type 4.1
             BSD42         :    de type 4.2
               SEQUENT     :       sous-type Sequent DYNIX

  Les traits pre'sents :

        FOREIGN :       les messages sont en Breton!
	PAGESIZE:	La taille des pages
	EXECORE :	L'image me'moire est un exe'cutable (a.out)

  Les autres options fournies a` la compilation C

        NBSYST  :       nume'ro du syste`me a` cre'er
        FILEINI  :      nom du fichier startup
        FILIT   :       indicateur de fichier initial
        LLBAN   :       indicateur de pre'sence de bannie`re
	PAGESIZE :      la taille d'une page me'moire
        TIMEUNIT :      fre'quence de l'horloge.
	LELISPDIR :	repertoire du systeme lelisp
*/


/*      Choix du numero du systeme :
        ----------------------------
        1 = VERSADOS,   2 = VME,        3 = MicroMega,  4 = APOLLO
        5 = SM90,       6 = PE32OS,     7 = PE32UNIX,   8 = VAXUNIX
        9 = VAXVMS,     10= multics,    11= METHEUS,    12= UNIVERSE68
        13= MCPM86,     14= PCDOS,      15= MACII,      16= VAXIS3,
        17= MAC,        18= SPS9,       19= BELLMAC,    20= VM370UTS,
        21= PCS,        22= SUN,	23= HP9000-300,	24= METAVISEUR,
	25= GOULD,	26= IBMRT,	27= PYRAMID,	28= SEQUENT
	29= UNIGRAPH,	30= CL1000,	31= CL1020,     32= TEKTRONIX 43xx,
        33= C,          34= DPX1000,	35= SUN4        36= ATARI,
        37= CONVEX.
 */

#ifndef NBSYST
#define NBSYST  22
#endif  NBSYST

/*      Les autres parametres dependants du systeme
        -------------------------------------------  */

#ifndef FILEINI    
#define FILEINI      "/usr/ilog/lelisp/llib/startup.ll"
#endif  FILEINI

#define FILIT 0      /* 0 = fichier initial, 1 = core */
#define LLBAN 0      /* 0 = banniere,  1 = silence */


/* la taille des pages (obtenu par pagesize(1) ou getpagesize(2) ou
   par la documentation). Doit etre une puissance de 2 >= BIPTR */

#ifndef PAGESIZE
#define PAGESIZE 1024
#endif  PAGESIZE

#define align(x) (x = ((x+PAGESIZE-1)&~(PAGESIZE-1)))

/*  Les tailles des zones (attention aux Unite's!)
    --------------------------------------------- */

/*  Les Unites avec lesquelles sont definies les zones  */

#define PTR     (sizeof (char *))
#define BIPTR	(PTR*2)
#define KPTR    (PTR*1024)

int SSTACK = 6;          /* en K objets de type pointeurs */
int SCODE  = 128;        /* en K octets */
int SHEAP  = 70;         /* en K octets */
int SNUMB  = 0;          /* en K objets de type entiers */
int SFLOAT = 1;          /* en K objets de type flottant */
int SVECT  = 1;          /* en K objets de type vecteur */
int SSTRG  = 3;          /* en K objets de type chaine */
int SSYMB  = 2;          /* en K objets de type symboles */
int SCONS  = 3;          /* en 8 K CONS */
int UCONS  = 0;          /* en 32 CONS */

/*  Si en mode debug, on n'arme pas les interruptions et on ne fait pas
    de stty.  Principalement pour adb.  */
int lldebug=0;


/* les include */

#include <sys/types.h> /* pour tout le monde */
#include <sys/stat.h>  /* pour tout le monde */
#include <signal.h>    /* pour les signaux */
#include <stdio.h>     /* pour les entre'es sorties */
#include <errno.h>     /* pour perror(), et le save-core BSD */
#include <a.out.h>     /* pour getglobal, et le save-core BSD */

    /* V-- cf page 3-218 AIX o/s guide */
#if IBMRT || LEWS || UNIGRAPH 
#undef n←name
#endif /* IBMRT LEWS UNIGRAPH */


#ifdef LEWS
       /* Les bibliotheques du LEWS exploitent ces traits */
#define u3b 0
#define vax 0
#define u3b5 0
#define sm90 1  /* pour nlist (dans a.out.h) */
#define ridge 0
#endif LEWS

#ifdef BSD42           /* pour runtime */
#include <sys/time.h>
#include <sys/resource.h>
#else BSD42
#include <time.h>
#ifdef Perkin          /* le Perkin n'a pas l'include sys/times.h */
struct tms {
        long    tms←utime;
        long    proc←system←time;
        long    child←user←time;
        long    child←system←time;
};
#else Perkin
#include <sys/times.h> /* pour les autres */
#endif Perkin
#endif BSD42

#ifdef VAXUNIX
#define N←DATADDR(gg) gg.a←text
#endif VAXUNIX

/* les point d'entree de Le-Lisp LLM3 */

extern host←start(), llstdio();
extern float  accusingle1;

/*
        Les variables globales Le-Lisp.
        Elles sont toutes definies dans LLINIT.LLM3
        mais doivent etre chargees ici.
 */

/* la pile d'evaluation de Le-Lisp */

extern char *bstack, *estack, *mstack1, *mstack2;

/* les limites des zones des differents types Le-Lisp */

extern  char    *bcode,  *ccode,  *ecode,
                *bheap,  *cheap,  *eheap,
                *bnumb,  *cnumb,
                *bfloat, *cfloat,
                *bvect,  *cvect,
                *bstrg,  *cstrg,
                *bsymb,  *csymb,
                *bcons,  *ccons,  *econs;

char *llucode, *lluheap;  /* fin des zones code et heap (trous) */

/* le fichier initial et la ligne de commande */

extern int filiz, filit;
extern char *filin;
extern int llban;

/* le numero (type) du systeme Le-Lisp */

extern int nbsyst;

/* Le flag controlant l'impression des erreurs syste`me */

extern int **prtmsgs;   /* il est dans le save-core ! */
#define  errreturn(M,V)   { if(**prtmsgs != 0) perror(M) ; return(V); }


/*
   Les variables du lanceur
   Elles ne sont pas sauve'es par save-core 
*/

/* tailles des zones */

int sstack, scode, sheap, snumb, sfloat, svect, sstrg, ssymb, scons;

/* bits invisibles */
int  stbin;
char *btbin;

/* bits du GC */
int stbgc;
char *btbgc;

/* debut et fin de la memoire */
char *bmem;
char *emem;


#ifdef EXECORE
/* Environnement Shell initial (pour le restore-core BSD) */
char **envpini;
#endif EXECORE

/* Path absolu du repertoire lelisp */
char *lelisp←racine;

/* Path absolu du binaire lelispbin */
char lelispbin[256];

char *getenv();

/* les variables et fonctions du cload */

char *mktemp();
char template[] = "/tmp/lelisp←XXXXXX";


/* 
   Points d'entree 
*/

/* Pour les erreurs */
int out(), oupps();
char *usage();

/* 
  References externes
*/

/* Allocation de la me'moire */
extern char *brk();
extern char *sbrk();
#define RATE (char *) -1
char *END;


/********************************************************


                Gestion du Terminal


 ********************************************************/


#ifdef S5
#include <fcntl.h>
#include <termio.h>
#endif S5

#ifdef BSD4x
#include <sgtty.h>
#endif BSD4x

#ifdef S5
struct termio tioini, tiolisp;              /* les termio initiaux et lisp */
#endif S5

#ifdef BSD4x
struct sgttyb ttyini, ttylisp;	            /* les stty initiaux et lisp */
#endif BSD4x

int realterminal = 0;                       /* =0 c'est un vrai terminal */

extern init←stty();
extern lisp←stty();
extern unix←stty();


/* init←stty: intialise les structures stty initiales
   -------------------------------------------------- */

init←stty () {
	realterminal = isatty(0);	    /* est-on interactif ? */
	if (realterminal != 0) {
#ifdef S5
		(void) ioctl(0, TCGETA, &tioini); /* prend le tty initial */
		(void) ioctl(0, TCGETA, &tiolisp);
		tiolisp.c←cc[VMIN] = 6;
		tiolisp.c←cc[VTIME] = 1;
		tiolisp.c←iflag &= ~(IGNBRK|INLCR|ICRNL);
		tiolisp.c←iflag |= BRKINT;
		tiolisp.c←oflag &= ~(OPOST|ONLCR|OCRNL|ONOCR|ONLRET);
		tiolisp.c←lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL|NOFLSH);
		tiolisp.c←lflag |= ISIG;
		(void) ioctl(0, TCSETAF, &tiolisp); /* mets le tty lisp */
#endif S5

#ifdef BSD4x
		(void) gtty(0, &ttyini);    /* prend le tty initial */
		(void) gtty(0, &ttylisp);   /* recopie' dans le tty lisp */
		ttylisp.sg←flags |= CBREAK; /* Lisp est en cbreak -echo -nl */
		ttylisp.sg←flags &= ~(ECHO|CRMOD);
#endif BSD4x
	}
}

/* lisp←stty: passe le terminal en mode Le-Lisp
   -------------------------------------------- */

lisp←stty () {
	if (realterminal != 0)
#ifdef S5
		(void) ioctl(0, TCSETAF, &tiolisp);
#endif S5

#ifdef BSD4x
		(void) stty(0, &ttylisp);
#endif BSD4x
}

/* unix←stty: passe le terminal en mode UN*X
   ----------------------------------------- */

unix←stty () {
	if (realterminal != 0)
#ifdef S5
		(void) ioctl(0, TCSETAF, &tioini);
#endif S5

#ifdef BSD4x
		(void) stty(0, &ttyini);
#endif BSD4x
}


/********************************************************


                Gestion de la Signalerie UN*X


 ********************************************************/


extern ll←break();             /* dans ../<system>/ll<system>.llm3 */
extern ll←merro();
extern ll←clock();

#ifdef BSD41
onstop41(signo)			/* gestion du "stopped job" ↑Z sous BSD 4.1 */
int signo;
{
	unix←stty();
	sigset(signo, SIG←DFL); 
	kill(0, signo);
	sigset(signo, onstop41); 
}
oncont41(signo)			/* repasse en Lisp */
int signo;
{
	lisp←stty();
}
#endif BSD41

#ifdef BSD42
onstop42(signo)			/* gestion du "stopped job" ↑Z sous BSD 4.2 */
int signo;
{
	unix←stty();
 	signal(SIGTSTP, SIG←DFL);
	killpg(getpgrp(0), signo);
}

oncont42(signo)			/* repasse en mode Lisp */
int signo;
{
	lisp←stty();
	signal(SIGTSTP, onstop42); 
}

shstop42(signo)			/* pendant un COMLINE */
int signo;
{
 	signal(SIGTSTP, SIG←DFL);
	killpg(getpgrp(0), signo);
}

shcont42(signo)			/* pendant un COMLINE */
int signo;
{
	signal(SIGTSTP, shstop42); 
}

#endif BSD42

/* init←signal: intialise les signaux UN*X ge're's par Le-Lisp
   ----------------------------------------------------------- */

init←signal() {
	int i;
	if ( lldebug == 0 ) {
		for(i = 3 ; i <= 12; signal(i++, oupps));
#ifdef BSD41
		sigset(SIGTSTP, onstop41); 
		sigset(SIGCONT, oncont41);  
#endif BSD41
		
#ifdef BSD42
		signal(SIGTSTP, onstop42); 
		signal(SIGCONT, oncont42);  
#endif BSD42
	}
}

/* pour e'viter un "core-dumped" pour les mauvais signaux */

oupps(n) {
#ifdef FOREIGN
        fprintf(stderr, "Le-Lisp : I quit on signal %d\r\n", n);
#else  FOREIGN
        fprintf(stderr, "signal %d\r\n", n);
        fprintf(stderr, "OUPPS! J'ai failli faire un core\r\n");
#endif FOREIGN
        out(-1);
}

int←ign () {
        if (realterminal != 0)
          signal(SIGINT,  SIG←IGN);     /* interrupt */
        signal(SIGILL,  SIG←IGN);       /* illegal instruction */
        signal(SIGBUS,  SIG←IGN);       /* bus error */
        signal(SIGSEGV, SIG←IGN);       /* segmentation violation */
	signal(SIGTRAP, SIG←IGN);       /* trace trap */
        signal(SIGFPE,  SIG←IGN);       /* floating point exception */
#ifdef BSD42
        signal(SIGTSTP, shstop42);      /* stop generated from keyboard */
        signal(SIGCONT, shcont42);      /* continue after stop */
#endif
      };

/* int←std: passe en mode signaux standard pour le COMLINE
   ------------------------------------------------------- */

int←std() {
        if (realterminal != 0)
          signal(SIGINT,  SIG←DFL);     /* interrupt */
        signal(SIGILL,  SIG←DFL);       /* illegal instruction */
        signal(SIGBUS,  SIG←DFL);       /* bus error */
        signal(SIGSEGV, SIG←DFL);       /* segmentation violation */
	signal(SIGTRAP, SIG←DFL);       /* trace trap */
        signal(SIGFPE,  SIG←DFL);       /* floating point exception */
#ifdef BSD42
        signal(SIGTSTP, SIG←DFL);       /* stop generated from keyboard */
        signal(SIGCONT, SIG←DFL);       /* continue after stop */
#endif
};

/* inton: arme les signaux UN*X qui seront ge're's par Le-Lisp
   ----------------------------------------------------------- */

inton () {

	if ( lldebug == 0 ) {
		if (realterminal != 0)
			signal(SIGINT,  ll←break);     /* interrupt */
		signal(SIGILL,  ll←merro);       /* illegal instruction */
		signal(SIGBUS,  ll←merro);       /* bus error */
		signal(SIGSEGV, ll←merro);       /* segmentation violation */
		signal(SIGTRAP, ll←merro);       /* trace trap */
		signal(SIGFPE,  ll←merro);       /* floating point exception */
		signal(SIGALRM, ll←clock);       /* alarm clock */
		
#ifdef BSD42
		signal(SIGTSTP, onstop42); 
		signal(SIGCONT, oncont42);  
		sigsetmask(0);
#endif BSD42
		
#ifdef IBMRT
		signal(SIGDANGER, ll←merro);     /* impending lack of page space */
#endif IBMRT
	}
}               

/* intoff: de'sarme les signaux UN*X ge're's par Le-Lisp
   ----------------------------------------------------- */

/* ?!?!?! ou` est le code S5 ?!?!? */

intoff () {

	if ( lldebug == 0 ) {
		
#ifdef BSD42
#define mask(s) (1 << ((s)-1))
		return(sigblock (mask (SIGALRM) | mask(SIGINT)));
#else  BSD42
		if (realterminal != 0)
			signal(SIGINT,  SIG←IGN);
#endif BSD42
	}
}               



/*******************************************

                   INLELISP   (pour ne pas dire MAIN !!)
           point d'entree de Le-Lisp

 *******************************************/

inlelisp(argc, argv, envp)
int argc; char **argv, **envp; {
int n, size;
int verbose=0;

#ifdef EXECORE
        int selfcore = 0;
#endif EXECORE


#ifdef EXECORE
        envpini = envp;     /* sauvegarde de l'environnement Shell */
#endif EXECORE

        init←signal();      /* initialisation des signaux */

        filin  = FILEINI;    /* initialisation des valeurs par defaut */
        filit  = FILIT;
        llban  = LLBAN;
        nbsyst = NBSYST;

#ifdef HP9300
	lelisp←racine = LELISPDIR;
#endif HP9300

        /* De'cryptage des  arguments
           Le premier argument est TOUJOURS le path absolu de lelispbin
           L'argument 0 est le path absolu du binaire */

        strcpy(lelispbin, argv[0]);

#define suitarg() ((++n >= argc) ? usage() : *(argv+n))
#define checkarg(s) (!strcmp(s,*(argv+n)))

        for(n = 1; n < argc; n++){
                if((**(argv+n) >= '0') && (**(argv+n) <= '9')) {
                       SCONS = atoi(*(argv+n)); continue; }
                if(**(argv+n) == '-'){
#ifdef EXECORE
                     if(checkarg("-c")){
                       selfcore = 1; continue; }
#endif EXECORE
                     if(checkarg("-s")){
                       llban = 1; continue; }
                     if(checkarg("-r")) {
                       filit = 1; filin = suitarg(); continue; }
		     if(checkarg("-debug")) {
		       lldebug = 1; continue; }
                     if(checkarg("-v")) {
                       verbose = 1; continue; }
                     if(checkarg("-stack")) {
                       SSTACK = atoi(suitarg()); continue; }
                     if(checkarg("-code")) {
                       SCODE = atoi(suitarg()); continue; }
                     if(checkarg("-heap")) {
                       SHEAP = atoi(suitarg()); continue; }
                     if(checkarg("-number")) {
                       SNUMB = atoi(suitarg()); continue; }
                     if(checkarg("-float")) {
                       SFLOAT = atoi(suitarg()); continue; }
                     if(checkarg("-vector")) {
                       SVECT = atoi(suitarg()); continue; }
                     if(checkarg("-string")) {
                       SSTRG = atoi(suitarg()); continue; }
                     if(checkarg("-symbol")) {
                       SSYMB = atoi(suitarg()); continue; }
                     if(checkarg("-cons")) {
                       SCONS = atoi(suitarg()); continue; }
                     if(checkarg("-ucons")) {
                       UCONS = atoi(suitarg()); continue; }
                     (void) usage();
                 }
                 filit = 0; filin = *(argv+n);
        }
        filiz=strlen(filin);

        if( lldebug == 0 )      
                 init←stty();        /* initialisation du terminal */


        sstack = SSTACK * KPTR;
        scode  = SCODE  * 1024;
        sheap  = SHEAP  * 1024;
        snumb  = SNUMB  * KPTR;
        sfloat = SFLOAT * KPTR * 2;
        svect  = SVECT  * KPTR * 2;
        sstrg  = SSTRG  * KPTR * 2;
        ssymb  = SSYMB  * KPTR * 8;         /* symbole = 8 pointeurs */
        scons  = SCONS  * KPTR * 16;        /* c'est en 8K CONS */
        scons  += UCONS * PTR * 64;         /* c'est en paquet de 32 CONS*/

        /* 
           Verifications des arguments.
           Les zones FLOAT (flottants 31 bits) et NUMB (Toutes machines)
           peuvent e↑tre demande'es vides
        */

	align(snumb);
	align(sfloat);
        align(scode);

#define nozero(zone, nom) if(zone == 0) zonevide(nom)

        nozero(sstack,"stack"); align(sstack);
        nozero(sheap,"heap");   align(sheap);
        nozero(svect,"vector"); align(svect);
        nozero(sstrg,"string"); align(sstrg);
        nozero(ssymb,"symbol"); align(ssymb);
        nozero(scons,"cons");   align(scons);


        /*  
           Calcul de la taille de la me'moire
        */

        stbin = scons / 64;   /* taille de la table des bits invisibles */
	align(stbin); 

        stbgc = (snumb+sfloat+svect+sstrg+ssymb+scons)/64; /* bits GC */

	align(stbgc); 

        /* en 2 coups a cause des limites de certains compilos C */

        size = sstack+scode+sheap+svect;
        size = size+snumb+sfloat+sstrg+ssymb+scons+stbin+stbgc;

if ( verbose ) 
       {printf("FILIT   %3d\r\n", filit);
        printf("FILIN   %s\r\n", filin);
	printf("Tailles des zones me'moires (octets)\r\n");
        printf("pile             %8d\r\n", sstack);
        printf("code             %8d\r\n", scode);
        printf("tas              %8d\r\n", sheap);
        printf("nombres          %8d\r\n", snumb);
        printf("flottants        %8d\r\n", sfloat);
        printf("vecteurs         %8d\r\n", svect);
        printf("strings          %8d\r\n", sstrg);
        printf("symboles         %8d\r\n", ssymb);
	printf("cons		 %8d\r\n", scons);
        printf("bits invisibles  %8d\r\n", stbin);
        printf("bits de marquage %8d\r\n", stbgc);
        printf("    total        %8d\r\n", size);
       }

#ifdef EXECORE
        if(selfcore == 1){
          corinit();        /* restauration turbo */
          out(-1);          /* au cas ou on rentrerait */
        }
#endif EXECORE

        if (filiz) {
            if (close(open(filin, 0)) != 0){
#ifdef FOREIGN
               fprintf(stderr, "Le-Lisp : cannot find file %s\r\n", filin);
#else FOREIGN
               fprintf(stderr, "Le-Lisp : je ne trouve pas le fichier %s\r\n",
                                                     filin);
#endif FOREIGN
               out(-1);
            }
#ifdef EXECORE
            if (filit == 1) {
               int dummy;
               int *pdummy;

               dummy = 1;
               pdummy = &dummy;
               prtmsgs = &pdummy;	/* **prtmsgs existe */
               corest(filin);
               out(-1);
	    }
#endif EXECORE
	}

        /*
           Allocation de la me'moire 
        */

	/* Pour pre'allouer ce qu'il faut pour un GETGLOBAL et e'viter
           que le MALLOC n'aille prendre de la place n'importe ou` */

#ifdef BSD4x
	(void) getgloba("start");
#endif BSD4x

	bmem = sbrk(0);
	bmem = (char *) (((long)bmem+PAGESIZE-1)&~(PAGESIZE-1));
	(void) brk(bmem);
        bmem = sbrk(size);

        if(bmem == RATE){
#ifdef FOREIGN
          fprintf(stderr, "Le-Lisp : I can't get required memory space\r\n");
#else FOREIGN
          fprintf(stderr,
                    "Le-Lisp : Impossible d'allouer tant de memoire\r\n");
#endif FOREIGN
          out(-1);
        }

	END = sbrk(0);		/* pour voir si malloc prend de la place */

        /* chargement des variables pre'de'finies */

        estack  = bmem + (4 * PTR);         /* tole'rance minimale */
        mstack2 = estack + (128 * PTR);     /* Full Stack non re'cupe'rable */
        mstack1 = estack + (1024 * PTR);    /* Full Stack re'cupe'rable */
        bstack  = estack + sstack - PTR;

        bcode  = bstack + PTR;
        ccode  = bcode;
        ecode  = bcode + scode;

        bheap  = ecode;
        cheap  = bheap;
        eheap  = bheap + sheap;

        bnumb  = eheap;
        cnumb  = bnumb;

        bfloat = bnumb + snumb;
        cfloat = bfloat;

        bvect  = bfloat + sfloat;
        cvect  = bvect;

        bstrg  = bvect + svect;
        cstrg  = bstrg;

        bsymb  = bstrg + sstrg;
        csymb  = bsymb;

        bcons  = bsymb + ssymb;
	econs  = bcons + scons;
        ccons  = bcons;

        btbin  = econs;
        btbgc  = btbin + stbin;
        emem   = btbgc;

        /* et on y va !!! */

        llstdio();
        lisp←stty();
        host←start();

        /* au retour (si l'on rentre) on sort joliement */

        out(0);
}


/**********************************************************

         L E S    I M A G E S     M E M O I R E S         

 **********************************************************/


/*   l'instruction LLM3 CORSAV doit positionner les 4 variables:
     bllm3, ellm3 limites de la zone impure LLM3
     llucode      fin de la zone code utilise'e
     lluheap      fin de la zone heap utilise'e     */

char *bllm3, *ellm3;


/* Pour ne faire que des petites entrees/sorties (cf NFS ...) */

#ifndef WRITESIZE
#define WRITESIZE 8192
#endif  WRITESIZE

WRITE(fd,where,length)
int fd, length;
char *where;
{
	int cc, n;

/* Si on veut une trace e'crite: */
/* printf("WRITE: %d %x  %x \r\n", fd, where, length); */
	n = length;
	while(n >= WRITESIZE) {
		if ((cc = write(fd, where, WRITESIZE)) < 0)
			return(cc);
		where += cc;
		n -= cc;
	}
	while(n > 0) {
		if ((cc = write(fd, where, n)) < 0)
			return(cc);
		where += cc;
		n -= cc;
	}
	return(length);
}


/************************************
 Les images me'moires en mode EXECORE
 ************************************/

#ifdef EXECORE

/* Point de lancement effectif */

extern llcorgo(); /* dans ../<system>/ll<system>.llm3 */

/* Variables positionnees au moment du save-core BSD4x */

int corscons;  /* taille des CONS de l'image me'moire */
int corstbin;  /* bits invisibles de l'image me'moire */
char *corbtbin;

/***********
    Le lancement direct (lelispbin -c) d'une image me'moire
    re'alise'e en mode EXECORE.
***********/

extern corinit();

corinit () {
	int diffcons;
	int diffmem;
	int i;

        if (scons > corscons) {
	   if (sbrk(0) != END)
#ifdef FOREIGN
	      fprintf (stderr,
		       "Le-Lisp : I can't allocate space without hole\r\n");
#else FOREIGN
	      fprintf (stderr,
		 "Le-Lisp : je ne peux pas allouer de la place sans trou\r\n");
#endif FOREIGN
	   else {
		/* l'image memoire est plus petite que lelisp courant */
		diffcons = (scons - corscons);
		/* bits invisibles */
		diffmem = diffcons + (diffcons / 64);
		/* bits du GC */
		diffmem += diffcons / 64;
		align(diffmem);

		if (sbrk(diffmem) == RATE) {
#ifdef FOREIGN
		   fprintf (stderr,
		     "Le-Lisp : not enough ressources to allocate space\r\n");
#else FOREIGN
		   fprintf (stderr,
		     "Le-Lisp : Impossible de vous fournir tant de place\r\n");
#endif FOREIGN
		   out(-1);
	        }

                econs += diffcons;
                btbin = econs;
                for (i = corstbin; --i >= 0;)
		    btbin[i] = corbtbin[i];

                btbgc = btbin + stbin;

		END = sbrk(0);
		}
	}
        inton();
        llcorgo();
}


/**********
   Save-core en mode EXECORE
***********/

struct exec entete;
char corbuf[1024];

extern int errno;

int corsav (nom) char *nom; {
int fd, fdbin;
long symbols;
long bout;
int n, wr;

        llglobb("","",-1);                /* pour tuer un sous-sh */

        /* positionne les variables pour le restore-core */
        corscons = scons;
        corbtbin = btbin;
        corstbin = stbin;

        if((fdbin = open(lelispbin, 0)) == -1)
          errreturn(lelispbin, 1);

        read(fdbin, &entete, sizeof (struct exec));

        if((fd = creat(nom, 0777)) /* rwxrwxrwx | umask */
	    == -1){
                if(errno != ETXTBSY) 
                        errreturn(nom, 1);
                if(unlink(nom) == -1)
                        errreturn(nom, 1);
                if((fd = creat(nom, 0777)) /* rwxrwxrwx | umask */
		   == -1)
                        errreturn(nom, 1);
        }
                                
        bout = (long) sbrk(0);

/* c'est la table des symboles de lelispbin qui nous interesse,
   Il faut la calculer avant de changer le champ entete.a←data */
        symbols = N←SYMOFF(entete);

        entete.a←data = bout - N←DATADDR(entete);
        entete.a←bss = 0;
	entete.a←magic = ZMAGIC;
			/* le header */
        write(fd, &entete, sizeof(struct exec));

#ifdef SEQUENT
/* recopie du texte */
	n = N←DATAOFF(entete) - sizeof(struct exec);
	while (n >= 1024) {
	    read(fdbin, corbuf, 1024);
	    WRITE(fd, corbuf, 1024);
	    n -= 1024;
	}
	read(fdbin, corbuf, n);
	WRITE(fd, corbuf, n);
	WRITE(fd, entete.a←text, llucode - entete.a←text); /* le bas de lisp */
#else  SEQUENT
#ifdef VAXUNIX
        lseek(fd, N←TXTOFF(entete), 0);              /* va au debut du texte */
	write(fd, 0L, llucode);                      /* le bas de lisp */
#endif VAXUNIX
#endif SEQUENT
#ifdef VAXUNIX || SEQUENT
	lseek(fd, bheap-llucode, 1);		     /* le trou fin de code */
	WRITE(fd, bheap, lluheap-bheap);             /* le tas */
	lseek(fd, bnumb-lluheap, 1);		     /* le trou fin de tas */
	WRITE(fd, bnumb, econs-bnumb);		     /* le reste */
	WRITE(fd, btbin, stbin);		     /* les bits invisibles */
	lseek(fd, bout-(long)btbin-stbin, 1);
#else VAXUNIX || SEQUENT
/* recopie du texte */
	n = entete.a←text - sizeof(struct exec);
	while (n >= 1024) {
	    read(fdbin, corbuf, 1024);
	    wr=write(fd, corbuf, 1024);
	    if(wr != 1024) { perror ("save-core1"); exit(1); }
	    n -= 1024;
	}
	    read(fdbin, corbuf, n);
	    wr=write(fd, corbuf, n);
	    if(wr != n) { perror ("save-core1.1"); exit(1); }

/* le data */
	wr=write(fd, N←DATADDR(entete), bout - N←DATADDR(entete));
        if(wr != (int)bout-N←DATADDR(entete))
	  { perror ("save-core2"); exit(1);}
#endif VAXUNIX || SEQUENT
/* le symbol */     /* on ajuste, normalement 0 sauf sur Sequent */
        lseek(fdbin, symbols, 0);
        while ((n = read(fdbin, corbuf, 1024)) > 0)
              WRITE(fd, corbuf, n);

        close(fdbin);
        close(fd);
/*      chmod(nom, 493);    -rwxr-xr-x Pour garder le umask du user (creat).*/
        return(0);
}

/**********
   Restore-core en mode EXECORE
***********/


char *corargv[5] = { "lelispbin", "003", "003", "-c", 0};

int corest (nom) char *nom; {
int fd, i;
	corargv[0] = nom;		/* convention Unix */
        if ((fd = open(nom, 0)) == -1)
		errreturn(nom, 1);
        close(fd);
        sprintf(corargv[2], "%d", scons/(8*8*1024));
        execve(nom, corargv, envpini);
        errreturn (nom, 1);
}

#else EXECORE

/*************************************
 Les images me'moires en mode standard
 *************************************

  L'ente↑te des fichiers image-me'moire contient :
    - 3 mots d'identification (12 caracte`res)
    - les tailles des zones de l'image me'moire
        corsstack
        corscode
        corsheap
        corsnumb
        corsfloat
        corsvect
        corsstrg
        corssymb
        corscons
        corstbin
    - les tailles des bouts me'moires sauve's
        sllm3
        ucode
        uheap
        urest
*/

#define ID "lelisp core "

struct ENTETE {
        char idlelisp[12];

        int corsstack;
        int corscode;
        int corsheap;
        int corsnumb;
        int corsfloat;
        int corsvect;
        int corsstrg;
        int corssymb;
        int corscons;
        int corstbin;

        int sllm3;
        int ucode;
        int uheap;
        int urest;
} entete;


/**********
   Save-core en mode standard
***********/

int corsav (nom) char *nom; {
int fd;

        if((fd = creat(nom, 511)) == -1)
          errreturn(nom, 1);


        strncpy(entete.idlelisp, ID, 12);

        entete.corsstack = sstack;
        entete.corscode  = scode;
        entete.corsheap  = sheap;
        entete.corsnumb  = snumb;
        entete.corsfloat = sfloat;
        entete.corsvect  = svect;
        entete.corsstrg  = sstrg;
        entete.corssymb  = ssymb;
        entete.corscons  = scons;
        entete.corstbin  = stbin;

        entete.sllm3 = ellm3 - bllm3;
        entete.ucode = llucode - bmem;
        entete.uheap = lluheap - bheap;
        entete.urest = econs - bnumb;

        if(WRITE(fd, &entete, sizeof(struct ENTETE))
                                    != sizeof(struct ENTETE)){
                                                    /* entete */
                close(fd);
                errreturn(nom, 1);  
        }
        if((WRITE(fd, bllm3, entete.sllm3)) != entete.sllm3){ 
                                                    /* variables LLM3 */
                close(fd);
                errreturn(nom, 1);  
        }
        if((WRITE(fd, bmem, entete.ucode)) != entete.ucode){
                                                    /* code utilise' */
                close(fd);
                errreturn(nom, 1);  
        }
        if((WRITE(fd, bheap, entete.uheap)) != entete.uheap){
                                                    /* heap utilise' */
                close(fd);
                errreturn(nom, 1);  
        }
        if((WRITE(fd, bnumb, entete.urest)) != entete.urest){
                                                    /* zones lisp */
                close(fd);
                errreturn(nom, 1);  
        }
        if((WRITE(fd, btbin, entete.corstbin)) != entete.corstbin){
                                                    /* bits invisibles */
                close(fd);
                errreturn(nom, 1);  
        }

        if (close(fd) < 0)
                errreturn("Le-Lisp",1);
        return(0);
}

/**********
   Restore-core en mode standard
***********/

int READ(fd,where,length)
int fd, length;
char *where;
{
	int cc, n;

/* Si on veut une trace e'crite: */
/* printf("READ:  %d %x  %x \r\n", fd, where, length); */
	return(read(fd, where, length));
}

int corest (nom) char *nom; {
int fd;
        if((fd = open(nom, 0)) == -1)
          errreturn(nom, 1);

        if(READ(fd, &entete, sizeof(struct ENTETE))
                                 != sizeof(struct ENTETE)){
                                                  /* lit l'entete */
          close(fd);
          errreturn(nom, 1);
        }

        if(strncmp(entete.idlelisp, ID, 12)){
                                      /* chai↑ne d'identification */
#ifdef FOREIGN
          fprintf(stderr, "Le-Lisp : %s is not a core image\r\n", nom);
#else FOREIGN
          fprintf(stderr,
                   "Le-Lisp : %s n'est pas une image memoire\r\n", nom);
#endif FOREIGN
          close(fd);
          if ((prtmsgs == 0) || (*prtmsgs == 0)) out (-1);
          errreturn(nom, 1);
        }

        if((entete.corsstack    != sstack)
           || (entete.corscode  != scode)
           || (entete.corsheap  != sheap)
           || (entete.corsnumb  != snumb)
           || (entete.corsfloat != sfloat)
           || (entete.corsvect  != svect)
           || (entete.corsstrg  != sstrg)
           || (entete.corssymb  != ssymb)){   /* les tailles fixes */
#ifdef FOREIGN
          fprintf(stderr, 
                    "Le-Lisp : non compatible core image : %s\r\n", nom);
#else FOREIGN
          fprintf(stderr, 
                    "Le-Lisp : image memoire non compatible : %s\r\n", nom);
#endif FOREIGN
          close(fd);
          if ((prtmsgs == 0) || (*prtmsgs == 0)) out (-1);
          errreturn(nom, 1);}

        if(entete.corscons > scons){         /* trop gros ? */
#ifdef FOREIGN
          fprintf(stderr, "Le-Lisp : core image too large : %s\r\n", nom);
#else FOREIGN
          fprintf(stderr, "Le-Lisp : image memoire trop grosse : %s\r\n",
                                nom);
#endif FOREIGN
          close(fd);
          errreturn(nom, 1);
        }

        if((READ(fd, bllm3, entete.sllm3)) != entete.sllm3){ 
                                                    /* variables LLM3 */
                close(fd);
                errreturn(nom, 1);  
        }
        if((READ(fd, bmem, entete.ucode)) != entete.ucode){
                                                    /* code utilise' */
                close(fd);
                errreturn(nom, 1);  
        }
        if((READ(fd, bheap, entete.uheap)) != entete.uheap){
                                                    /* heap utilise' */
                close(fd);
                errreturn(nom, 1);  
        }
        if((READ(fd, bnumb, entete.urest)) != entete.urest){
                                                    /* zones lisp */
                close(fd);
                errreturn(nom, 1);  
        }
        if((READ(fd, btbin, entete.corstbin)) != entete.corstbin){
                                                    /* bits invisibles */
                close(fd);
                errreturn(nom, 1);  
        }

        close(fd);
        return(0);
}

#endif EXECORE

/**********************************************************

         cline: Envoi d'une commande au SHELL

 **********************************************************/


cline (buff)
char *buff;
{
    char *dir;
    if (!strncmp(buff, "cd", 2)) {  /* c'est peut-etre un cd */
	    dir = buff + 1;
	    while (*++dir == ' ')
		    /* void */ ;
	    if (*dir=='\0')
		    cchdir(getenv("HOME"));  /* cd tout court */
	    else if (dir != buff+2)
		    if (!cchdir(dir))		/* cd PATH */
                      return (0);
    }
    unix←stty();
    system(buff);
    lisp←stty();
    inton();
}

system(s)
char *s;
{
	int status, pid, w;

#ifdef BSD4x
	pid=vfork();    /* on forke astucieusement */
#endif
#ifdef S5
	pid =fork();   /* on ne vforke pas en systeme 5 */
#endif
	if (pid == 0) {
		{int f;
		 for(f = 3;f < 10; f++)
			(void) close(f);	/* parano ! */
		}
                int←std();
		execl("/bin/sh", "sh", "-c", s, 0);
		←exit(127);
	}
        int←ign();
	while ((w = wait(&status)) != pid && w != -1)
		;
	if (w == -1)
		status = -1;
	return(status);
}


/* runtime
   =======
   Retourne le temps depuis le debut du job.
   Ce temps est en secondes (flottant).
   L'unite' de temps de'pend du syste`me 
*/

#ifndef TIMEUNIT

#ifdef BSD4x
#define TIMEUNIT 60.
#endif BSD4x

#ifdef S5
#define TIMEUNIT 1000.
#endif S5

#endif TIMEUNIT

#ifdef BSD42
double
runtime()
        {
struct rusage urusage;
struct timeval utimeval;
        getrusage(0, &urusage);
        utimeval = urusage.ru←utime;
        return(utimeval.tv←sec+(utimeval.tv←usec/1000000.));
}
#else BSD42
double
runtime()
        {
struct tms timebuffer;
        times(&timebuffer);
        return (timebuffer.tms←utime / TIMEUNIT);
}
#endif BSD42

/* sleep
   =======
   Dort n secondes. Ce temps est en secondes (flottant).
   Helas UN*X ne peut dormir qu'un nb de sec fixes
*/
/* En 31bitfloats: l'argument est dans accusingle1 */
csleep()
{
        unsigned seconds;
        seconds = accusingle1;
        sleep(seconds);
}
/* En 64bitfloats: l'argument est en argument(dans la pile) */
cdleep(f)
double f; {
        unsigned seconds;
        seconds = f;
        sleep(seconds);
}
/* cdate
   =====
   Donne la date courante
*/

extern struct tm *localtime();

cdate (date←lisp)
int *date←lisp;
{
    struct tm decoded;
    long clock;

    clock = time(0);
    decoded = *localtime(&clock);
    date←lisp[0] = decoded.tm←year + 1900;
    date←lisp[1] = decoded.tm←mon + 1;
    date←lisp[2] = decoded.tm←mday;
    date←lisp[3] = decoded.tm←hour;
    date←lisp[4] = decoded.tm←min;
    date←lisp[5] = decoded.tm←sec;
    date←lisp[7] = decoded.tm←wday == 0 ? 7 : decoded.tm←wday;
}

/* setalarm
   ========
   De'clenche une alarme apre`s n secondes (flottant).
*/



double setalarm(f)
double f; {
#ifdef BSD42
	struct itimerval nit,oit;
	register int secs;

	secs = (long) (f * 1e+6);	/* marche si f < 1000000 s ! */
	timerclear(&nit.it←interval);
	nit.it←value.tv←sec = secs / 1000000;
	nit.it←value.tv←usec = secs % 1000000;
	if (setitimer(ITIMER←REAL, &nit, &oit) < 0)
		return(0);
	return(oit.it←value.tv←sec + oit.it←value.tv←usec * 1e-6);
#else BSD42
#ifdef SPS7

/* sur SMX 5.1 il y a un hack pour avoir une horloge au 1/1000ieme */

	register int secs;
	extern int alarm←on;

	secs = (long) (f * -1000.);
	if ((secs == 0) && (f != 0.))
		secs = -1;		/* pour l'arrondi */
	return((double) alarm(secs));
#else SPS7
	register int secs;
	extern int alarm←on;

	secs = (long) f;
	alarm←on = f == 0. ? 0 : 1;
	if ((secs == 0) && (f != 0.))
		secs = 1;		/* pour l'arrondi */
	return((double) alarm(secs));
#endif SPS7
#endif BSD42
}

/* getenvrn
   ========
   Recherche d'une variable de l'environnement.
   Rempli le buffer donne argument avec la chaine resultat.
   Retourne la taille de la chaine. 
*/

extern char *getenv();

int getenvrn (nom, buff)
char *nom, *buff;{
char *u;
        if(nom = (u = getenv(nom))){
          while(*buff++ = *u++);
          return (u-nom-1);
        }
        return (0);
}


/* getgloba
   =========
   retourne la valeur associee a un symbole
   dans la table des symboles de l'image Le-Lisp.
*/

/* la macro NLISTNAME permet de positionner le champ n←name d'un
   e'le'ment de table des symboles.
   Ca depend beaucoup des systemes... */

#ifdef  BSD4x
#define NLISTNAME(e,i,s) e[i].n←un.n←name = s
#endif  BSD4x

#ifdef  Perkin
#define NLISTNAME(e,i,s) strncpy(e[i].n←name,s,8)
#endif  Perkin

#ifdef  CADMUS
#define NLISTNAME(e,i,s) strcpy(e[i].n←name, s)
#endif  CADMUS

#ifdef  HP9300
#define NLISTNAME(e,i,s) e[i].n←name = (*s == 0) ? NULL : s
#endif  HP9300

#ifdef  UNIGRAPH | LEWS
#define NLISTNAME(e,i,s) e[i].n←name = (*s == 0) ? s : s+1
#endif  UNIGRAPH

/* le defaut */

#ifndef NLISTNAME
#define NLISTNAME(e,i,s) e[i].n←name = s
#endif  NLISTNAME

struct nlist elem[2];
int getgloba (strg) char *strg; {
	NLISTNAME(elem, 0, strg);
	NLISTNAME(elem, 1, "");
        nlist(lelispbin, elem);
        return(elem[0].n←value);
}

/* le getglobal multiple */
struct lisp←string {
       char *pad1;
       char *pad2;
       char chars;
};

struct lisp←cons {
       struct lisp←string **car;
       struct lisp←cons *cdr;
};

void mgetglo (list, nil) 
    struct lisp←cons *list, *nil; {
    int length, i;
    struct lisp←cons *courant;
    struct nlist *elems;
    char *name;

    length = 0;
    for (courant = list; courant != nil; 
         courant = (struct lisp←cons *)courant->cdr) 
        length++;
    elems = (struct nlist *) malloc ((length+1) * sizeof(struct nlist));

    i = 0;
    for (courant = list; courant != nil; 
         courant = (struct lisp←cons *) courant->cdr) {
	name = &((*(courant->car))->chars);
	NLISTNAME(elems, i, name);
        i++;
    }

    NLISTNAME(elems, i, "");
    
    nlist (lelispbin, elems);

    i = 0;
    for (courant = list; courant != nil; 
         courant = (struct lisp←cons *) courant->cdr) {
        courant->car = (struct lisp←string **) elems[i].n←value;
        i++;
    }
    free(elems);
}
  

/* la routine de sortie */
out(code)
int code; {
        if(!strncmp(lelispbin, template, 12))
          unlink(lelispbin);
	unix←stty();
        exit(code);                /* puis sort avec code de retour */
}
outner () {                       /* sortie normale depuis lisp */
          out(0);
	}
outwer () {                      /* sortie anormale depuis lisp */
         out(-1);                /* suivant la convention UNIX  */
       }
outcore() {
        perror("Le-Lisp : restore-core : ");
        out(-1);
}


/* la syntaxe d'appel de Le-Lisp sous UN*X */

char *usage() {
 fprintf(stderr, "Usage : lelisp [-s] [file] [-r file] [number] \
[-stack number] [-code number] [-heap number] [-float number] \
[-vector number] [-string number] [-symbol number] [-cons number]\r\n");
 out(-1);
 return((char *)-1);
}

zonevide(s){
#ifdef FOREIGN
 fprintf(stderr, "Empty %s zone\r\n", s);
#else FOREIGN
 fprintf(stderr, "Zone %s vide\r\n", s);
#endif FOREIGN
 out(-1);
}

/*
        Le chargement dynamique de modules C

        Courtesy of L. Fallot
	Revu par M. Devin
 */


#define wwe(s)    write(2,s,strlen(s))
#define round(x,s) ((((x)-1) & ~((s)-1)) +(s))

#ifndef S5
char *
cload(file, ccode, ecode)
    char *file, *ccode, *ecode;{
    char        *ccoderound;
    int         taille;
    int         totale;
    char        cbuf[512];
    int fd;
    struct exec header;
    int i;

    /* remettre 6 X au bout du template 
       et ge'ne'rer un nom unique  */

    for(i = strlen(template)-6; i < strlen(template); i++)
       template[i] = 'X';
    mktemp(template);

    /* arrondir ccode a` la taille de la page */

#ifdef SPS9
    ccoderound = (char *)round((int)ccode, 4096);
#else SPS9

#ifdef SEQUENT
    ccoderound = (char *)round((int)ccode, 2048);
#else SEQUENT
    ccoderound = (char *)round((int)ccode, 512);
#endif SEQUENT

#endif SPS9

    /* appeler le linker */
    sprintf(cbuf,
#ifdef SPS9
            "/bin/ld -C -A %s -N -x -T %x -o %s %s -lc",
#else  SPS9
#ifdef SUNOS40
            "/bin/ld -A %s -Bstatic -N -x -T %x -o %s %s -lc",
#else  SUNOS40
            "/bin/ld -A %s -N -x -T %x -o %s %s -lc",
#endif SUNOS40
#endif SPS9
            lelispbin,
            ccoderound,
            template,
            file);
    cline(cbuf);

    /* Le link est-il bien fini ? */
    fd = open(template, 0);
    if (fd < 0) {
        perror(template);
        unlink(template);
        return(ccode);
    }
    if(read(fd,&header,sizeof(header)) != sizeof(header)) {
        perror(template);
        close(fd);
        unlink(template);
        return(ccode);
    }

    /* le programme ge'ne're' tient-il dans la zone code ? */
    taille = round(header.a←text, 4) + round(header.a←data, 4);
    totale = taille + header.a←bss;
#ifdef SPS9
    totale = round(totale, 4096);
#else SPS9
#ifdef SEQUENT
    totale = round(totale, 2048);
#else SEQUENT
    totale = round(totale, 512);
#endif SEQUENT
#endif SPS9

    if((ccoderound+totale) >= ecode){
      fprintf(stderr,
#ifdef FOREIGN
         "cload: fatal error full code zone: missing %d Kbytes\r\n",
#else FOREIGN
         "cload: erreur fatale zone code pleine: il manque %d Koctets\r\n",
#endif FOREIGN
         ((ccoderound+totale-ecode))/1024+1);
      return(ccode);
    }

    if (taille != read(fd,ccoderound,taille)) {
        perror(template);
        close(fd);
        unlink(template);
        return(ccode);
    }
    close(fd);

    if(!strncmp(lelispbin, template, 12))
      unlink(lelispbin);
    strcpy(lelispbin, template);

    return(ccoderound+totale);
}
#endif S5

/* le repertoire courant */

int
llgetwd (s, l) char *s; int l; {
int code;
#ifdef VAXUNIX	
	code = getwd(s); /* maxpathlen is the max */
#else  VAXUNIX
	code = getcwd(s, l);
#endif VAXUNIX
	return(code ? strlen(s) : 0);
}

/*
   Les tests pour callextern
*/

int cchdir (strg) char *strg; {
    return(llglobb(strg,"",0));
}

char *chome () {
     return(getenv("HOME"));
}

#ifdef BSD42
char *date () {
char *s;
long temps;
        temps = time(0);
        s = ctime(&temps);
        *(s+24) = '\0';
        return(s);
}
#endif BSD42

#ifdef SPS9
#include "lelisp.h" 

struct LL←SYMBOL *ll←concat;

struct LL←SYMBOL *
getsym (s) char *s; {
	pusharg(LLT←STRING, s);
	return (struct LL←SYMBOL *) lispcall (LLT←T, 1, ll←concat);
}
#endif SPS9

int cmoinsun () {
    return(-1);
}


double ctest (strg,nf,ni,vect) char *strg; double nf; int ni; int *vect;{
int i;
        printf("la chaine est %s\r\n", strg);
        printf("le flottant est %e\r\n", nf);
        printf("l'entier est %d\r\n", ni);
        printf("le vecteur contient vect[0]=%8x,vect[1]=%8x\r\n",
                                vect[0], vect[1]);
        i = vect[0]; vect[0] = vect[1]; vect[1] = i;
        return(nf*ni);
}

cboucle () {
        while (1) sin(3.14);
}

/*
 *        newer
 *        =====
 *        Lists both of its arguments newer first.
 *        For CAML module system.
 */

static time←t fdate(name)
char *name;
{
        struct stat stbuf;
        if (stat(name, &stbuf) == -1) {
                return(-1);
        }
        return(stbuf.st←mtime);
}

newer(name1,name2)
char *name1;
char *name2;
{
        time←t   date1;
        time←t   date2;
        date1 = fdate (name1);
        date2 = fdate (name2);
        if (date1 == -1)
		if (date2 == -1)
			return(-3);
		else
			return(-1);
	if (date2 == -1)
		return(-2);
	return(date1 > date2);
}

/* Ce paragraphe  contient le mecanisme de wildcarding implemente sur
BSD4.2 (SUN) . Il essaie d'etre relativement efficace. la premiere
invocation cree un sous process cshell par vfork les fois suivantes ,
on se contente de piper les noms a expanser et a recuperer les chaines
expansees, apres quoi, lisp en fait ce qu'il veut....

  Auteur : Michel DANA
  Date   : 26 Aout 1988 
  Modif  : 31 Aout 1988 pour adaptation SYSTEM 5
 */


#define MAXLINE 1024
int llglobb (ll←in←string,ll←out←string,maxline)

  char *ll←in←string, *ll←out←string ; {
  static int pipe←in[2],pipe←out[2],first←time=0,pid=0;
  static int incopy, outcopy;
  static char *s;
  static FILE *stream←in, *stream←out;
  static char buff[MAXLINE];
  int i;
                                           /* EN */
 if (maxline==0)                           /* chdir */
   {if (chdir(ll←in←string)) return(-1);   /* chdir pour le process-meme */
    if (first←time==0) return(0);          /* pas de sous-shell */
    };                                     /* on en reste la */

 if (maxline==-1)                          /* destruction du sous-shell */
   {if (first←time==0)                     /* meme pas cree encore */
      return(0);                           /* on en reste la */
    fclose(stream←out);                    /* on ferme fd vers le sh */
    i=wait(0);                             /* le sous-sh est mort */
    fclose(stream←in);                     /* on ferme le fd venant du sh */
    first←time=0;                          /* on revient a l'etat */
    return(i);};                           /* on en reste la */

 if (first←time==0){
/* c'est la premiere fois, il y a des choses a initialiser  */
   if (maxline==0)                         /* chdir? */
     return(chdir(ll←in←string));          /* nouvelle directory */
   if (pipe(pipe←in) || pipe(pipe←out))    /* erreur? */
     return(-7);                           /* retour lelisp */
   incopy=dup(0);                          /* copie pour cline .... */
   outcopy=dup(1);                         /* ... redirige par <> dans sh */
   first←time=1;
#ifdef BSD4x
   pid=vfork();    /* on forke astucieusement */
#endif
#ifdef S5
   pid =fork();   /* on ne vforke pas en systeme 5 */
#endif
   if (pid<0) return(-8);                  /* erreur? retour lelisp */
   if (pid==0) {   /* je suis le fils  */
      close(pipe←in[1]);                   /* faut pas oublier */
      close(pipe←out[0]);                  /* ces deux inutiles-la */
#ifdef BSD4x
      dup2(pipe←in[0],0);  /* je reassigne stdin */
      dup2(pipe←out[1],1); /* la meme chose sur stdout */
#endif
#ifdef S5
      fclose(stdin);
      fclose(stdout); 
      dup(pipe←in[0]);
      dup(pipe←out[1]);
#endif
/*      freopen("/dev/null","w",stderr);  pour ne pas avoir de messages */
	                	       /* bizarres en cas d'echec */
      execl ("/bin/sh","sh",0);            /* sh existe partout */
 }
   /* le pere maintenant */

   close(pipe←in[0]);
   close(pipe←out[1]);  /* inutile de conserver des descripteurs */
			/* inutiles */
   stream←in=fdopen(pipe←out[0],"r");
   stream←out=fdopen(pipe←in[1],"w");
#ifdef BSD4x
   setlinebuf(stream←out); /* fin des initialisations */
#endif
#ifdef S5
  setbuf(stream←out,NULL);  /*pas de bufferisation....*/
#endif
  fputs("trap '' 2\n", stream←out);        /* contre les ↑C de Lelisp */
  close(incopy);                           /* seul utilise par le fils */
  close(outcopy);
 }
   
   if (kill(pid,0)<0)                      /* le pid, est-il la? */
     {fclose(stream←out);                  /* non, on ferme */
      fclose(stream←in);                   /*  les filedesc */
      first←time=0;                        /* pret a recommencer */
      if (maxline == 0) return(0);         /* chdir?, pas d'erreur */
      return(-9);};                        /* retour Lelisp */

   if (maxline == 0)                       /* chdir, suite */
     {fprintf(                             /* on compose une commande cd */
        stream←out,                        /* vers le sous-sh */
        "cd %s\n",                         /* le template */
        ll←in←string);                     /* la directory */
      return(0);};                         /* on en reste la */

   if (maxline==-2)                        /* on simule cline */
     {int←ign();                           /* prolog de ... */
      unix←stty();                         /* .. cline */
      fprintf                              /* on construit la commande */
        (stream←out,                       /* vers le sous-sh */
         "sh -c 'exec <&%d >&%d; %s'\n",   /* recuperation de ... */
         incopy,                           /*  ... stdin ...*/
         outcopy,                          /*  ... stdout */
         ll←in←string);                    /* la commande-cline */
      fprintf(stream←out,"echo $?\n");     /* imprime exit-status */
      fscanf(stream←in,"%d",&i);           /* recupere exit-status */
      lisp←stty();                         /* epilog de ... */
      inton();                             /* ... cline */
      return(i);};                         /* synchronise' */

   s= & buff[0];
   buff[0]='\0';
   strcat(&buff[0],"echo ll: ");
   strcat(&buff[0],ll←in←string);
   strcat(&buff[0],"\n");
/*   printf("on passe %s \n",&buff[0]); */ 
   fputs(s ,stream←out);
   while (strncmp(s=fgets(buff,maxline,stream←in),"ll: ",4)); /* on */
							      /* tout */
							      /* garbage */
    s=s+4;
   strcpy(ll←out←string,s);
   return(strlen(ll←out←string));
}