Path: utzoo!censor!geac!torsqnt!news-server.csri.toronto.edu!cs.utexas.edu!uunet!mcsun!inria!litp!pda
From: pda@litp.ibp.fr (Pierre DAVID)
Newsgroups: comp.sys.handhelds
Subject: Saturn Assembler (Part 1/8)
Message-ID: <3302@litp.ibp.fr>
Date: 5 Jul 90 16:20:49 GMT
Reply-To: pda@litp.ibp.fr.UUCP (Pierre DAVID)
Organization: M.A.S.I., Universite P. & M. Curie, Paris, FRANCE
Lines: 2422


#---------------------------------- cut here ----------------------------------
# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by Pierre David <pda@janick> on Sun Jul  1 12:32:48 1990
#
# This archive contains:
#	areuh			areuh/cpy		
#	areuh/linker		areuh/dump		
#	areuh/doc		areuh/equ		
#	areuh/load		areuh/msg		
#	areuh/jmpdoc		areuh/assembler		
#	areuh/cpy/a2lex.c	areuh/cpy/a2rs.c	
#	areuh/cpy/copy.h	areuh/linker/mdep.c	
#	areuh/linker/exp.c	areuh/linker/err.h	
#	areuh/linker/common.h	areuh/linker/lutil.c	
#	areuh/linker/lpass.c	areuh/linker/lmain.c	
#
# Error checking via wc(1) will be performed.

LANG=""; export LANG
PATH=/bin:/usr/bin:$PATH; export PATH

echo mkdir - areuh
mkdir areuh

chmod 755 areuh

echo mkdir - areuh/cpy
mkdir areuh/cpy

chmod 755 areuh/cpy

echo mkdir - areuh/linker
mkdir areuh/linker

chmod 755 areuh/linker

echo mkdir - areuh/dump
mkdir areuh/dump

chmod 755 areuh/dump

echo mkdir - areuh/doc
mkdir areuh/doc

chmod 755 areuh/doc

echo mkdir - areuh/equ
mkdir areuh/equ

chmod 755 areuh/equ

echo mkdir - areuh/load
mkdir areuh/load

chmod 755 areuh/load

echo mkdir - areuh/msg
mkdir areuh/msg

chmod 755 areuh/msg

echo mkdir - areuh/jmpdoc
mkdir areuh/jmpdoc

chmod 755 areuh/jmpdoc

echo mkdir - areuh/assembler
mkdir areuh/assembler

chmod 755 areuh/assembler

echo x - areuh/cpy/a2lex.c
cat >areuh/cpy/a2lex.c <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

#include "copy.h"

char outname [100] ;
FILE *fpdev ;

init ()
{
#ifdef unix
    fpdev = stdout ;
#else
    sprintf (outname, "%s.lex", file) ;
    if ((fpdev = fopen (outname, "wb")) == NULL)
        error (ERROPN, outname) ;
#endif
}

output (c)
uchar c ;
{
    putc ((int) c, fpdev) ;
    if (ferror (fpdev)) error (ERRWRT, outname) ;
}

term ()
{
    if (fclose (fpdev))
        error (ERRCLO, outname) ;
}
@EOF
set `wc -lwc <areuh/cpy/a2lex.c`
if test $1$2$3 != 39108641
then
	echo ERROR: wc results of areuh/cpy/a2lex.c are $* should be 39 108 641
fi

chmod 644 areuh/cpy/a2lex.c

echo x - areuh/cpy/a2rs.c
cat >areuh/cpy/a2rs.c <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

#include "copy.h"
#include <dos.h>

union REGS inregs, outregs ;

init ()
{
    inregs.h.ah = 0 ;
    inregs.h.al = 0xe3 ;
    inregs.x.dx = 0 ;		    /* com1 */
    int86 (0x14, &inregs, &outregs) ;
}

output (c)
char c ;
{
    int ok ;

    ok = 0 ;
    while (!ok)
    {
	inregs.h.ah = 0x03 ;			/* get line status */
	inregs.x.dx = 0x0000 ;
	int86 (0x14, &inregs, &outregs) ;
	ok = (outregs.h.al & 0x30) == 0x30 ;	/* handshake lines */
    }
    inregs.h.ah = 1 ;				/* send char */
    inregs.h.al = c ;
    inregs.x.dx = 0 ;

    int86 (0x14, &inregs, &outregs) ;
}

term ()
{
}
@EOF
set `wc -lwc <areuh/cpy/a2rs.c`
if test $1$2$3 != 47146813
then
	echo ERROR: wc results of areuh/cpy/a2rs.c are $* should be 47 146 813
fi

chmod 644 areuh/cpy/a2rs.c

echo x - areuh/cpy/copy.h
cat >areuh/cpy/copy.h <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

#include <stdio.h>

long int con () ;

typedef unsigned char uchar ;

typedef unsigned long int  int32 ;
typedef unsigned short int int16 ;

#define ERRUSA	       1		/* usage */
#define ERROPN	       2		/* cannot open */
#define ERRNAL	       3		/* not a Lex */
#define ERRCLO	       4		/* cannot close */
#define ERRRD	       5		/* error reading */
#define ERRWRT	       6		/* error writing */
#define ERRLEN	       7		/* bad REL(5) FiLeNd field */
#define ERRINT	       8		/* interface error */

uchar	*file ;

uchar	name [10] ;
FILE	*fp ;
int16	ftype ;
int32	lnib, lbyte, lsect ;

uchar	*pgm ;				/* name of current program */

main (argc, argv)
int argc ;
char *argv[] ;
{
    long int magic ;
    int32 l ;
    uchar tab [4] ;
    int i, j, m ;
    int mod ;

    pgm = (uchar *) argv [0] ;		/* program name */

    switch (argc)
    {
	case 1 :
	    file = (uchar *) "lex" ;	/* default name */
	    break ;
	case 2 :
	    file = (uchar *) argv [1] ;
	    break ;
	default :
	    error (ERRUSA, "") ;
	    break ;
    }

    fp = fopen (file, "rb") ;		/* binary file for MS-DOS machines */
    if (fp == NULL)
	error (ERROPN, file) ;

/* get Lex file header */

    fread ((char *) &magic, sizeof (long int), 1 , fp) ;
    if (magic!=0x1b080100)
	error (ERRNAL, file) ;		/* not a Lex file */

    for (i=0; i<8; i++)
	name [i] = (uchar) con (2) ;
    name [8] = name [9] = ' ' ;

    ftype = (int32) con (4) ;		/* file type */

    skip (12) ; 			/* skip date and time */

    lnib = (int32)con (5) - (int32)5 ;	/* get length */
    lsect = (lnib + 511) / 512 ;

    if (ferror (fp))			/* read error */
	error (ERRRD, file) ;

/* initialize output channel */

    init () ;

/* header output */

    for (i=0; i<10; i++)		/* file name */
	output ((uchar) name [i]) ;
    output ((uchar) (ftype / 256)) ;	/* file type */
    output ((uchar) (ftype % 256)) ;
    for (i=1; i<=4; i++)		/* start sector */
	output ((uchar) 0) ;
    l = lsect ;
    for (i=3; i>=0; i--)		/* length in sectors */
    {
	tab [i] = (uchar) l & 0xff ;
	l >>= 8 ;
    }
    for (i=0; i<4; i++)
	output (tab [i]) ;
    for (i=0; i<6; i++)			/* date and time */
	output ((uchar) 0) ;
    output ((uchar) 0x80) ;		/* 80 */
    output ((uchar) 0x01) ;		/* 01 */
    l = lnib ;
    for (i=0; i<4; i++) 		/* length in nibbles */
    {
	output ((uchar) (l & (int32) 0xff)) ;
	l >>= 8 ;
    }

/* data output */

    lbyte = (lnib+1) >> 1 ;
    mod = lbyte % 256 ;
    for (i=1; i<=lsect; i++)
    {
	m = (i == lsect && mod != 0) ? min (256, mod) : 256 ;
	for (j=0; j<m ; j++)
	    output ((uchar) con (2)) ;
    }
    for (j=m; j<256; j++)
	output ((uchar) 0) ;

/* end */

    if (getc (fp) != EOF)		/* bad file len */
	error (ERRLEN, file) ;
    term () ;

    exit (0) ;
}

