This is fasl_loader.c in view mode; [Download] [Up]
/*
(C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
*/
/*
fasl_loader.c
DG-SPECIFIC
*/
#include "../h/fasl.h"
#include "../h/fasl_global.h"
#include "include.h"
#define ERFDE 025
int debug;
#ifdef DGUX
$low32k short short_buffer[BUFSIZ]; /* short nrel area buffer */
#endif
int
fasl_loader(filename, skip_count, data)
char *filename;
int skip_count;
object data;
{
char *alloc_contblock(); /* LISP allocation */
int ier;
int block_type;
char *cfun_start;
int cfun_length;
int m_len;
object fasl_obj;
#ifdef DGUX
char buff[BUFSIZ];
char buff1[BUFSIZ];
#endif
#ifdef DGUX
faslbuff = buff;
faslbuff1 = buff1;
#endif
ier = fasl_open(filename);
#ifdef AOSVS
if (ier == ERFDE) return(-1);
if (ier != 0) sys_emes(ier);
#endif
#ifdef DGUX
if (ier != 0) return(-1);
#endif
fas_temp_flush = TRUE;
init_pass1();
#ifdef AOSVS
fasl_skip(skip_count);
#endif
for (;;) {
fasl_nblock();
block_type = (((FAS_HDR_P)fas_buffp) -> hdr_typ) & BLOCK_TYPE;
/* dispatch by block type */
switch(block_type) {
case DATA_BLOCK: data_pass1();
break;
case TITL_BLOCK: titl_pass1();
break;
case EXT_BLOCK: ext_pass1();
break;
case PAT_BLOCK: pat_pass1();
break;
case REV_BLOCK: rev_pass1();
break;
case ALN_BLOCK: aln_pass1();
break;
case END_BLOCK:
case ENT_BLOCK:
case LOCAL_BLOCK:
case DEBS_BLOCK:
case DEBL_BLOCK:
case LTITL_BLOCK:
case MREV_BLOCK: break;
default: fasl_invalid();
break;
}
if (block_type == END_BLOCK) break;
}
#ifdef AOSVS
fasl_skip(skip_count);
#endif
#ifdef DGUX
fasl_rpos();
#endif
check_short_area();
fasl_write_temp();
fas_temp_flush = FALSE;
cfun_length = m_len = fasl_len() * 2; /* to byte length */
fas_temp_flush = TRUE;
fasl_obj = alloc_object(t_cfun);
fasl_obj->cf.cf_name = fasl_obj->cf.cf_data = OBJNULL;
fasl_obj->cf.cf_start = NULL;
fasl_obj->cf.cf_size = m_len;
vs_push(fasl_obj);
cfun_start = alloc_contblock(m_len);
fas_rstart = (short *)cfun_start;
fasl_obj->cf.cf_start = cfun_start; /* set start addr */
fas_relocation_by_table = FALSE;
fasl_saddr(); /* set actual address */
fasl_write_temp(); /* be sure all records in file */
/* watson(); */
fas_temp_flush = FALSE;
for (;;) {
fasl_nblock();
block_type = (((FAS_HDR_P)fas_buffp) -> hdr_typ) & BLOCK_TYPE;
/* dispatch by block type */
switch(block_type) {
case DATA_BLOCK: data_pass2();
break;
case ENT_BLOCK: ent_pass2();
break;
case TITL_BLOCK:
case END_BLOCK:
case EXT_BLOCK:
case PAT_BLOCK:
case REV_BLOCK:
case MREV_BLOCK:
case ALN_BLOCK: break;
default: fasl_invalid();
break;
}
if (block_type == END_BLOCK) break;
}
fasl_close();
fasl_close_temp();
/*
printf("init addr %o\n", fas_routine_addr);
fflush(stdout);
{
int i;
for (i = 0; i < m_len / 2; i++)
printf("%o %10o\n", fas_rstart+i, ((unsigned int)fas_rstart[i]) & 0177777);
fflush(stdout);
}
*/
if (fas_routine_addr != 0)
(*fas_routine_addr)(cfun_start, cfun_length, data);
else
FEerror("Init routine not found.", 0);
printf("end init routine\n");
fflush(stdout);
vs_pop; /* pop dummy string */
return(m_len);
}
#ifdef AOSVS
init_fasl()
{
fas_stchan = -1;
init_fasl_io();
get_pid();
copypid(fas_temp_name + 1);
sshort(&fas_short_nrel, &fas_short_end);
}
#endif
#ifdef DGUX
init_dguxfasl()
{
init_faslst();
fas_short_nrel = short_buffer;
fas_short_end = short_buffer + BUFSIZ;
}
#endif
/*
memory saved program initialization.
*/
init_fasl1()
{
#ifdef AOSVS
fas_stchan = -1;
init_fasl_io();
get_pid();
copypid(fas_temp_name + 1);
#endif
}
fasl_invalid()
{
FEerror("Not a LISP object. Can't load.",0);
}
fasl_buf_overflow()
{
FEerror("Internal buffer overflow.", 0);
}
fasl_rev_error()
{
FEerror("Revision unmatch.", 0);
}
fasl_undefined(symp)
char *symp;
{
char emess[128];
strcpy(emess, "Undefined symbol : ");
strcat(emess, symp);
strcat(emess, ".");
FEerror(emess, 0);
}
fasl_align_error()
{
FEerror("Alignment larger than 1 is not allowed.", 0);
}
watson()
{
PART_TABLE_P p_table_p;
int addr;
short i = 0;
printf("\nReport from WATSON :\n");
for (i = 0; i <= max_part_no; i++) {
part_table_p = fasl_get_table(i);
addr = fasl_get_addr(i);
printf("\n");
printf(" number : %o\n", part_table_p -> part_no);
printf(" length : %o\n", part_table_p -> part_len);
printf(" addr : %o %o\n", part_table_p -> part_addr,
addr);
printf(" align : %o\n", part_table_p -> part_align);
printf(" global : %o\n", part_table_p -> part_global);
printf(" symbol : %o\n", part_table_p -> part_symbol);
printf(" name : %s\n", part_table_p -> part_name);
}
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.