This is unixfasl.c in view mode; [Download] [Up]
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
#include "include.h"
#ifdef UNIXFASL
#include UNIXFASL
#else
#ifdef HAVE_AOUT
#undef BSD
#undef ATT
#define BSD
#include <a.out.h>
#endif
#ifdef COFF_ENCAPSULATE
#undef BSD
#undef ATT
#define BSD
#include "a.out.encap.h"
#endif
#ifdef ATT
#include <filehdr.h>
#include <scnhdr.h>
#include <syms.h>
#endif
#ifdef E15
#include <a.out.h>
#define exec bhdr
#define a_text tsize
#define a_data dsize
#define a_bss bsize
#define a_syms ssize
#define a_trsize rtsize
#define a_drsize rdsize
#endif
#ifdef BSD
#define textsize header.a_text
#define datasize header.a_data
#define bsssize header.a_bss
#ifdef COFF_ENCAPSULATE
#define textstart sizeof(header) +sizeof(struct coffheader)
#else
#define textstart sizeof(header)
#endif
#define newbsssize newheader.a_bss
#endif
#ifndef HEADER_SEEK(x)
#define HEADER_SEEK
#endif
#define MAXPATHLEN 1024
#ifndef SFASL
int
fasload(faslfile)
object faslfile;
{
#ifdef BSD
struct exec header, newheader;
#endif
#ifdef ATT
struct filehdr fileheader;
struct scnhdr sectionheader;
int textsize, datasize, bsssize;
int textstart;
#endif
#ifdef E15
struct exec header;
#define textsize header.a_text
#define datasize header.a_data
#define bsssize header.a_bss
#define textstart sizeof(header)
#endif
object memory, data, tempfile;
FILE *fp;
char filename[MAXPATHLEN];
char tempfilename[32];
char command[MAXPATHLEN * 2];
int i;
object *old_vs_base = vs_base;
object *old_vs_top = vs_top;
#ifdef IBMRT
#endif
coerce_to_filename(faslfile, filename);
faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
vs_push(faslfile);
fp = faslfile->sm.sm_fp;
/* seek to beginning of the header */
HEADER_SEEK(fp);
#ifdef BSD
fread(&header, sizeof(header), 1, fp);
#endif
#ifdef ATT
fread(&fileheader, sizeof(fileheader), 1, fp);
#ifdef S3000
if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1);
#endif
fread(§ionheader, sizeof(sectionheader), 1, fp);
textsize = sectionheader.s_size;
textstart = sectionheader.s_scnptr;
fread(§ionheader, sizeof(sectionheader), 1, fp);
datasize = sectionheader.s_size;
fread(§ionheader, sizeof(sectionheader), 1, fp);
if (strcmp(sectionheader.s_name, ".bss") == 0)
bsssize = sectionheader.s_size;
else
bsssize = 0;
#endif
#ifdef E15
fread(&header, sizeof(header), 1, fp);
#endif
memory = alloc_object(t_cfdata);
memory->cfd.cfd_self = NULL;
memory->cfd.cfd_start = NULL;
memory->cfd.cfd_size = textsize + datasize + bsssize;
vs_push(memory);
memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,
memory->cfd.cfd_size,sizeof(double));
#ifdef SEEK_TO_END_OFILE
SEEK_TO_END_OFILE(fp);
#else
#ifdef BSD
fseek(fp,
header.a_text+header.a_data+
header.a_syms+header.a_trsize+header.a_drsize,
1);
fread(&i, sizeof(i), 1, fp);
fseek(fp, i - sizeof(i), 1);
#endif
#ifdef ATT
fseek(fp,
fileheader.f_symptr + SYMESZ*fileheader.f_nsyms,
0);
fread(&i, sizeof(i), 1, fp);
fseek(fp, i - sizeof(i), 1);
while ((i = getc(fp)) == 0)
;
ungetc(i, fp);
#endif
#ifdef E15
fseek(fp,
header.a_text+header.a_data+
header.a_syms+header.a_trsize+header.a_drsize,
1);
#endif
#endif
data = read_fasl_vector(faslfile);
vs_push(data);
close_stream(faslfile, TRUE);
sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
AGAIN:
#ifdef BSD
LD_COMMAND(command,
kcl_self,
memory->cfd.cfd_start,
filename,
" ",
tempfilename);
if(symbol_value(Vload_verbose)!=Cnil)
printf("start address -T %x ",memory->cfd.cfd_start);
#endif
#ifdef ATT
coerce_to_filename(symbol_value(siVsystem_directory),
system_directory);
sprintf(command,
"%sild %s %d %s %s",
system_directory,
kcl_self,
memory->cfd.cfd_start,
filename,
tempfilename);
#endif
#ifdef E15
coerce_to_filename(symbol_value(siVsystem_directory),
system_directory);
sprintf(command,
"%sild %s %d %s %s",
system_directory,
kcl_self,
memory->cfd.cfd_start,
filename,
tempfilename);
#endif
if (system(command) != 0)
FEerror("The linkage editor failed.", 0);
tempfile = make_simple_string(tempfilename);
vs_push(tempfile);
tempfile = open_stream(tempfile, smm_input, Cnil, Kerror);
vs_push(tempfile);
fp = tempfile->sm.sm_fp;
HEADER_SEEK(fp);
#ifdef BSD
fread(&newheader, sizeof(header), 1, fp);
if (newbsssize != bsssize) {
insert_contblock(memory->cfd.cfd_start, memory->cfd.cfd_size);
bsssize = newbsssize;
memory->cfd.cfd_start = NULL;
memory->cfd.cfd_size = textsize + datasize + bsssize;
memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,memory->cfd.cfd_size,
sizeof( double));
close_stream(tempfile, TRUE);
unlink(tempfilename);
goto AGAIN;
}
#endif
if (fseek(fp, textstart, 0) < 0)
error("file seek error");
fread(memory->cfd.cfd_start, textsize + datasize, 1, fp);
close_stream(tempfile, TRUE);
unlink(tempfilename);
call_init(0,memory,data);
vs_base = old_vs_base;
vs_top = old_vs_top;
return(memory->cfd.cfd_size);
}
#endif /* ifndef SFASL */
#ifdef BSD
#ifndef NeXT
#define FASLINK
#ifndef PRIVATE_FASLINK
int
faslink(faslfile, ldargstring)
object faslfile, ldargstring;
{
struct exec header, faslheader;
object memory, data, tempfile;
FILE *fp;
char filename[MAXPATHLEN];
char ldargstr[MAXPATHLEN];
char tempfilename[32];
char command[MAXPATHLEN * 2];
char buf[BUFSIZ];
int i;
object *old_vs_base = vs_base;
object *old_vs_top = vs_top;
coerce_to_filename(ldargstring, ldargstr);
coerce_to_filename(faslfile, filename);
sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
LD_COMMAND(command,
kcl_self,
(int)core_end,
filename,
ldargstr,
tempfilename);
if (system(command) != 0)
FEerror("The linkage editor failed.", 0);
fp = fopen(tempfilename, "r");
setbuf(fp, buf);
fread(&header, sizeof(header), 1, fp);
memory = alloc_object(t_cfdata);
memory->cfd.cfd_self=0;
memory->cfd.cfd_start = NULL;
memory->cfd.cfd_size = textsize + datasize + bsssize;
vs_push(memory);
memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,
memory->cfd.cfd_size,
sizeof(double));
fclose(fp);
faslfile = open_stream(faslfile, smm_input, Cnil, Kerror);
vs_push(faslfile);
#ifdef SEEK_TO_END_OFILE
SEEK_TO_END_OFILE(faslfile->sm.sm_fp);
#else
fp = faslfile->sm.sm_fp;
fread(&faslheader, sizeof(faslheader), 1, fp);
fseek(fp,
faslheader.a_text+faslheader.a_data+
faslheader.a_syms+faslheader.a_trsize+faslheader.a_drsize,
1);
fread(&i, sizeof(i), 1, fp);
fseek(fp, i - sizeof(i), 1);
#endif
data = read_fasl_vector(faslfile);
vs_push(data);
close_stream(faslfile, TRUE);
LD_COMMAND(command,
kcl_self,
memory->cfd.cfd_start,
filename,
ldargstr,
tempfilename);
if(symbol_value(Vload_verbose)!=Cnil)
printf("start address -T %x ",memory->cfd.cfd_start);
if (system(command) != 0)
FEerror("The linkage editor failed.", 0);
tempfile = make_simple_string(tempfilename);
vs_push(tempfile);
tempfile = open_stream(tempfile, smm_input, Cnil, Kerror);
vs_push(tempfile);
fp = tempfile->sm.sm_fp;
if (fseek(fp, textstart, 0) < 0)
error("file seek error");
fread(memory->cfd.cfd_start, textsize + datasize, 1, fp);
close_stream(tempfile, TRUE);
unlink(tempfilename);
call_init(0,memory,data);
vs_base = old_vs_base;
vs_top = old_vs_top;
return(memory->cfd.cfd_size);
}
#endif
siLfaslink()
{
bds_ptr old_bds_top;
int i;
object package;
check_arg(2);
check_type_or_pathname_string_symbol_stream(&vs_base[0]);
check_type_string(&vs_base[1]);
vs_base[0] = coerce_to_pathname(vs_base[0]);
vs_base[0]->pn.pn_type = FASL_string;
vs_base[0] = namestring(vs_base[0]);
package = symbol_value(Vpackage);
old_bds_top = bds_top;
bds_bind(Vpackage, package);
i = faslink(vs_base[0], vs_base[1]);
bds_unwind(old_bds_top);
vs_top = vs_base;
vs_push(make_fixnum(i));
}
#endif /* not NeXT */
#endif /* BSD */
#endif /* UNIXFASL */
init_unixfasl()
{
#ifdef FASLINK
make_si_function("FASLINK", siLfaslink);
#endif
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.