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

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

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

/*
	savemem.c
	DG-SPECIFIC
*/

#include <stdio.h>
#include <packets:create.h>
#include "include.h"

#define $CREATE 00
#define $GNAME 0111

#define $ORDY 01
#define $FSTF 0103
#define ERFDE 025
#define ERDDE 023
#define EREOF 030

#define SV_BUFF_SIZE 2048

#define PRSTART 020000

#define UST   0400
#define USTBL 013
#define USTST 016
#define USTSZ 022
#define USTSH 031
#define RING_MASK 001777777777
#define ST_REC_SIZE 0400

FILE	*fopen();

FILE	*mypr;
FILE	*savedpr;

extern short fas_stchan;		/* .st channel for fasl io */

char	sv_buffer[SV_BUFF_SIZE];
char	sv_in_buff[BUFSIZ];
char	sv_o_buff[BUFSIZ];

savememory(filen)
char	*filen;
{
	int	i;
	char	prname[256];

	get_path(filen, prname);

	for (i = 0; prname[i] != '\0'; i++)
		;
	i -= 3;
	if (i < 1 || strcmp(prname + i, ".PR") != 0)
		i += 3;		/* go back to last */
	prname[i++] = '.';
	prname[i++] = 'P';
	prname[i++] = 'R';
	prname[i] = '\0';

	mdump(prname);
	ustcopy(prname);

	i -= 2;
	prname[i++] = 'S';
	prname[i++] = 'T';
	prname[i] = '\0';
	stcopy(prname);
}

/* dump my process to filen */

mdump(filen)
char	*filen;
{
	int	ac0, ac1, ac2, ier;

	unlink(filen);	/* first delete it */
	ac0 = &ac0;	/* set ring 7 */
	ac2 = filen;
	if (ier = sys($MDUMP, &ac0, &ac1, &ac2))
		sys_emes(ier);
}