long int con (n)
int n ;
{
    int i ;
    long int res ;
    uchar buf [1024] ;
    int first ;

    res = 0 ;
    first = 1 ;
    for (i=0; i<n; i++)
    {
	buf [i] = (uchar) getc (fp) ;
	if (first && feof (fp))
	    error (ERRLEN, "") ;
	first = 0 ;
    }
    if (ferror (fp))
	error (ERRRD, file) ;
    for (i=n-1; i>=0; i--)
	res = (res << 4) | hex (buf [i]) ;
    return res ;
}

skip (n)
int n ;
{
    uchar buf [1024] ;

    fread (buf, n, 1, fp) ;
    if (ferror (fp))
	error (ERRRD, file) ;
    if (feof (fp))
	error (ERRLEN, "") ;
}

int min (a, b)
int a, b ;
{
    return a <= b ? a : b ;
}

int hex (c)
uchar c ;
{
    return (c >= 'A' && c <= 'F') ? c - 'A' + 10 : c - '0' ;
}

error (code, str)
int code ;
uchar *str ;
{
    switch (code)
    {
	case ERRUSA :	    /* usage */
	    fprintf (stderr, "usage: %s [file]\n", pgm) ;
	    break ;
	case ERROPN :	    /* cannot open */
	    fprintf (stderr, "%s: cannot open %s\n", pgm, str) ;
	    break ;
	case ERRNAL :	    /* not a Lex */
	    fprintf (stderr, "%s: %s is not a lex file\n", pgm, str) ;
	    break ;
	case ERRCLO :	    /* cannot close */
	    fprintf (stderr, "%s: cannot close %s\n", pgm, str) ;
	    break ;
	case ERRRD  :	    /* error reading */
	    fprintf (stderr, "%s: error reading %s\n", pgm, str) ;
	    break ;
	case ERRWRT :	    /* error writing */
	    fprintf (stderr, "%s: error writing %s\n", pgm, str) ;
	    break ;
	case ERRLEN :	    /* bad REL(5) FiLeNd field */
	    fprintf (stderr, "%s: bad REL(5) FiLeNd field\n", pgm) ;
	    break ;
	case ERRINT :	    /* interface error */
	    fprintf (stderr, "%s: interface error\n", pgm) ;
	    break ;
	default :
	    fprintf (stderr, "%s: internal error\n", pgm) ;
	    break ;
    }
    exit (1) ;
}
@EOF
set `wc -lwc <areuh/cpy/copy.h`
if test $1$2$3 != 2249004719
then
	echo ERROR: wc results of areuh/cpy/copy.h are $* should be 224 900 4719
fi

chmod 644 areuh/cpy/copy.h

echo x - areuh/linker/mdep.c
cat >areuh/linker/mdep.c <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

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

      M A C H I N E    D E P E N D E N C I E S

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

#include "flag.h"

#if ASSEMBLER
#include "aglobal.h"
#else
#include "lglobal.h"
#endif

extern struct symbol *add_label() ;

#if HPUX

void format_time (str)
uchar *str ;
{
    long int l ;

    extern long int time () ;
    extern char *ctime () ;

    l = time (0L) ;
    strcpy (str, ctime (&l)) ;
    str [strlen (str) - 1] = EOL ;
}

char *tab[] = { "",
		"/usr/lib/",
		"/usr/local/lib/",
		"/lib/",
		"/hp71/lib/",
		"/local/lib/",
		0 } ;

void load_file (file)
uchar *file ;
{
    int i = 0 ;
    uchar name [MAXLEN+1] ;
    saddr val ;
    FILE *fp ;

    fp = (FILE *) NULL ;
    while ((tab[i])&&(!fp))
    {
	sprintf (name, "%s%s", tab[i++], file) ;
	fp = fopen (name, "r") ;
    }
    if (!fp) error (ERROPN, file) ;

#if LINKER
    file = 0 ;
#endif
    while (fscanf (fp, "%s\n%X\n", name, &val) != EOF)
    {
#if ASSEMBLER
	add_label (name, val, "", LABS, 1) ;
#else
	add_label (name, val, 1) ;
#endif
    }
    if (ferror (fp)) error (ERRWRT, file) ;
    if (fclose (fp)) error (ERRCLO, file) ;
}

#include <sys/types.h>
#include <sys/stat.h>

/* look for object file (object code or listing file)
 *   if non existent, ok
 *   if exists and not directory, ok
 *   if exists and directory, then append "<dir>/<default>" */

look_obj (fname, dfl)
uchar *fname, *dfl ;
{
    struct stat buf ;

    if (*fname == EOL)		   /* if fname == "" then default it */
	strcpy (fname, dfl) ;

    if (!stat (fname, &buf))	   /* file exists. Is it a directory ? */
    {
	if ((buf.st_mode & S_IFMT) == S_IFDIR)
	    sprintf (fname, "%s/%s", fname, dfl) ;
    }
}

/* build a default file name, based on "source" basename and a given
 * default extension.
 */

dfl_extension (object, source, extension)
uchar *object, *source, *extension ;
{
    uchar *pname ;

    strcpy (object, source) ;
    pname = object ;
    while ((*pname)&&(*pname!='.')) pname++ ;
    if (*pname==EOL) *pname = '.' ;
    strcpy (pname+1, extension) ;
}

#endif	   /* HPUX */


#if ATARI_LATTICE

char skipvar ;

void format_time (str)
uchar *str ;
{
    strcpy (str, "Areuh Tagada Bouzouh bouzouh areuh areuh... et toc !") ;
}

char *optarg ;
int optind = 0, opterr = 0 ;

int getopt (argc, argv, optstr)
int argc ;
char *argv[], *optstr ;
{
    char *o, car ;
    static char *index = 0 ;
    extern char *strchr () ;

    if ((index==(char *)0)||(*(index+1)==0))
    {
	if (++optind>argc-1) return (EOF) ;
	index = argv[optind] ;
	if (*index!='-') return (EOF) ;
    }
    car = *(++index) ;	      /* state 6 */
    if (!(o = strchr (optstr, car))) return ('?') ;
    if (*(o+1)!=':')     return ((int) car) ;
    if (*(index+1)) optarg = index+1 ;
    else
    {
	if (++optind>argc-1) return (EOF) ;
	else optarg = argv[optind] ;
    }
    index = (char *) 0 ;
    return ((int) car) ;
}

uchar *tab[] = { "",
		 "A:",
		 "A:\\TABLE\\",
		 0 } ;

