ftp.nice.ch/pub/next/developer/languages/lisp/AKCL.1.599.s.tar.gz#/akcl-1-599/c/fasl_io.c

This is fasl_io.c in view mode; [Download] [Up]

/*
(C) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
*/

/*
	fasl_io.c
	DG-SPECIFIC

	FASL loader io routines
*/

#include "^h:fasl.h"
#include "^h:fasl_global.h"
#include <sysid.h>
#include <packets:normal_io.h>
#include <paru.h>

P_NIO_EX	fas_io;		/* io packet for fasl file */
P_NIO_EX	fas_temp;	/* io packet for temp file */

/* open fasl file */
fasl_open(namep)
char	*namep;		/* file name byte pointer */
{
	int	ac0, ac1, ac2, ier;

	if (fas_io.ich != 0 ) {
	/*	ier = fasl_close();
		if (ier != 0) return(ier);	*/
		fasl_close();
		}
	fas_io.isti = $ICRF | $OFIN | $RTDY;
	fas_io.imrs = -1;
	fas_io.ibad = -1;
	fas_io.ircl = -1;
	fas_io.ifnp = namep;		/* file name pointer */
	fas_io.idel = -1;

	ac2 = &fas_io;
	return(sys($OPEN, &ac0, &ac1, &ac2));

}

/* close FASL file */
fasl_close()
{
	int	ac0, ac1, ac2, ier;

	ac2 = &fas_io;
	ier = sys($CLOSE, &ac0, &ac1, &ac2);
/*	if (ier != 0) return(ier);	ignore error */
	fasl_clear_pack(&fas_io);
	return(0);
}

/* clear io packet */
fasl_clear_pack(iopack)
P_NIO_EX *iopack;
{
	(*iopack).ich = 0;
	(*iopack).isti = 0;
	(*iopack).isto = 0;
	(*iopack).imrs = 0;
	(*iopack).ibad = 0;
	(*iopack).ires = 0;
	(*iopack).ircl = 0;
	(*iopack).irlr = 0;
	(*iopack).irnw = 0;
	(*iopack).irnh = 0;
	(*iopack).ifnp = 0;
	(*iopack).idel = 0;
	(*iopack).etsp = 0;
	(*iopack).etft = 0;
	(*iopack).etlt = 0;
	(*iopack).enet = 0;
}

/* get next fasl block */
fasl_nblock()
{
	int	ac0, ac1, ac2, ier;
	short	block_len;	/* block length */

	fas_io.isti = $RTDY;
	fas_io.ibad = fas_buffp;
	fas_io.ircl = FAS_HEADER_BLEN;
	fas_io.irnh = 0;

	ac2 = &fas_io;
	ier = sys($READ, &ac0, &ac1, &ac2);	/* get header only */
/*	if (ier != 0) return(ier);	*/
	if (ier != 0) sys_emes(ier);		/* not return */

	block_len = ((FAS_HDR_P)fas_buffp)->hdr_len;  /* set block len */

	/* if no block body , then return to caller */
	if (block_len <= FAS_HEADER_LEN) return(0);

	/* we must read block body */

	fas_io.ibad = fas_buffp + FAS_HEADER_BLEN;
	fas_io.ircl = block_len * 2 - FAS_HEADER_BLEN;

	if (fas_io.ircl > FAS_BUFF_LEN - FAS_HEADER_BLEN)
		fasl_invalid();

	ac2 = &fas_io;
/*	return(sys($READ, &ac0, &ac1, &ac2));	*/
	ier = sys($READ, &ac0, &ac1, &ac2);
	if (ier != 0) sys_emes(ier);
}

/* reset file position */
fasl_rpos()
{
	int	ac0, ac1, ac2, ier;

	fas_io.isti = $IPST | $RTDY;
	fas_io.irnh = 0;
	fas_io.ircl = 0;

	ac2 = &fas_io;
/*	return(sys($SPOS, &ac0, &ac1, &ac2));	*/
	ier = sys($SPOS, &ac0, &ac1, &ac2);
	if (ier != 0) sys_emes(ier);
}

fasl_open_temp()
{
	int	ac0, ac1, ac2, ier;

	get_pid();
	copypid(fas_temp_name+1);

	if (fas_temp.ich != 0) {
	/*	ier = fasl_close_temp();
		if (ier != 0) return(ier);	*/
		fasl_close_temp();
		}
	fas_temp.isti = $OFCR | $OFCE | $ICRF | $OFIO | $RTFX;
	fas_temp.imrs = -1;
	fas_temp.ibad = fas_temp_buff;
	fas_temp.ircl = FAS_BUFF_LEN;
	fas_temp.ifnp = fas_temp_name;
	fas_temp.idel = -1;

	ac2 = &fas_temp;
	ier = sys($OPEN, &ac0, &ac1, &ac2);
	if (ier != 0) sys_emes(ier);
}

fasl_close_temp()
{
	int	ac0, ac1, ac2, ier;

	ac2 = &fas_temp;
	ier = sys($CLOSE, &ac0, &ac1, &ac2);
	fasl_clear_pack(&fas_temp);
	if (ier != 0) sys_emes(ier);

	ac0 = fas_temp_name;
	sys($DELETE, &ac0, &ac1, &ac2);
}