/*
	ustcopy replaces ust of memory dumped file by the original
	ust of .pr file, and also clears out the C library global
	variable , i.e. _fdl and _chnl_blk area to prevent the C
	envirionment initializing error.
*/
ustcopy(filen)
char	*filen;
{
	int	i, ier;
	short	*ust;
	int	impure_block;
	int	shared_start;
	int	shared_size;
	int	shared_block_no;
	int	_fdl_addr, _chnl_blk_addr;
	int	stack_base;
	int	stack_limit;
	char	myname[256];

	get_prname(myname);
	mypr = fopen(myname, "r");
	if (mypr == NULL) sys_emes(lasterror());
	setbuf(mypr, sv_in_buff);

	savedpr = fopen(filen, "r+");
	if (savedpr == NULL) sys_emes(lasterror());
	setbuf(savedpr, sv_o_buff);
	
	if (fread(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
		sys_emes(lasterror());

	/*
	remember unshared and shared size... of memory dumped file.
	*/
	ust = (short *)sv_buffer + UST;
	impure_block = *(int *)(ust + USTBL);
	shared_start = *(int *)(ust + USTST);
	shared_size = *(int *)(ust + USTSZ);
	shared_block_no = *(int *)(ust + USTSH);

	stack_base = *((int *)sv_buffer + 0270);
	stack_limit = *((int *)sv_buffer + 0267);

	if (fseek(savedpr, 0, 0)) sys_emes(lasterror());

	if (fread(sv_buffer, SV_BUFF_SIZE, 1, mypr) != 1)
		sys_emes(lasterror());

	*(int *)(ust + USTBL) = impure_block;
	*(int *)(ust + USTST) = shared_start;
	*(int *)(ust + USTSZ) = shared_size;
	*(int *)(ust + USTSH) = shared_block_no;

	if (fwrite(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
		sys_emes(lasterror());

	for (i = 1; i < 8; i++) {
		if (fread(sv_buffer, SV_BUFF_SIZE, 1, mypr) != 1)
			sys_emes(lasterror());
		if (fwrite(sv_buffer, SV_BUFF_SIZE, 1, savedpr) != 1)
			sys_emes(lasterror());
	}

/*	if (fseek(mypr, PRSTART * 2, 0))
		sys_emes(lasterror());		*/
	if (fseek(savedpr, PRSTART * 2, 0))
		sys_emes(lasterror());

	if (fread(sv_buffer, 050 * 2, 1, savedpr) != 1)
		sys_emes(lasterror());
	/*
	 * set up stack registers
	*/
	*((int *)sv_buffer + 013) = stack_base;	/* stack base */
	*((int *)sv_buffer + 011) = stack_base;	/* stack pointer */
	*((int *)sv_buffer + 012) = stack_limit; /* stack limit */
	*((int *)sv_buffer + 010) = 0;		/* frame pointer */

	if (fseek(savedpr, PRSTART * 2, 0))
		sys_emes(lasterror());
	if (fwrite(sv_buffer, 050 * 2, 1, savedpr) != 1)
		sys_emes(lasterror());

/*
	if (fseek(mypr, (PRSTART + 0400) * 2, 0))
		sys_emes(lasterror());
	if (fseek(savedpr, (PRSTART + 0400) * 2, 0))
		sys_emes(lasterror());
	if (fread(sv_buffer, 050 * 2, 1, mypr) != 1)
		sys_emes(lasterror());
	if (fwrite(sv_buffer, 050 * 2, 1, savedpr) != 1)
		sys_emes(lasterror());
*/

	fclose(mypr);

	if (fas_stchan == -1) fasl_openst();
	if (ier = fasl_st("_chnl_blk", &_chnl_blk_addr))
		sys_emes(ier);
	if (ier = fasl_st("_fdl", &_fdl_addr))
		sys_emes(ier);

	_chnl_blk_addr = (_chnl_blk_addr & RING_MASK) + PRSTART;
	_fdl_addr = (_fdl_addr & RING_MASK) + PRSTART;

	if (fseek(savedpr, _chnl_blk_addr * 2, 0))
		sys_emes(lasterror());

	zero(sv_buffer, SV_BUFF_SIZE);
	if (fwrite(sv_buffer, SV_BUFF_SIZE, 2, savedpr) != 2)
		sys_emes(lasterror());
	if (fwrite(sv_buffer, 0400, 1, savedpr) != 1)
		sys_emes(lasterror());
	if (fseek(savedpr, _fdl_addr * 2, 0)) sys_emes(lasterror());
	if (fwrite(sv_buffer, 0200, 1, savedpr) != 1)
		sys_emes(lasterror());
	fclose(savedpr);
}

/*
	stcopy copies .st file.
*/
stcopy(filen)
char	*filen;
{
	int	ac0, ac1, ac2, ier;
	char	mystname[256];
	FILE	*myst;
	FILE	*newst;
	P_CREATE crpack;

	get_stname(mystname);

	unlink(filen);		/* if exist, delete it */

	crpack.cftyp_format = $ORDY;
	crpack.cftyp_entry = $FSTF;
	crpack.ccps = 0;
	crpack.ctim = -1;
	crpack.cacp = -1;
	crpack.cdeh = 0;
	crpack.cdel = 4;
	crpack.cmil = 3;
	crpack.cmrs = 0;

	ac0 = filen;
	ac2 = &crpack;
	if (ier = sys($CREATE, &ac0, &ac1, &ac2))
		sys_emes(ier);

	if ((myst = fopen(mystname, "r")) == NULL)
		sys_emes(lasterror());
	setbuf(myst, sv_in_buff);
	if ((newst = fopen(filen, "w")) == NULL)
		sys_emes(lasterror());
	setbuf(newst, sv_o_buff);
	
	for (;;) {
		if (fread(sv_buffer, ST_REC_SIZE, 1, myst) != 1)
			if ((ier = lasterror()) == EREOF)
				break;
			else
				sys_emes(ier);
		if (fwrite(sv_buffer, ST_REC_SIZE, 1, newst) != 1)
			sys_emes(lasterror());
	}
	fclose(myst);
	fclose(newst);
}

/*
	get_path convert a filename to the full path name.
*/
get_path(filen, fpath)
char	*filen;
char	*fpath;
{
	char	dir[256];
	int	i, j, ac0, ac1, ac2, ier;

	for (i = 0; filen[i] != '\0'; i++)
		;
	for (;  i >=0 &&
		filen[i] != ':' &&
		filen[i] != '=' &&
		filen[i] != '@' &&
		filen[i] != '^'		; i--)
		;
	if (i < 0) {
		dir[0] = '=';
		dir[1] = '\0';
	} else {
		for (j = 0; j <= i; j++)
			dir[j] = filen[j];
		dir[j] = '\0';
		if (dir[j-1] == ':' && j != 1 )
			dir[j-1] = '\0';

	}
	ac0 = dir;
	ac1 = fpath;
	ac2 = 256;

	if (ier = sys($GNAME, &ac0, &ac1, &ac2))
		if (ier == ERFDE)	   /* file does not exist */
			sys_emes(ERDDE);   /* dir does not exist */
		else
			sys_emes(ier);
	if (ac2 != 1)
		fpath[ac2++] = ':';
	for (j = ac2, i++; (fpath[j] = toupper(filen[i])) != '\0'
		; j++, i++)
		;
}

Lsave()
{
	object	x;
	int	len, i, ier;
	char	*cp;
	char	filen[256];

	short *sp;

	check_arg(1);
	check_type_or_pathname_string_symbol_stream(&vs_base[0]);
	x = coerce_to_namestring(vs_base[0]);
	vs_push(x);

	cp = x->st.st_self;
	len = x->st.st_dim;

	for (i=0; i < len; i++) filen[i] = cp[i];
	filen[i] = '\0';

	savememory(filen);
	vs_top = vs_base;
	vs_push(Ct);
}

init_save()
{
	make_function("SAVE", Lsave);
}

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