void load_file (file)
uchar *file ;
{
    int i = 0 ;
    uchar name [MAXLEN+1] ;
    saddr val ;
    FILE *fp ;

    fp = (FILE *) NULL ;
    while ((tab[i])&&(!fp))
    {
	sprintf (name, "%s%s", tab[i++], file) ;
	fp = fopen (name, "r") ;
    }
    if (!fp) error (ERROPN, file) ;

#if LINKER
    file = 0 ;
#endif
    while (fscanf (fp, "%s\n%x\n", name, &val) != EOF)
    {
#if ASSEMBLER
	add_label (name, val, "", LABS, 1) ;
#else
	add_label (name, val, 1) ;
#endif
    }
    if (fclose (fp)) error (ERRCLO, file) ;
}

#endif	  /* ATARI_LATTICE */


#if PC_MSC

char skipvar ;

void format_time (str)
uchar *str ;
{
    long int l ;

    extern long int time () ;
    extern char *ctime () ;

    time (&l) ;
    strcpy (str, ctime (&l)) ;
    str [strlen (str) - 1] = EOL ;
}

char *optarg ;
int optind = 0, opterr = 0 ;

int getopt (argc, argv, optstr)
int argc ;
char *argv[], *optstr ;
{
    char *o, car ;
    static char *index = 0 ;
    extern char *strchr () ;

    if ((index==(char *)0)||(*(index+1)==0))
    {
	if (++optind>argc-1) return (EOF) ;
	index = argv[optind] ;
	if (*index!='-') return (EOF) ;
    }
    car = *(++index) ;	      /* state 6 */
    if (!(o = strchr (optstr, car))) return ('?') ;
    if (*(o+1)!=':')     return ((int) car) ;
    if (*(index+1)) optarg = index+1 ;
    else
    {
	if (++optind>argc-1) return (EOF) ;
	else optarg = argv[optind] ;
    }
    index = (char *) 0 ;
    return ((int) car) ;
}

uchar *tab[] = { "",
		 "c:",
		 "c:\\hp71\\",
		 "c:\\lib\\hp71\\",
		 "c:\\lib\\",
		 "c:\\areuh\\lib\\",
		 0 } ;

void load_file (file)
uchar *file ;
{
    int i = 0 ;
    uchar name [MAXLEN+1] ;
    saddr val ;
    FILE *fp ;

    fp = (FILE *) NULL ;
    while ((tab[i])&&(!fp))
    {
	sprintf (name, "%s%s", tab[i++], file) ;
	fp = fopen (name, "r") ;
    }
    if (!fp) error (ERROPN, file) ;

#if LINKER
    file = 0 ;
#endif
    while (fscanf (fp, "%s\n%X\n", name, &val) != EOF)
    {
#if ASSEMBLER
	add_label (name, val, "", LABS, 1) ;
#else
	add_label (name, val, 1) ;
#endif
    }
    if (fclose (fp)) error (ERRCLO, file) ;
}

#include <sys\types.h>
#include <sys\stat.h>

/* look for object file (object code or listing file)
 *   if non existent, ok
 *   if exists and not directory, ok
 *   if exists and directory, then append "<dir>/<default>" */

look_obj (fname, dfl)
uchar *fname, *dfl ;
{
    struct stat buf ;

    if (*fname == EOL)		   /* if fname == "" then default it */
	strcpy (fname, dfl) ;

    if (!stat (fname, &buf))	   /* file exists. Is it a directory ? */
    {
	if ((buf.st_mode & S_IFMT) == S_IFDIR)
	    sprintf (fname, "%s\\%s", fname, dfl) ;
    }
}

/* build a default file name, based on "source" basename and a given
 * default extension.
 */

dfl_extension (object, source, extension)
uchar *object, *source, *extension ;
{
    uchar *pname ;

    strcpy (object, source) ;
    pname = object ;
    while ((*pname)&&(*pname!='.')) pname++ ;
    if (*pname==EOL) *pname = '.' ;
    strcpy (pname+1, extension) ;
}

#endif	  /* PC_MSC */
@EOF
set `wc -lwc <areuh/linker/mdep.c`
if test $1$2$3 != 32610286303
then
	echo ERROR: wc results of areuh/linker/mdep.c are $* should be 326 1028 6303
fi

chmod 644 areuh/linker/mdep.c

echo x - areuh/linker/exp.c
cat >areuh/linker/exp.c <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

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

                                TITAN ASSEMBLER

                             EXPRESSION EVALUATION


calc_expression, reduce_E, reduce_T, reduce_F, reduce_B, reduce_X,
reduce_P, dec_value, hex_value, bin_value, ascii_value, label_value, apply,
trunc, next_char, append_extexp

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

#include "flag.h"

#if ASSEMBLER
#include "aglobal.h"
#else
#include "lglobal.h"
#endif

uchar extexp [4*MAXLEN] ;
uchar *pexp, *pextexp ;
uchar *xlabel ;
int relabs ;

extern saddr symbol_value() ;

saddr reduce_E(), reduce_T(), reduce_F(), reduce_B(), reduce_X(), reduce_P(),
      dec_value(), hex_value(), bin_value(), ascii_value(), label_value(),
      apply(), trunc() ;
void next_char(), append_extexp() ;


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

                               CALC_EXPRESSION


synopsis : saddr calc_expression (exp)
           uchar *exp
