🚀 go-pugleaf

The problem occurred with the free "f2c" f77-compatible Fortran-to-C
translater recently released by AT&T.

All tools used below are the GNU versions.

I suspect the bug lies in the loader.

The preprocessed output of wsfe.c as well as the compiler output
wsfe.s are appended to this bug report.

# The symptom is a relocation error when trying to use the library.
$ cc -v spara.o ../f2c/libF77/libF77.a ../f2c/libI77/libI77.a -lm
gcc version 1.36
 /gnu/lib/ld /gnu/lib/crt0.o spara.o ../f2c/libF77/libF77.a ../f2c/libI77/libI77.a -lm /gnu/lib/gnulib -lc
ld: relocation address out of range in ../f2c/libI77/libI77.a(wsfe.o)


# The library was built as follows:
$ cc -O -S -v /tmp/wsfe.c
gcc version 1.36
 /gnu/lib/cpp -v -undef -D__GNUC__ -Dmc68000 -Dmc68k -Dunix -Dunixpc -D__mc68000__ -D__mc68k__ -D__unix__ -D__unixpc__ -D__OPTIMIZE__ -Dmc68010 /tmp/wsfe.c /usr/tmp/cca11426.cpp
GNU CPP version 1.36
 /gnu/lib/cc1 /usr/tmp/cca11426.cpp -quiet -dumpbase /tmp/wsfe.c -O -version -o wsfe.s
GNU C version 1.36 (68k, MIT syntax) compiled by GNU C version 1.36.
default target switches:

# This is the GNU assembler, dated around October 1989, with the -m68010
# flag permanently turned on.  Taken from an official release on prep.
$ as -o wsfe.o wsfe.s

# GNU loader, snarfed out of the binutils on apple-gunkies around
# October 1989.  Not from an official release.

# Interestingly enough, if this step is omitted, the
# relocation bug above does not occur.  The libI77 makefile says
# the purpose of this step is to eliminate unnecessary symbols
# from the library.

$ ld -r -x wsfe.o
$ mv a.out wsfe.o