fasl_read_temp(recno)
int	recno;
{
	int	ac0, ac1, ac2, ier;

	fas_temp.isti = $IPST | $RTFX;
	fas_temp.irnh = fas_temp_curr = recno;

	ac2 = &fas_temp;
	ier = sys($READ, &ac0, &ac1, &ac2);
	if (ier != 0) sys_emes(ier);
}

fasl_write_temp()
{
	int	ac0, ac1, ac2, ier;

	fas_temp.isti = $IPST | $RTFX;
	fas_temp.irnh = fas_temp_curr;	/* cuurent record in memory */

	ac2 = &fas_temp;
	ier = sys($WRITE, &ac0, &ac1, &ac2);
	if (ier != 0) sys_emes(ier);
}

fasl_read_addr_rec(recno)
int recno;
{
	int	ac0, ac1, ac2, ier;

	fas_temp.isti = $IPST | $RTFX;
	fas_temp.irnh = fas_addr_rec_first + recno;
	fas_temp.ibad = fas_addr_buff;

	ac2 = &fas_temp;
	ier = sys($READ, &ac0, &ac1, &ac2);

	fas_temp.ibad = fas_temp_buff;

	if (ier != 0)
		sys_emes(ier);

	fas_addr_rec_curr = recno;
}

fasl_write_addr_rec(recno)
int recno;
{
	int	ac0, ac1, ac2, ier;

	fas_temp.isti = $IPST | $RTFX;
	fas_temp.irnh = fas_addr_rec_first + recno;
	fas_temp.ibad = fas_addr_buff;

	ac2 = &fas_temp;
	ier = sys($WRITE, &ac0, &ac1, &ac2);

	fas_temp.ibad = fas_temp_buff;

	if (ier != 0)
		sys_emes(ier);
}

/* Old one.  New one below.
fasl_openst()
{
	int	ac0,ac1,ac2,ier;
	P_NIO_EX	fas_stio;
	char	st_name[256];

	get_stname(st_name);

	fasl_clear_pack(&fas_stio);

	fas_stio.ich = 0;
	fas_stio.isti = $OFIN | $RTDY;
	fas_stio.imrs = -1;
	fas_stio.ibad = -1;
	fas_stio.ircl = -1;
	fas_stio.ifnp = st_name;
	fas_stio.idel = -1;
	fas_stio.etsp = 0;
	fas_stio.etft = 0;
	fas_stio.etlt = 0;

	ac2 = &fas_stio;
	ier = sys($OPEN,&ac0,&ac1,&ac2);
	if (ier != 0) sys_emes(ier);
	fas_stchan = fas_stio.ich;
}
*/

/* New fasl_openst for AOS/VS REV 5.03 */
fasl_openst()
{
	int	ac0, ac1, ac2, ier;
	char	st_name[256];

	get_stname(st_name);

	ac0 = st_name;
	ac1 = -1;
	ac2 = 0;
	if(ier = sys($SOPEN, &ac0, &ac1, &ac2))
		sys_emes(ier);

	fas_stchan = ac1;
}


/* get symbol value */
fasl_st(symp, symv)
char	*symp;		/* symbol byte pointer */
int	*symv;		/* symbol value returned */
{
	int	ac0,ac1,ac2,ier;
	int	symlen;

	for (symlen = 0; symp[symlen] != '\0'; symlen++)
		;
	ac1 = (symlen << 8) | fas_stchan;
	ac2 = symp;
	ier = sys($GTSVL,&ac0,&ac1,&ac2);
	if (ier == 0) {
		*symv = ac0;
		return(0);
		} else
		return(ier);
}

get_stname(st_name)
char	*st_name;
{
	int	i, j;
	char	*cp;

	get_prname(st_name);

	for (i = 0; st_name[i] != '\0'; i++)
		;
	if ((i - 3) > 0) {
		cp = st_name + i - 3;
		if (strcmp(cp, ".PR") == 0) i = i - 3;
	}
	st_name[i++] = '.';
	st_name[i++] = 'S';
	st_name[i++] = 'T';
	st_name[i] = '\0';
}

get_prname(pr_name)
char	*pr_name;
{
	int	ac0, ac1, ac2, ier;

	ac0 = -1;
	ac2 = pr_name;
	ier = sys($GPRNM, &ac0, &ac1, &ac2);
	if (ier != 0) sys_emes(ier);
}

init_fasl_io()
{
	fasl_clear_pack(&fas_io);
	fasl_clear_pack(&fas_temp);
}

/* skip first text */
fasl_skip(count)
int	count;
{
	int	ac0, ac1, ac2, ier;
	int	rec_count;

	fas_io.isti = $IPST;
	fas_io.irnh = count;
	ac2 = &fas_io;
	if (ier = sys($SPOS, &ac0, &ac1, &ac2))
		sys_emes(ier);
/*
	while (count > 0) {
		fas_io.isti = $RTDY;
		fas_io.ibad = fas_buffp;
		if (count > FAS_BUFF_LEN) {
			fas_io.ircl = FAS_BUFF_LEN;
			count -= FAS_BUFF_LEN;
		} else {
			fas_io.ircl = count;
			count = 0;
		}

		ac2 = &fas_io;
		ier = sys($READ, &ac0, &ac1, &ac2);
		if (ier) sys_emes(ier);
	}
*/
}

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.