description : That's the expression evaluator. Productions used are :

    E -> T { {+|-} T }*
    T -> F { {*|/} F }*
    F -> B { {&|!} B }*
    B -> X | -X | `X           (two's and one's complement)
    X -> N { {~|^} N }*
    P -> D | #<hex> | %<bin> | '<ascii>' | \<ascii>\ | <label> | * | (E)

    D -> <dec>                 if expression evaluated by ASSSEMBLER
    D -> <dec> | <dec> r       if expression evaluated by LINKER

    where   E : expression
            T : term
            F : factor
            B : boolean
            X : exponentiation
            P : primary
            D : decimal number
warning : with this grammar, 5--5 is valid (5 minus -5), but 5---5 is not.
          This can be modified by : B -> -B | P . The code is more complex,
          and I'm not sure that it's a real improvement.
note : Algorithm used is recursive descent (Mr Vermeulen would be horrified !)
       like Forth/Assembler rom based assembler, but is quietly different...

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

saddr calc_expression (exp)
uchar *exp;
{
    saddr val;

    pextexp = extexp ;
    pexp = exp ;
    val = reduce_E() ;
    if (((val>=0L)||(val==EXP_EXT))&&(*pexp!=EOL)&&(*pexp!=' ')&&(*pexp!='\t'))
    {
        error(WRNEXP, "") ;    /* illegal expression */
        val = EXP_ERR ;
    }
    *pextexp = EOL ;
    return (val) ;
}


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

                                   REDUCE_E


synopsis : saddr reduce_E()
description : This function reduces a given expression starting at pexp.

******************************************************************************/
saddr reduce_E()
{
    saddr val1, val2;
    uchar op, lrelabs;

    val1 = reduce_T () ;

    while ((((op = *pexp)=='+')||(op=='-'))&&(val1!=EXP_ERR))
    {
        lrelabs = relabs ;
        next_char () ;
        val2 = reduce_T () ;
        val1 = apply (val1, op, val2, lrelabs, relabs) ;
    }
    return (val1) ;
}


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

                                   REDUCE_T


synopsis : saddr reduce_T ()
description : same as above, for T-production

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

saddr reduce_T ()
{
    saddr val1, val2 ;
    uchar op, lrelabs ;

    val1 = reduce_F () ;
    while ((((op = *pexp)=='*')||(op=='/'))&&(val1!=EXP_ERR))
    {
        lrelabs = relabs ;
        next_char () ;
        val2 = reduce_F () ;
        val1 = apply (val1, op, val2, lrelabs, relabs) ;
    }
    return (val1) ;
}


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

                                   REDUCE_F


synopsis : saddr reduce_F ()
description : same as reduce_E

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

saddr reduce_F ()
{
    saddr val1, val2;
    uchar op, lrelabs ;

    val1 = reduce_B () ;
    while ((((op = *pexp)=='&')||(op=='!'))&&(val1!=EXP_ERR))
    {
        lrelabs = relabs ;
        next_char () ;
        val2 = reduce_B () ;
        val1 = apply (val1, op, val2, lrelabs, relabs) ;
    }
    return (val1) ;
}


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

                                   REDUCE_B


synopsis : saddr reduce_B ()
description : reduces a boolean factor. This must be done by reduction of minus
              sign eventually.

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

saddr reduce_B ()
{
    saddr val;
    uchar op ;

    op = *pexp ;

    if ((op=='-')||(op=='\`')) next_char () ;
    val = reduce_X () ;
    if (val<0L)
        return(val) ;
    switch (op)
    {
        case '-' :
            return (trunc (-val)) ;
        case '\`' :
            return (trunc (~val)) ;
        default :
            return (val) ;
    }
}


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

                                   REDUCE_X


synopsis : saddr reduce_X ()
description : same as reduce_E

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

saddr reduce_X ()
{
    saddr val1, val2;
    uchar op, lrelabs;

    val1 = reduce_P () ;
    while ((((op = *pexp)=='~')||(op=='^'))&&(val1!=EXP_ERR))
    {
        lrelabs = relabs ;
        next_char () ;
        val2 = reduce_P () ;
        val1 = apply (val1, op, val2, lrelabs, relabs) ;
    }
    return (val1) ;
}


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

                                   REDUCE_P


synopsis : saddr reduce_P ()
description : these are the terminal rules.
note : rule P -> D is implemented "in line" in this code (not as a separate
  function).

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

saddr reduce_P ()
{
    saddr val ;
    uchar limit, line[MAXLEN] ;

    switch (*pexp)
    {
        case '#' :
            next_char () ;
            if (((*pexp>='0')&&(*pexp<='9')) ||
               ((*pexp>='A')&&(*pexp<='F')) ||
               ((*pexp>='a')&&(*pexp<='f')))
                val = hex_value () ;
            else
            {
                error (WRNIHX,"");          /* illegal hexadecimal constant */
                val = EXP_ERR ;
            }
            relabs = LABS ;
            break ;
        case '%' :
            next_char () ;
            if ((*pexp=='0')||(*pexp=='1'))
                val = bin_value () ;
            else
            {
                error (WRNIBC, "") ;        /* illegal binary constant */
                val = EXP_ERR ;
            }
            relabs = LABS ;
            break ;
        case '\'' :
        case '\\' :
            limit = *pexp ;
            next_char () ;
            val = ascii_value (limit) ;
            if (*pexp!=limit)
            {
                error (WRNASC,"");                 /* illegal ascii constant */
                val = EXP_ERR ;
            }
            next_char () ;
            relabs = LABS ;
            break ;
        case '*' :
            val = pc ;
            pexp++ ;
            sprintf (line, "%ldr", pc) ;
            relabs = LREL ;
            append_extexp (line) ;
            break ;
        case '(' :
            next_char () ;
            val = reduce_E () ;
            if ((*pexp!=')')&&(val>=0))
            {
                error (WRNPAR, "") ;         /* mismatched parenthesis */
                val = EXP_ERR ;
            }
            next_char () ;
            break ;
        case EOL :
            error (WRNEXP,"") ;              /* illegal expression     */
            val = EXP_ERR ;
            break ;

        default :
            if ((*pexp>='0')&&(*pexp<='9'))
            {
                val = dec_value () ;
                relabs = LABS ;
#if LINKER
                if (*pexp=='r')
                {
                    next_char() ;
                    relabs = LREL ;
                    val += tmodule[file].m_ad ;
                }
#endif
            }
            else val = label_value () ;
            break ;
    }
    return (val) ;
}


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

                                   DEC_VALUE


synopsis : saddr dec_value ()
descrption : This function returns the decimal value of a constant. The search
             is stopped when a non numeric digit is reached.
             (this can be ),+,-,*,/,&,!).
             Finally, the founded value is returned.
note : this function doesn't check overflow. If there is, numbers are treated
       as 20 bits words, and overflow doesn't propagate on 32 bits of an
       integer (-1 is never reached when calculus).

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

saddr dec_value ()
{
    saddr val=0L ;

    do
    {
        val = trunc (val * 10L + (saddr) (*pexp-'0') ) ;
        next_char () ;
    }
    while ((*pexp>='0')&&(*pexp<='9')) ;
    return (val);
}


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

                                   HEX_VALUE


synopsis : saddr hex_value ()
description : same as above for hexadecimal constants

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

saddr hex_value ()
{
    saddr i, val = 0L ;

    while ( ((*pexp>='0')&&(*pexp<='9')) ||
            ((*pexp>='A')&&(*pexp<='F')) ||
            ((*pexp>='a')&&(*pexp<='f')) )
    {
        if (*pexp<='9') i = (long int) ((*pexp) - '0') ;
        else if (*pexp<='F') i = (long int) ((*pexp) - 'A' + 10) ;
        else i = (long int) ((*pexp) - 'a' + 10) ;
        val = trunc (val*16L +  i) ;
        next_char () ;
    }
    return (val) ;
}


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

                                   BIN_VALUE


synopsis : saddr bin_value ()
description : same as above for binary constants

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

saddr bin_value ()
{
    saddr val = 0L ;

    while ((*pexp=='0')||(*pexp=='1'))
    {
        val = trunc (val*2L + ((saddr) ((*pexp) - '0'))) ;
        next_char () ;
    }
    return (val) ;
}


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

                                  ASCII_VALUE


synopsis : saddr ascii_value ()
description : same as above, but the search is stopped when encoutered a '.
              The pointer *pexp stands on this character.

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

saddr ascii_value (limit)
uchar limit ;
{
    saddr val = 0 ;

    while ((*pexp!=EOL)&&(*pexp!=limit))
    {
        val = trunc (val*256L + ((saddr) *pexp)) ;
        next_char () ;
    }
    return (val) ;
}


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

                                  LABEL_VALUE


synopsis : saddr label_value ()
description : parses the symbol, then tries to return the value founded in the
              symbol list.

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

saddr label_value ()
{
    uchar label[LBLLEN+2], *plabel ;
    int mx, need_par = 0, j = 0 ;
    saddr val ;

    mx = LBLLEN + ((*pexp=='=') ? 1 : 0) ;
    while ((*pexp!=EOL)&&(*pexp!=' ')&&(*pexp!='\t')&&
           (*pexp!=')')&&(*pexp!='\\'))
    {
        if (j<mx) label[j++] = *pexp ;
        pexp++ ;
    }
    label[j] = EOL ;
    plabel = label ;

    if ((val = symbol_value (label)) >= (saddr) 0)
    {                             /* found, copy value */
     
        if (relabs==LREL) sprintf (label, "%ldr", val) ;
        else sprintf (label, "%ld", val) ;
    }
    else if ((val == LBL_UDF) || (val == LBL_IVL))
    {   /* UDF : label not (yet) declared, IVl : invalid label */
        *plabel = EOL ;                /* incoherent value */
        val = EXP_ERR ;
    }
    else if ((val == LBL_EXT) || (val == LBL_XEQ))
    {   /* LBL_EXT: ext. label not known, LBL_XEQ: global defined with ext. */
        val = EXP_EXT ;                        /* keep label name */
    }
    else                       /* (val == LBL_SEQ) */
    {   /* LBL_SEQ : synonym, expandable */
        plabel = xlabel ;              /* get definition of label */
        need_par = 1 ;                 /* enclose label with (...) */
        val = EXP_EXT ;                /* and store it into extep */
    }

    if (need_par) append_extexp ("(") ;
    append_extexp (plabel) ;
    if (need_par) append_extexp (")") ;

    return (val) ;
}


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

                                     APPLY


synopsis : saddr apply (val1, op, val2, relabs1, relabs2)
           saddr val1, val2
           uchar op, relabs1, relabs2
description : calculate the value of binary operator op applied to operands
              val1 & val2.
note : under overflow condition, numbers are truncated to 20 bits.

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

saddr apply (val1, op, val2, relabs1, relabs2)
uchar op, relabs1, relabs2 ;
saddr val1, val2 ;
{
    saddr val ;

    if (val2==EXP_ERR)                    return (EXP_ERR) ;
    if ((val1==EXP_EXT)||(val2==EXP_EXT)) return (EXP_EXT) ;

    switch (op)
    {
        case '+' :
            val = trunc (val1 + val2) ;
            break ;
        case '-' :
            val = trunc (val1 - val2 ) ;
            break ;
        case '*' :
            val = trunc (val1 * val2 ) ;
            break ;
        case '/' :
#if ASSEMBLER
            val = (val2 ? val1 / val2 : EXP_ERR ) ;
#else
            val = (val2 ? val1 / val2 : EXP_EXT ) ;
#endif
            if (val2==0L)   error (WRNNUL, "") ;   /* null divisor */
            break ;
        case '&' :
            val = val1 & val2 ;
            break ;
        case '!' :
            val = val1 | val2 ;
            break ;
        case '~' :
            val = trunc (val1*256 + val2) ;
            break ;
        case '^' :
            if ((val1<0)||(val2<0)||((val1==0)&&(val2==0)))
            {
                error (WRNIXP, "") ;           /* Illegal exponentiation */
#if ASSEMLER
                val = EXP_ERR ;
#else
                val = EXP_EXT ;
#endif
            }
            else
            {
                val = 1 ;
                for (;val2>0 ; val2--) val *= val1 ;
                val = trunc (val) ;
            }
            break ;
    }
    if ((relabs1==LUDF)||(relabs2==LUDF))      relabs = LUDF ;
    else if ((relabs1==LREL)||(relabs2==LREL)) relabs = LREL ;
    else                                       relabs = LABS ;
    return (val) ;
}


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

                                     TRUNC


synopsis : saddr trunc (val)
           saddr val
description : truncates 32 bits integer to 24 bits.

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

saddr trunc (val)
saddr val ;
{
    return (val & 0xffffff) ;
}


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

                                   NEXT_CHAR


synopsis : void next_char ()
description : stores the current character in extexp variable, and moves the
              expression pointer (pexp) forward one position.

******************************************************************************/
void next_char ()
{
    *pextexp = *pexp ;
    pextexp++ ;
    pexp++ ;
}


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

                                 APPEND_EXTEXP


synopsis : void append_extexp (line)
           uchar *line ;
description : append line to extexp string.

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

void append_extexp (line)
uchar *line ;
{
    while (*line)
    {
        *pextexp = *line ;
        pextexp++ ;
        line++ ;
    }
}
@EOF
set `wc -lwc <areuh/linker/exp.c`
if test $1$2$3 != 634182916414
then
	echo ERROR: wc results of areuh/linker/exp.c are $* should be 634 1829 16414
fi

chmod 644 areuh/linker/exp.c

echo x - areuh/linker/err.h
cat >areuh/linker/err.h <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

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

                           AREUH ASSEMBLER / LINKER


                          ERROR NUMBERS DECLARATIONS

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




/* FATAL ERRORS */

#define ERROPN  -1                                       /* A L */
    /* system error opening file */
#define ERRCLO  -2                                       /* A L */
    /* system error closing file */
#define ERRREW  -3                                       /* A */
    /* system error on file at start of pass two */
#define ERRWRT  -4                                       /* A L */
    /* system error writing file */
#define ERRRD   -5                                       /* A L */
    /* system error reading file */
#define ERRMEM  -6                                       /* A L */
    /* not enough memory */

#define ERRLEX  -10                                      /* A */
    /* invalid macro pseudo-op LEX or BIN */
#define ERRPGS  -11                                      /* A */
    /* invalid page size */
#define ERRFLN  -12                                      /* A */
    /* restricted label FiLeNd exists */
#define ERRIFL  -13                                      /* A L */
    /* invalid file name */
#define ERRIMO  -14                                      /* A */
    /* invalid macro-op xx in modular assembling */
#define ERRVMD  -15                                      /* A */
    /* value must be defined for xx */

#define ERRUSA  -20                                      /* A L */
    /* usage: ass [ [-l] source_file ] */
    /* usage: ald ... */

#define ERRNOA  -30                                      /* L */
    /* file not output from aas */
#define ERRICV  -31                                      /* L */
    /* incompatible version */



/* NON FATAL ERRORS */

#define WRNEQU  10                                       /* A */
    /* cannot resolve equate */
#define WRNDUP  11                                       /* A L */
    /* duplicate label */
#define WRNLBL  12                                       /* A */
    /* illegal label */
#define WRNULB  13                                       /* A */
    /* unrecognized label */
#define WRNURF  14                                       /* L */
    /* unresolved reference */
#define WRNURL  15                                       /* L */
    /* unresolved label */

#define WRNEXP  20                                       /* A */
    /* illegal expression */
#define WRNASC  21                                       /* A */
    /* illegal ascii constant */
#define WRNPAR  22                                       /* A */
    /* mismatched parenthesis */
#define WRNIHX  23                                       /* A */
    /* illegal hexadecimal constant */
#define WRNNUL  24                                       /* A */
    /* null divisor */
#define WRNIXP  25                                       /* A */
    /* illegal exponentiation */
#define WRNIBC  26                                       /* A */
    /* illegal binary constant */
#define WRNENA  27                                       /* A */
    /* external references not allowed */

#define WRNYES  30                                       /* A */
    /* GOYES or RTNYES required */
#define WRNIDP  31                                       /* A */
    /* illegal dp arithmetic value */
#define WRNIPP  32                                       /* A */
    /* illegal pointer position */
#define WRNISB  33                                       /* A */
    /* illegal status bit */
#define WRNTFR  34                                       /* A */
    /* illegal transfer value */
#define WRNIWS  35                                       /* A */
    /* illegal word select */
#define WRNLST  36                                       /* A */
    /* invalid LIST argument */
#define WRNJVL  37                                       /* A L */
    /* jump or value too large */
#define WRNMLB  38                                       /* A */
    /* missing label */
#define WRNTST  39                                       /* A */
    /* needs previous test instruction */
#define WRNNHX  40                                       /* A */
    /* non hexadecimal digits present */
#define WRNTMA  41                                       /* A */
    /* too many ascii characters present */
#define WRNTMH  42                                       /* A */
    /* too many hexadecimal digits present */
#define WRNOPC  43                                       /* A */
    /* unknown opcode */

#define WRNIIF  50                                       /* A */
    /* invalid conditional structure */

extern void error() ;
@EOF
set `wc -lwc <areuh/linker/err.h`
if test $1$2$3 != 1275845010
then
	echo ERROR: wc results of areuh/linker/err.h are $* should be 127 584 5010
fi

chmod 644 areuh/linker/err.h

echo x - areuh/linker/common.h
cat >areuh/linker/common.h <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

#include <stdio.h>


#define MAXLEN 256
#define EOL    '\0'
#define LBLLEN 12

/******************************************************************************
 TYPE DEFINITIONS
******************************************************************************/

typedef long int saddr ;	      /* Saturne address. At least 32 bits   */
typedef unsigned char uchar ;	      /* unsigned characters, for accents    */
typedef short int sint ;	      /* 16 bits */

/******************************************************************************
 MAGIC NUMBERS
******************************************************************************/

#define  AL_MAGIC 0x1b080100	      /* ... areuh_lex */
#define  AO_MAGIC 0x1b0d0100	      /* ... areuh_output of assembler */
#define ALF_MAGIC 0x1b080100	      /* first version of object file format */
#define AOF_MAGIC 0x1b0d0100	      /* first version of object file format */


/******************************************************************************
 USAGE TYPES IN .ao FILES
******************************************************************************/

#define XABSL 0x10     /* absolute reference */
#define XABSO 0x20     /* absolute reference, with one bias */
#define XRGTO 0x40     /* relative reference, goto type */
#define XRGSB 0x80     /* relative reference, gosub type */


/******************************************************************************
 LABEL VALUES IN .ao FILES
******************************************************************************/

#define LBL_UDF -1L
    /* label not declared (implicit or explicit) <=> only used */
#define LBL_IVL -2L
    /* invalid label (invalid expression for an EQU during pass one) */
#define LBL_EXT -3L
    /* external label not defined here (or yet) */
#define LBL_XEQ -4L
    /* global label which is defined here, with an external reference */
#define LBL_SEQ -5L
    /* local label which is defined with an external reference */


/******************************************************************************
 LABEL TYPES IN .ao FILES
******************************************************************************/

#define LUDF 0
    /* undefined type (external label) */
#define LABS 1
    /* absolute local label (declared explicitly, with constants) */
#define LREL 2
    /* relative local label (declared implicitly, or explicitly with at least
       one relative) */


/******************************************************************************
 VALUES RETURNED BY EXPRESSION EVALUATOR
******************************************************************************/

#define EXP_ERR -1L
#define EXP_EXT -2L

extern int relabs ;
extern uchar extexp[] ;

#include "err.h"
extern void error () ;

#define hex5(str,val) format_hex (str, val, 5) ;
#define hex6(str,val) format_hex (str, val, 6) ;

/******************************************************************************
 MACHINE DEPENDANCIES
******************************************************************************/

#define HPUX		     1
#define ATARI_LATTICE	     0
#define PC_MSC		     0		/* PC (beuark, Microsoft C) */

#if HPUX
extern void format_time(), load_file() ;
#define HP71EP "hp71.ep"
#define RAO_MODE "r"
#define WAO_MODE "w"
#define skip(fp)
#endif

#if ATARI_LATTICE
extern void format_time(), load_file() ;
#define HP71EP "hp71.ep"
#define RAO_MODE "rb"
#define WAO_MODE "wb"
extern char skipvar ;
#define skip(fp) fread(&skipvar,1,1,fp) ;
#endif

#if PC_MSC
extern void format_time(), load_file() ;
#define HP71EP "hp71.ep"
#define RAO_MODE "rb"
#define WAO_MODE "wb"
extern char skipvar ;
#define skip(fp) fread(&skipvar,1,1,fp) ;
#endif
@EOF
set `wc -lwc <areuh/linker/common.h`
if test $1$2$3 != 1244243878
then
	echo ERROR: wc results of areuh/linker/common.h are $* should be 124 424 3878
fi

chmod 644 areuh/linker/common.h

echo x - areuh/linker/lutil.c
cat >areuh/linker/lutil.c <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

#include "lglobal.h"

extern char *malloc () ;
extern saddr calc_expression () ;
uchar *memoire () ;

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

				  FIND_LABEL

synopsis : struct symbol *find_label (label)
	   char *label
description : find address of label, return address of structure describing it.

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

struct symbol *find_label (label)
char *label ;
{
    struct symbol *p ;
    int test ;

    p = h_label [label[1]]->s_next ;
    while (p)
    {
	test = strcmp (label, p->s_name) ;
	if (test==0)  break ;
	p = p->s_next ;
	if (test<0) p = (struct symbol *) NULL ;
    }
    return (p) ;
}


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

				   ADD_LABEL


synopsis : void add_label (label, val, os)
	   uchar *label
	   saddr val
	   int os
description : add a label in label table and, if already defined, add it to
  multiply defined lists.

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

void add_label (label, val, os)
uchar *label ;
saddr val ;
int os ;
{
    uchar error_text [MAXLEN+1] ;
    struct symbol *p, *s ;
    int b = 1 ;

    p = find_label (label) ;
    if (p)
    {
	sprintf (error_text, "%s in files %s and %s", label,
			     fname[p->s_file],
			     fname[file]) ;
	error (WRNDUP, error_text) ;	       /* duplicate label */
    }
    else
    {
	s = p = h_label [label[1]] ;
	while ((b)&&(s))
	{
	    if (strcmp (label, s->s_name)<0) b = 0 ;
	    else
	    {
		p = s ;  s = s->s_next ;
	    }
	}
	s = (struct symbol *) memoire (sizeof (struct symbol)) ;
	s->s_next = p->s_next ;
	p->s_next = s ;
	strcpy (s->s_name, label) ;
	s->s_xref = (struct xtable *) NULL ;
	p = s ;
    }
    p->s_value = val ;
    p->s_file = (uchar) file ;
    p->s_os = os ;
}


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

				ADD_UNRES


synopsis : void add_unres (label, def)
	   char *label, *def
	   int file
description : during first part of pass one, if a label is undefined, add it
  to a special list. During second part, if this list is scaned. If value
  is then defined, the label will be removed. At the end of first pass, this
  queue will be the undefined labels queue, which should be empty...

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

void add_unres (label, def)
uchar *label, *def ;
{
    struct unres *x ;

    x = (struct unres *) memoire (sizeof (struct unres)) ;
    strcpy (x->u_label, label) ;
    x->u_file = (uchar) file ;
    x->u_def = memoire (strlen (def) + 1) ;
    strcpy (x->u_def, def) ;
    x->u_next = head_unres ;
    head_unres = x ;
}


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

				  READ_USAGE


synopsis : void read_usage (characteristic, def, fp)
	   long int *characteristic
	   char *def
	   FILE *fp
description : read an entry in third part of object file fp.

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

void read_usage (characteristic, def, fp)
long int *characteristic ;
char *def ;
FILE *fp ;
{
    int i ;

    fread (characteristic, sizeof (long int), 1, fp) ;
    fread (&pc, sizeof (saddr), 1, fp) ;
    i = 0 ;
    while ((def [i] = (uchar) fgetc (fp)) != '\n') i++ ;
    def [i] = EOL ;
    if (ferror (fp)) error (ERRRD, fname [file]) ;
}


int lrange (offset, nibs)
saddr *offset ;
int nibs ;
{
    saddr Sixtine, Fiftine ;
    int r ;

    Sixtine = ((saddr) 1) << (nibs*4) ;
    Fiftine = Sixtine >> 1 ;
    r = ((*offset>=-Fiftine)&&(*offset<Fiftine)) ;
    if (*offset<0) *offset += Sixtine ;
    return (r) ;
}


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

			      RESOLVE_USAGE


synopsis : void resolve_usage (characteristic, def, file, fp, code)
	   long int characteristic
	   char *def, *code
	   FILE *fp
	   int file
description : make all the work which is to be made by a linker. Resolve
  all usages.

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

void resolve_usage (characteristic, def, fp, code)
saddr characteristic ;
uchar *def, *code ;
FILE *fp ;
{
    uchar hexa [MAXLEN+1] ;
    saddr type, source, dest, offset ;
    int i, j ;

    type = characteristic & (XABSL | XABSO | XRGTO | XRGSB) ;
    characteristic &= ~type ;
    dest = calc_expression (def) ;
    if (dest < (saddr) 0)
    {
	error (WRNURF, def) ;	  /* unresolved reference */
	dest = (saddr) 0 ;
    }
    switch ((int) type)
    {
	case XABSL :
	    source = 0 ;
	    break ;
	case XABSO :
	    source = 1 ;
	    break ;
	case XRGTO :
	    source = tmodule [file].m_ad + pc  ;
	    break ;
	case XRGSB :
	    source = tmodule [file].m_ad + pc  + characteristic ;
	    break ;
    }
    offset = dest - source ;
    if ((type==XRGTO)||(type==XRGSB))
    {
	if (!lrange (&offset, characteristic))
	{
	    offset = (saddr) 0 ;
	    error (WRNJVL, def) ;    /* Jump or value too large */
	}
    }
    hex6 (hexa, offset) ;
    for (i=0, j=5; i<characteristic; i++, j--)
    {
	code [pc+i] = hexa[j] ;
    }
}


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

				SYMBOL_VALUE


synopsis : saddr symbol_value (label)
	   uchar *label
description : fetch a label, and return its value.

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

saddr symbol_value (label)
uchar *label ;
{
    struct symbol *ad ;
    struct xtable *x, *y, *z ;

    ad = find_label (label) ;

    if ((ad)&&(passnb==2)&&xref)
    {
	x = (struct xtable *) memoire (sizeof (struct xtable)) ;
	x->x_pc = pc ;
	x->x_file = file ;
	z = y = ad->s_xref ;
	while ((y)&&(y->x_file<file))
	{
	    z = y ;
	    y = y->x_next ;
	}
	if (y==z) ad->s_xref = x ;	/* insert at begining of the list */
	else z->x_next = x ;		/* insert in middle of list */
	x->x_next = y ;
	ad->s_os = 0 ;
    }
    return ((ad) ? ad->s_value : EXP_EXT) ;
}


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

				  MEMOIRE


synopsis : uchar *memoire (size)
	   int size
description : get memory from heap using malloc. It is just a layer above
	      malloc, including a test.

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

uchar *memoire (size)
int size ;
{
    uchar *x ;

    if ((x = (uchar *) malloc (size)) == NULL)
	error (ERRMEM, "") ;
    return (x) ;
}


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

				 FORMAT_HEX


synopsis : void format_hex (str, val, dig)
	   uchar *str
	   saddr val
	   int dig
description : stores into str the hexadecimal string representing the dig
	      low order hex digits of val.

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

format_hex (str, val, dig)
uchar *str ;
saddr val ;
int dig ;
{
    register int i, h ;

    for (i=dig-1; i>=0; i--)
    {
	h = (int) (val & ((saddr) 0xf)) ;
	str [i] = h + ((h < 10) ? '0' : 'A' - 10) ;
	val >>= 4 ;
    }
    str [dig] = EOL ;
}
@EOF
set `wc -lwc <areuh/linker/lutil.c`
if test $1$2$3 != 32910407349
then
	echo ERROR: wc results of areuh/linker/lutil.c are $* should be 329 1040 7349
fi

chmod 644 areuh/linker/lutil.c

echo x - areuh/linker/lpass.c
cat >areuh/linker/lpass.c <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

#include "lglobal.h"


extern void add_label (), add_unres () ;
extern long int calc_expression () ;
extern uchar *memoire () ;


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

				   PASS1


synopsis : pass1 ()
description : processes the first pass on the object files. Open each file,
  read part one (code) and two (public label definitions), and close it.

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

pass1 ()
{
    tmodule [1].m_ad = (saddr) 0 ;
    for (file=1; file<=nfile; file++)	ps_part12 () ;
	    /* still undefined labels ? */
    file = nfile + 1 ;
    add_label ("=FiLeNd", tmodule[file].m_ad, 0) ;
    if (head_unres)    pass1_bis () ;	    /* yes, try to resolve */
}


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

				  PS_PART12


synopsis : ps_part12 ()
description : in first pass, process parts one and two of an object file, and
  store all necessary informations in tmodule array.
  name is the file name, i is the entry in tmodule array.

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

ps_part12 ()
{
    FILE *fp ;
    uchar label [LBLLEN+2], def [MAXLEN+1], type ;
    saddr size, val ;
    long int part2, nl, magic ;
    int j, k ;

    if (!(fp = fopen (fname[file], RAO_MODE)))
	error (ERROPN, fname[file]) ;	  /* error opening file */
    fgetl (magic, fp) ;
    if ((magic<AOF_MAGIC)||(magic>AO_MAGIC))
	error (ERRNOA, fname[file]) ;	  /* not output of aas */
    if (magic!=AO_MAGIC)
	error (ERRICV, fname[file]) ;	  /* incompatible version */

    fgetl (part2, fp) ;
    fgetl (size, fp) ;			   /* length of code */
    tmodule[file+1].m_ad = tmodule[file].m_ad + size ;

    fseek (fp, part2, 0) ;
    fgetl (tmodule[file].m_part3, fp) ;
    fgetl (nl, fp) ;

    if (ferror (fp)) error (ERRRD, fname [file]) ;

    for (j=1; j<=nl; j++)
    {
	k = 0 ;
	while ((label [k] = (uchar) fgetc (fp)) != '\n') k++ ;
	label [k] = EOL ;
	fgetl (val, fp) ;
	if (ferror (fp)) error (ERRRD, fname [file]) ;
	if (val<0L)
	{
	    k = 0 ;
	    while ((def [k] = (uchar) fgetc (fp)) != '\n') k++ ;
	    def [k] = EOL ;
	    val = calc_expression (def) ;
	}
	else
	{
	    type = (uchar) getc (fp) ;
	    switch (type)
	    {
		case LABS :
		    break ;
		case LREL :
		    val += tmodule[file].m_ad ;
		    break ;
		case LUDF :
		default :
		    fprintf (stderr, "Internal error. Aie aie aie. LUDF\n") ;
		    exit (1) ;
	    }
	}
	if (val>=0L) add_label (label, val, 0) ;
	else add_unres (label, def) ;
    }
    if (fclose (fp)) error (ERRCLO, fname[file]) ;   /* error closing file */
}


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

				PASS1_BIS


synopsis : pass1_bis ()
description : at the end of first pass, if still undefined labels, try to
  resolve all definitions. If not succesful, exit on error.

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

pass1_bis ()
{
    struct unres *xdef ;
    saddr val ;

    passbis = 1 ;     /* signal to error message driver */

    while (head_unres)
    {
	file = head_unres->u_file ;
	val = calc_expression (head_unres->u_def) ;

	if (val<0) error (WRNURL, head_unres->u_label) ; /* unresolved label */
	else add_label (head_unres->u_label, val, 0) ;

	xdef = head_unres ;
	head_unres = head_unres->u_next ;
        free ((char *) xdef->u_def) ;
	free ((char *) xdef) ;
    }

    passbis = 0 ;
}


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

				PASS2


synopsis : void pass2 ()
description : during pass two, we open each file, we read the code into a
  string variable properly dimensioned. Then, for each external reference
  usage, we store the proper value into the proper place (we hope so !).
  At last, we append the code to the final lex file. That's grehate.

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

void pass2 ()
{
    FILE *fp ;
    uchar def [MAXLEN+1], *code ;
    int j ;
    long int size, bidon, nu, characteristic ;

    for (file=1; file<=nfile; file++)
    {
	fp = fopen (fname[file], RAO_MODE) ;
	if (!fp) error (ERROPN, fname[file]) ;
	fgetl (bidon, fp) ;
	fgetl (bidon, fp) ;
	fgetl (size, fp) ;
	code = memoire (size) ;
	fread ((char *) code, (int) size, 1, fp) ;

	fseek (fp, tmodule[file].m_part3, 0) ;
	fgetl (nu, fp) ;

	if (ferror (fp)) error (ERRRD, fname [file]) ;

	for (j=1; j<=nu; j++)
	{
	    read_usage (&characteristic, def, fp) ;
	    resolve_usage (characteristic, def, fp, code) ;
	}

	fwrite (code, (int) size, 1, fplex) ;
	free ((char *) code) ;
	if (ferror (fplex)) error (ERRWRT, flex) ;
	if (fclose (fp)) error (ERRCLO, fname[file]) ;
    }
}
@EOF
set `wc -lwc <areuh/linker/lpass.c`
if test $1$2$3 != 1997114979
then
	echo ERROR: wc results of areuh/linker/lpass.c are $* should be 199 711 4979
fi

chmod 644 areuh/linker/lpass.c

echo x - areuh/linker/lmain.c
cat >areuh/linker/lmain.c <<'@EOF'
/*
 * Authors :
 *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
 *   Janick TAILLANDIER
 *
 * This program can be freely used or distributed as long as this
 * note is kept.
 *
 * This program is provided "as is".
 */

#include "lglobal.h"

saddr pc ;
int nfile, file ;
uchar flex [MAXLEN+1], flisting [MAXLEN+1] ;
FILE *fplex ;
struct module tmodule[MAXMOD] ;
struct unres *head_unres ;
struct symbol *h_label[256] ;
uchar *code ;
uchar *fname[MAXMOD+2] ;
int page_size, cntlist, xref, passnb, errnb ;
int passbis = 0 ;

void prompt (), read_line (), make_name () ;
extern uchar *memoire () ;

main (argc, argv)
int argc ;
uchar *argv[] ;
{
    int r = 0, c, i ;
    int errflg = 0 ;

    extern char *optarg ;
    extern int optind, opterr ;

    opterr = 0 ;

    xref = 0 ;
    page_size = 0 ;
    strcpy (flex, "") ;
    strcpy (flisting, "") ;

    fname[0] = memoire (sizeof(HP71EP)+1) ;
    strcpy (fname[0], HP71EP) ;
    nfile = 0 ;

    while ((c = getopt (argc, argv, "xa:Apl:o:")) != EOF)
        switch (c)
        {
            case 'x' :
                xref = 1 ;
                break ;
            case 'a' :
                strcpy (flisting, optarg) ;
                cntlist = 2 ;
                break ;
            case 'A' :
                cntlist = 1 ;
                break ;
            case 'p' :
                r++ ;
                break ;
            case 'l' :
                sscanf (optarg, "%d", &page_size) ;
                break ;
            case 'o' :
                strcpy (flex, optarg) ;
                break ;
            case '?' :
                errflg++ ;
                break ;
        }
        
    if ((r)||(argc==1)) prompt () ;
    if (errflg || ((optind==argc)&&(nfile==0)))
        error (ERRUSA, "") ;
    for (i=optind; i<argc; i++)
        make_name (nfile+i-optind+1, argv [i]) ;
    nfile += argc - optind ;

    if (*flex==EOL) strcpy (flex, "lex") ;

    if (page_size==0) page_size = 72 ;

    fname [nfile + 1] = memoire (sizeof("eof.ep")+1) ;
    strcpy (fname[nfile + 1], "eof.ep") ;

    init () ;
    pass1 () ;
    between () ;
    pass2 () ;
    term () ;
    exit (errnb) ;
}


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

                                    PROMPT


synopsis : void prompt ()
description : if "-p" option is used, or if no parameters are passed to "ald",
  asks the user for missing arguments.

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

void prompt ()
{
    uchar line [MAXLEN+1] ;

    do
    {
        printf ("Input module : ") ;
        read_line (stdin, line) ;
        if (*line) make_name (++nfile, line) ;
    } while (*line) ;
    if (*flex==EOL)
    {
        printf ("Object file : ") ;
        read_line (stdin, flex) ;
    }
    if (cntlist==0)
    {
        printf ("Listing file : ") ;
        read_line (stdin, flisting) ;
        if (*flisting)
        {
            cntlist = 2 ;
            xref = 1 ;
        }
        else cntlist = 0 ;
    }
    if (cntlist)
    {
        if (page_size==0)
        {
            printf ("Page length : ") ;
            read_line (stdin, line) ;
            sscanf (line, "%d", &page_size) ;
        }
    }
}

void read_line (fp, line)
FILE *fp ;
uchar *line ;
{
    int c, i = -1 ;

    do
    {
        c = getc (fp) ;
        if (i<MAXLEN) line[++i] = c ;
    } while ((c!=EOF)&&(c!='\n')) ; 
    line[i] = EOL ;
    if (ferror (fp)) error (ERRRD, "stdin") ; /* il se trouve que c'est stdin */
}


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

                                   MAKE_NAME


synopsis : void make_name (i, file)
           int i
           uchar *file
description : parse file name, and store file name with proper extension in
  fname table.

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

void make_name (i, file)
int i ;
uchar *file ;
{
    uchar *pfile ;

    pfile = file ;
    while ((*pfile)&&(*pfile!='.')) pfile++ ;
    fname [i] = memoire (strlen(file) + ((*pfile) ? 1 : 4) ) ;
    strcpy (fname[i], file) ;
    if (!(*pfile)) strcat (fname[i], ".ao") ;
}
@EOF
set `wc -lwc <areuh/linker/lmain.c`
if test $1$2$3 != 1885714190
then
	echo ERROR: wc results of areuh/linker/lmain.c are $* should be 188 571 4190
fi

chmod 644 areuh/linker/lmain.c

exit 0