# GNU 'ar' and 'ranlib', from the same place as the loader.
$ ar r libI77.a Version.o backspace.o dfe.o due.o iio.o inquire.o rewind.o rsfe.o rdfmt.o sue.o uio.o wsfe.o sfe.o fmt.o lio.o lread.o open.o close.o util.o endfile.o wrtfmt.o wref.o err.o fmtlib.o rsne.o wsne.o
Creating archive file `libI77.a'
$ ranlib libI77.a


### Preprocessed output of wsfe.c:
# 1 "wsfe.c"
 
# 1 "f2c.h" 1
 

 






typedef long int integer;
typedef char *address;
typedef short int shortint;
typedef float real;
typedef double doublereal;
typedef struct { real r, i; } complex;
typedef struct { doublereal r, i; } doublecomplex;
typedef long int logical;
typedef short int shortlogical;




 




 







typedef long flag;
typedef long ftnlen;
typedef long ftnint;


 
typedef struct
{	flag cierr;
	ftnint ciunit;
	flag ciend;
	char *cifmt;
	ftnint cirec;
} cilist;

 
typedef struct
{	flag icierr;
	char *iciunit;
	flag iciend;
	char *icifmt;
	ftnint icirlen;
	ftnint icirnum;
} icilist;

 
typedef struct
{	flag oerr;
	ftnint ounit;
	char *ofnm;
	ftnlen ofnmlen;
	char *osta;
	char *oacc;
	char *ofm;
	ftnint orl;
	char *oblnk;
} olist;

 
typedef struct
{	flag cerr;
	ftnint cunit;
	char *csta;
} cllist;

 
typedef struct
{	flag aerr;
	ftnint aunit;
} alist;

 
typedef struct
{	flag inerr;
	ftnint inunit;
	char *infile;
	ftnlen infilen;
	ftnint	*inex;	 
	ftnint	*inopen;
	ftnint	*innum;
	ftnint	*innamed;
	char	*inname;
	ftnlen	innamlen;
	char	*inacc;
	ftnlen	inacclen;
	char	*inseq;
	ftnlen	inseqlen;
	char 	*indir;
	ftnlen	indirlen;
	char	*infmt;
	ftnlen	infmtlen;
	char	*inform;
	ftnint	informlen;
	char	*inunf;
	ftnlen	inunflen;
	ftnint	*inrecl;
	ftnint	*innrec;
	char	*inblank;
	ftnlen	inblanklen;
} inlist;



union Multitype {	 
	shortint h;
	integer i;
	real r;
	doublereal d;
	complex c;
	doublecomplex z;
	};

typedef union Multitype Multitype;

typedef long Long;

struct Vardesc {	 
	char *name;
	char *addr;
	Long *dims;
	int  type;
	};
typedef struct Vardesc Vardesc;

struct Namelist {
	char *name;
	Vardesc **vars;
	int nvars;
	};
typedef struct Namelist Namelist;








 


# 168 "f2c.h"

typedef int   (*U_fp)();
typedef shortint (*J_fp)();
typedef integer (*I_fp)();
typedef real (*R_fp)();
typedef doublereal (*D_fp)(), (*E_fp)();
typedef   void  (*C_fp)();
typedef   void  (*Z_fp)();
typedef logical (*L_fp)();
typedef shortlogical (*K_fp)();
typedef   void  (*H_fp)();
typedef   int (*S_fp)();

 
typedef void  C_f;	 
typedef void  H_f;	 
typedef void  Z_f;	 
typedef doublereal E_f;	 

 

# 208 "f2c.h"


# 2 "wsfe.c" 2

# 1 "fio.h" 1
# 1 "/usr/include/stdio.h" 1


 

















 


typedef struct {

	int	_cnt;
	unsigned char	*_ptr;




	unsigned char	*_base;
	char	_flag;
	char	_file;
} FILE;

 








































extern FILE	_iob[20];
extern FILE	_iob2[80 -20];
extern FILE	*fopen(), *fdopen(), *freopen(), *popen(), *tmpfile();
extern long	ftell();
extern void	rewind(), setbuf();
extern char	*ctermid(), *cuserid(), *fgets(), *gets(), *tempnam(), *tmpnam();
extern unsigned char *_bufendtab[];
extern unsigned char *_buf2endtab[];






# 1 "fio.h" 2






 
typedef struct
{	FILE *ufd;	 
	char *ufnm;
	long uinode;
	int url;	 
	flag useek;	 
	flag ufmt;
	flag uprnt;
	flag ublnk;
	flag uend;
	flag uwrt;	 
	flag uscrtch;
} unit;

extern int errno;
extern flag init;
extern cilist *elist;	 
extern flag reading,external,sequential,formatted;
extern int (*getn)(),(*putn)();	 
extern FILE *cf;	 
extern unit *curunit;	 
extern unit units[];


 


extern int recpos;	 
extern int cursor;	 
extern int hiwater;	 











# 3 "wsfe.c" 2

# 1 "fmt.h" 1
struct syl
{	int op,p1,p2,p3;
};

































extern struct syl syl[];
extern int pc,parenlvl,revloc;
extern int (*doed)(),(*doned)();
extern int (*dorevert)(),(*donewrec)(),(*doend)();
extern flag cblank,cplus,workdone, nonl;
extern int dummy();
extern char *fmtbuf;
extern int scale;
typedef union
{	real pf;
	doublereal pd;
} ufloat;
typedef union
{	short is;
	char ic;
	long il;
} uint;



extern int cursor;
# 4 "wsfe.c" 2

extern int x_putc(),w_ed(),w_ned();
extern int xw_end(),xw_rev(),x_wSL();
extern int hiwater;
integer s_wsfe(a) cilist *a;	 
{	int n;
	if(!init) f_init();
	if(n=c_sfe(a)) return(n);
	reading=0;
	sequential=1;
	formatted=1;
	external=1;
	elist=a;
	hiwater = cursor=recpos=0;
	nonl = 0;
	scale=0;
	fmtbuf=a->cifmt;
	curunit = &units[a->ciunit];
	cf=curunit->ufd;
	if(pars_f(fmtbuf)<0) {if(a->cierr) errno= 100; else fatal(100,"startio"); return(100);} ;
	putn= x_putc;
	doed= w_ed;
	doned= w_ned;
	doend=xw_end;
	dorevert=xw_rev;
	donewrec=x_wSL;
	fmt_bg();
	cplus=0;
	cblank=curunit->ublnk;
	if(curunit->uwrt != 1 && nowwriting(curunit))
		{if(a->cierr) errno= errno; else fatal(errno,"write start"); return(errno);} ;
	return(0);
}
x_putc(c)
{
	 
	if(c == '\n' && recpos < hiwater) {	 

		if(cf->_ptr + hiwater - recpos < (cf->_flag & 	0004  ? cf->_ptr : cf->_base + 1024 ) )
			cf->_ptr += hiwater - recpos;
		else

			(void) fseek(cf, (long)(hiwater - recpos), 1);
	}
	(--(cf)->_cnt >= 0 ? ((int) (*(cf)->_ptr++ = (unsigned char) (c))) : _flsbuf((unsigned char) (c), (cf))) ;
	recpos++;
}
pr_put(c)
{	static flag new = 1;
	recpos++;
	if(c=='\n')
	{	new=1;
		(--(cf)->_cnt >= 0 ? ((int) (*(cf)->_ptr++ = (unsigned char) (c))) : _flsbuf((unsigned char) (c), (cf))) ;
	}
	else if(new==1)
	{	new=0;
		if(c=='0') (--(cf)->_cnt >= 0 ? ((int) (*(cf)->_ptr++ = (unsigned char) ('\n'))) : _flsbuf((unsigned char) ('\n'), (cf))) ;
		else if(c=='1') (--(cf)->_cnt >= 0 ? ((int) (*(cf)->_ptr++ = (unsigned char) ('\f'))) : _flsbuf((unsigned char) ('\f'), (cf))) ;
	}
	else (--(cf)->_cnt >= 0 ? ((int) (*(cf)->_ptr++ = (unsigned char) (c))) : _flsbuf((unsigned char) (c), (cf))) ;
}
x_wSL()
{
	(*putn)('\n');
	recpos=0;
	cursor = 0;
	hiwater = 0;
	return(1);
}
xw_end()
{
	if(nonl == 0)
		(*putn)('\n');
	hiwater = recpos = cursor = 0;
	return(0);
}
xw_rev()
{
	if(workdone) (*putn)('\n');
	hiwater = recpos = cursor = 0;
	return(workdone=0);
}
### END OF wsfe.c

### Assembler input wsfe.s.  This was produced by 68k gcc-1.36
### with the options and target-flags shown above.  The configuration
### is unique to my machine but is roughly equivalent to a sun2.
#NO_APP
gcc_compiled.:
.text
LC0:
	.ascii "startio\0"
LC1:
	.ascii "write start\0"
	.even
.globl _s_wsfe
_s_wsfe:
	link a6,#0
	movel a2,sp@-
	movel a6@(8),a2
	tstl _init
	jne L2
	jbsr _f_init
L2:
	movel a2,sp@-
	jbsr _c_sfe
	addqw #4,sp
	tstl d0
	jne L1
	clrl _reading
	moveq #1,d1
	movel d1,_sequential
	movel d1,_formatted
	movel d1,_external
	movel a2,_elist
	clrl _recpos
	clrl _cursor
	clrl _hiwater
	clrl _nonl
	clrl _scale
	movel a2@(12),_fmtbuf
	pea 44:w
	movel a2@(4),sp@-
	jbsr ___mulsi3
	addqw #8,sp
	movel d0,a0
	addl #_units,a0
	movel a0,_curunit
	movel a0@,_cf
	movel _fmtbuf,sp@-
	jbsr _pars_f
	addqw #4,sp
	tstl d0
	jge L4
	tstl a2@
	jeq L5
	moveq #100,d1
	movel d1,_errno
	jra L6
L5:
	pea LC0
	pea 100:w
	jbsr _fatal
L6:
	moveq #100,d0
	jra L1
L4:
	movel #_x_putc,_putn
	movel #_w_ed,_doed
	movel #_w_ned,_doned
	movel #_xw_end,_doend
	movel #_xw_rev,_dorevert
	movel #_x_wSL,_donewrec
	jbsr _fmt_bg
	clrl _cplus
	movel _curunit,a0
	movel a0@(28),_cblank
	moveq #1,d1
	cmpl a0@(36),d1
	jeq L7
	movel a0,sp@-
	jbsr _nowwriting
	addqw #4,sp
	tstl d0
	jeq L7
	tstl a2@
	jne L9
	pea LC1
	movel _errno,sp@-
	jbsr _fatal
L9:
	movel _errno,d0
	jra L1
L7:
	moveq #0,d0
L1:
	movel a6@(-4),a2
	unlk a6
	rts
	.even
.globl _x_putc
_x_putc:
	link a6,#0
	moveml #0x3000,sp@-
	movel a6@(8),d2
	moveq #10,d3
	cmpl d2,d3
	jne L11
	movel _recpos,d3
	cmpl _hiwater:l,d3
	jge L11
	movel _cf,a0
	movel a0@(4),d0
	addl _hiwater,d0
	movel d0,d1
	subl _recpos,d1
	btst #2,a0@(12)
	jeq L13
	movel a0@(4),d0
	jra L14
L13:
	movel _cf,a0
	movel a0@(8),d0
	addl #1024,d0
L14:
	cmpl d1,d0
	jls L12
	movel _cf,a0
	movel _hiwater,d0
	subl _recpos,d0
	addl d0,a0@(4)
	jra L11
L12:
	pea 1:w
	movel _hiwater,d3
	subl _recpos,d3
	movel d3,sp@-
	movel _cf,sp@-
	jbsr _fseek
	addw #12,sp
L11:
	movel _cf,a0
	subql #1,a0@
	jmi L16
	addqw #4,a0
	movel a0@,a1
	moveb d2,a1@
	addql #1,a0@
	jra L17
L16:
	movel _cf,sp@-
	moveq #0,d0
	moveb d2,d0
	movel d0,sp@-
	jbsr __flsbuf
L17:
	addql #1,_recpos
	moveml a6@(-8),#0xc
	unlk a6
	rts
.data
	.even
_new.0:
	.long 1
.text
	.even
.globl _pr_put
_pr_put:
	link a6,#0
	movel d2,sp@-
	movel a6@(8),d1
	addql #1,_recpos
	moveq #10,d2
	cmpl d1,d2
	jne L19
	moveq #1,d2
	movel d2,_new.0
	movel _cf,a0
	subql #1,a0@
	jpl L34
	jra L32
L19:
	moveq #1,d2
	cmpl _new.0:l,d2
	jne L23
	clrl _new.0
	moveq #48,d2
	cmpl d1,d2
	jne L24
	movel _cf,a0
	subql #1,a0@
	jmi L25
	addqw #4,a0
	movel a0@,a1
	moveb #10,a1@
	addql #1,a0@
	jra L22
L25:
	movel _cf,sp@-
	pea 10:w
	jra L35
L24:
	moveq #49,d2
	cmpl d1,d2
	jne L22
	movel _cf,a0
	subql #1,a0@
	jmi L29
	addqw #4,a0
	movel a0@,a1
	moveb #12,a1@
	addql #1,a0@
	jra L22
L29:
	movel _cf,sp@-
	pea 12:w
	jra L35
L23:
	movel _cf,a0
	subql #1,a0@
	jmi L32
L34:
	addqw #4,a0
	movel a0@,a1
	moveb d1,a1@
	addql #1,a0@
	jra L22
L32:
	movel _cf,sp@-
	moveq #0,d0
	moveb d1,d0
	movel d0,sp@-
L35:
	jbsr __flsbuf
L22:
	movel a6@(-4),d2
	unlk a6
	rts
	.even
.globl _x_wSL
_x_wSL:
	link a6,#0
	pea 10:w
	movel _putn,a0
	jbsr a0@
	clrl _recpos
	clrl _cursor
	clrl _hiwater
	moveq #1,d0
	unlk a6
	rts
	.even
.globl _xw_end
_xw_end:
	link a6,#0
	tstl _nonl
	jne L38
	pea 10:w
	movel _putn,a0
	jbsr a0@
L38:
	clrl _cursor
	clrl _recpos
	clrl _hiwater
	moveq #0,d0
	unlk a6
	rts
	.even
.globl _xw_rev
_xw_rev:
	link a6,#0
	tstl _workdone
	jeq L40
	pea 10:w
	movel _putn,a0
	jbsr a0@
L40:
	clrl _cursor
	clrl _recpos
	clrl _hiwater
	clrl _workdone
	moveq #0,d0
	unlk a6
	rts