github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-01-17 00:22:59 +00:00
Code Issues Projects Releases Wiki Activity
Interlisp.maiko/src/storage.c
Nick Briggs cfd0711a73 Create car-cdr.h to declare functions defined in car-cdr.c 
Update files that depend on car-cdr functions to include car-cdr.h.
    Add dependencies to makefile.

	modified:   makefile-darwin.386-x
	modified:   makefile-init.386
	modified:   makefile-tail
	new file:   ../inc/car-cdr.h
	modified:   ../src/bbtsub.c
	modified:   ../src/car-cdr.c
	modified:   ../src/dsk.c
	modified:   ../src/gcarray.c
	modified:   ../src/gcrcell.c
	modified:   ../src/kprint.c
	modified:   ../src/loopsops.c
	modified:   ../src/lsthandl.c
	modified:   ../src/mvs.c
	modified:   ../src/storage.c
	modified:   ../src/sxhash.c
	modified:   ../src/vars3.c
	modified:   ../src/xc.c
	modified:   ../src/z2.c
2017-06-29 22:24:33 -07:00

398 lines
12 KiB
C
Raw Blame History

/* $Id: storage.c,v 1.5 2001/12/26 22:17:04 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved
*/
static const char *id =
"$Id: storage.c,v 1.5 2001/12/26 22:17:04 sybalsky Exp $ Copyright (C) Venue";
/************************************************************************/
/* */
/* (C) Copyright 1989-94 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/* The contents of this file are proprietary information */
/* belonging to Venue, and are provided to you under license. */
/* They may not be further distributed or disclosed to third */
/* parties without the specific permission of Venue. */
/* */
/************************************************************************/
#include "version.h"
/*****************************************************************/
/*
File Name : storage.c
*/
/*****************************************************************/
#include <stdio.h> /* for printf */
#include "hdw_conf.h"
#include "lispemul.h"
#include "address.h"
#include "adr68k.h"
#include "lispmap.h"
#include "stack.h"
#include "lspglob.h"
#include "cell.h"
#include "car-cdr.h"
#include "lsptypes.h"
#include "ifpage.h"
#include "gc.h"
#define MINARRAYBLOCKSIZE 4
#define GUARDVMEMFULL 500
#define IFPVALID_KEY 5603
void advance_array_seg(register unsigned int nxtpage);
void set_storage_state(void);
/*****************************************************************/
/*
Func Name : checkfor_storagefull(npages)
Created : Oct. 7, 1987 Takeshi Shimizu
Changed : Oct. 12,1987 take
Used to be LispPTR T/NIL return, but result never used
*/
/*****************************************************************/
void checkfor_storagefull(register unsigned int npages) {
register int pagesleft;
register INTSTAT *int_state;
void advance_storagestate(DLword flg);
#ifdef BIGVM
pagesleft = (*Next_MDSpage_word) - (*Next_Array_word) - PAGESPER_MDSUNIT;
#else
pagesleft = (*Next_MDSpage_word & 0xffff) - (*Next_Array_word & 0xffff) - PAGESPER_MDSUNIT;
#endif
if ((pagesleft < GUARDSTORAGEFULL) || (npages != 0)) {
if (*STORAGEFULLSTATE_word == NIL) set_storage_state();
switch (*STORAGEFULLSTATE_word & 0xffff) {
case SFS_NOTSWITCHABLE:
case SFS_FULLYSWITCHED:
if (pagesleft < 0) {
while (T) { error("MP9320:Storage completly full"); }
} else if ((pagesleft <= GUARD1STORAGEFULL) && (*STORAGEFULL_word != NIL)) {
*STORAGEFULL_word = S_POSITIVE;
error(
"MP9325:Space getting VERY full.\
Please save and reload a.s.a.p.");
} else if (*STORAGEFULL_word == NIL) {
*STORAGEFULL_word = ATOM_T;
int_state = (INTSTAT *)Addr68k_from_LADDR(*INTERRUPTSTATE_word);
int_state->storagefull = T;
*PENDINGINTERRUPT_word = ATOM_T;
}
#ifdef DEBUG
printf("\n checkfor_storagefull:DORECLAIM.....\n");
#endif
return; /*(NIL); */
break;
case SFS_SWITCHABLE:
if (npages == NIL) {
if (pagesleft <= 0) {
*LeastMDSPage_word = *Next_Array_word;
*Next_MDSpage_word = *SecondMDSPage_word;
advance_storagestate(SFS_FULLYSWITCHED);
advance_array_seg(*SecondArrayPage_word);
return;
}
} else if (npages > pagesleft) {
/* Have to switch array space over,
but leave MDS to fill the rest of the low pages */
*LeastMDSPage_word = *Next_Array_word;
advance_storagestate(SFS_ARRAYSWITCHED);
advance_array_seg(*SecondArrayPage_word);
return;
}
break;
#ifdef BIGVM
case SFS_ARRAYSWITCHED:
if ((*Next_MDSpage_word) < (*LeastMDSPage_word))
#else
case SFS_ARRAYSWITCHED:
if ((*Next_MDSpage_word & 0xffff) < (*LeastMDSPage_word & 0xffff))
#endif
{
*Next_MDSpage_word = *SecondMDSPage_word;
advance_storagestate(SFS_FULLYSWITCHED);
return;
} else if (npages != NIL)
if ((npages + GUARDSTORAGEFULL) >=
#ifdef BIGVM
((*SecondMDSPage_word) - (*Next_Array_word)))
#else
((*SecondMDSPage_word & 0xffff) - (*Next_Array_word & 0xffff)))
#endif
return; /* (NIL); */
return; /* (T); */
/* break; */
default:
error("checkfor_storagefull: Shouldn't"); /* (*STORAGEFULLSTATE_word) & 0xffff) */
break;
}
} else
return; /*(NIL); */
} /* checkfor_storagefull end */
/*****************************************************************/
/*
Func Name : advance_array_seg(nxtpage)
Created : Oct. 7, 1987 Takeshi Shimizu
Changed :
*/
/*****************************************************************/
void advance_array_seg(register unsigned int nxtpage)
/* rare page num */
{
unsigned int ncellsleft;
LispPTR mergebackward(LispPTR base);
LispPTR makefreearrayblock(LispPTR block, DLword length);
/* Called when 8Mb are exhausted,and we want to switch array space
into the extended area(Secondary space),starting with nextpage.
We MUST clean up old area first. */
#ifdef BIGVM
nxtpage &= 0xFFFFF; /* new VM, limit is 20 bits of page */
#else
nxtpage &= 0xFFFF; /* for old VM size, limit is 16 bits of page */
#endif
ncellsleft = (*Next_Array_word - POINTER_PAGE(*ArrayFrLst_word) - 1) * CELLSPER_PAGE +
(CELLSPER_PAGE - (((*ArrayFrLst_word) & 0xff) >> 1));
if (ncellsleft >= MINARRAYBLOCKSIZE) {
mergebackward(makefreearrayblock(*ArrayFrLst_word, ncellsleft));
#ifdef BIGVM
*ArrayFrLst2_word = (((*LeastMDSPage_word)) << 8);
#else
*ArrayFrLst2_word = (((*LeastMDSPage_word) & 0xffff) << 8);
#endif
} else {
*ArrayFrLst2_word = *ArrayFrLst_word;
}
#ifdef BIGVM
*Next_Array_word = nxtpage;
#else
*Next_Array_word = S_POSITIVE | nxtpage;
#endif
*ArrayFrLst_word = nxtpage << 8;
*ArraySpace2_word = *ArrayFrLst_word;
/* return(S_POSITIVE); making function void as result never used */
} /* advance_array_seg end */
/*****************************************************************/
/*
Func Name : advance_storagestate(flg)
Created : Oct. 7, 1987 Takeshi Shimizu
Changed :
*/
/*****************************************************************/
/* DLword */
void advance_storagestate(DLword flg) {
LispPTR dremove(LispPTR x, LispPTR l);
#ifdef DEBUG
printf("STORAGEFULLSTATE is now set to %d \n", flg);
#endif
*STORAGEFULLSTATE_word = (S_POSITIVE | flg);
InterfacePage->fullspaceused = 65535;
*SYSTEMCACHEVARS_word = dremove(STORAGEFULLSTATE_index, *SYSTEMCACHEVARS_word);
}
/*****************************************************************/
/*
Func Name : set_storage_state()
Created : Oct. 7, 1987 Takeshi Shimizu
Changed :
*/
/*****************************************************************/
void set_storage_state(void) {
LispPTR cons(LispPTR cons_car, LispPTR cons_cdr);
if ((*MACHINETYPE_word & 0xffff) == KATANA) {
if (InterfacePage->dl24bitaddressable != 0)
*STORAGEFULLSTATE_word = S_POSITIVE | SFS_SWITCHABLE;
else
*STORAGEFULLSTATE_word = S_POSITIVE | SFS_NOTSWITCHABLE;
*SYSTEMCACHEVARS_word = cons(STORAGEFULLSTATE_index, *SYSTEMCACHEVARS_word);
GCLOOKUP(*SYSTEMCACHEVARS_word, ADDREF);
#ifdef DEBUG
printf("SETSTATE: set to %d \n", (*STORAGEFULLSTATE_word) & 0xffff);
#endif
} else {
error("set_storage_state: Sorry! We can work on only KATANA");
}
} /* set_storage_state() end */
LispPTR dremove(LispPTR x, LispPTR l) {
LispPTR z;
if (Listp(l) == NIL)
return (NIL);
else if (x == car(l)) {
if (cdr(l) != NIL) {
rplaca(l, car(cdr(l)));
rplacd(l, cdr(cdr(l)));
return (dremove(x, l));
}
} else {
z = l;
lp:
if (Listp(cdr(l)) == NIL)
return (z);
else if (x == car(cdr(l)))
rplacd(l, cdr(cdr(l)));
else
l = cdr(l);
goto lp;
}
}
/*****************************************************************/
/*
Func Name : newpage(addr)
Created : Oct. 12, 1987 Takeshi Shimizu
Changed : Oct. 13, 1987 take
OCt. 20, 1987 take
*/
/*****************************************************************/
LispPTR newpage(LispPTR base) {
#ifdef BIGVM
register unsigned int vp; /* Virtual Page we're creating */
#else
register DLword vp; /* (built from base) */
#endif /* BIGVM */
register INTSTAT *int_state;
extern LispPTR *LASTVMEMFILEPAGE_word;
extern LispPTR *VMEM_FULL_STATE_word;
unsigned int nactive;
vp = base >> 8; /* Compute virtual-page # from Lisp address of the page */
#ifdef DEBUG
/************************/
if (vp == 0) error("newpage: vp=0");
printf("***newpage modify vmemsize %d ", InterfacePage->nactivepages);
/*************************/
#endif
nactive = ++(InterfacePage->nactivepages);
/* if nactive is a multiple of the # of FPTOVP entries */
/* on a page, we need to create a new FPTOVP page. */
#ifdef BIGVM
if ((nactive & 127) == 0) /* in BIGVM, they're cells */
#else
if ((nactive & 0xff) == 0) /* in old way, they're words */
#endif /* BIGVM */
{ /* need to add virtual page for fptovp first */
unsigned int vp_of_fp, fp_of_fptovp;
/* compute virtual page of new FPtoVP table page */
/* i.e., the vp that holds the next FPtoVP entry */
vp_of_fp = (LADDR_from_68k(FPtoVP + nactive) >> 8);
/* compute file page where this entry has to be to ensure
that FPtoVP is contiguous on the file */
fp_of_fptovp = InterfacePage->fptovpstart + (vp_of_fp - (LADDR_from_68k(FPtoVP) >> 8));
/* debugging check: make sure FPtoVP is contiguous */
if (GETFPTOVP(FPtoVP, fp_of_fptovp - 1) != vp_of_fp - 1) {
printf("FPtoVP not contiguous\n");
printf("vp_of_fp = 0x%x, fp = 0x%x\n", vp_of_fp, fp_of_fptovp);
printf("FPTOVP(fp-1) = 0x%x.\n", GETFPTOVP(FPtoVP, fp_of_fptovp - 1));
}
/* move the file page for the previous VMEM page */
GETFPTOVP(FPtoVP, nactive) = GETFPTOVP(FPtoVP, fp_of_fptovp);
/* now, store virtual page of FPtoVP in FPtoVP table */
GETFPTOVP(FPtoVP, fp_of_fptovp) = (vp_of_fp);
/* now we can make room for the new page we're adding */
nactive = ++(InterfacePage->nactivepages);
}
GETFPTOVP(FPtoVP, nactive) = vp;
#ifdef DEBUG
/*************************/
printf("to %d with VP:%d \n", InterfacePage->nactivepages, vp);
/************************/
#endif
if (InterfacePage->nactivepages >
#ifdef BIGVM
(((*LASTVMEMFILEPAGE_word)) - GUARDVMEMFULL))
#else
(((*LASTVMEMFILEPAGE_word) & 0xffff) - GUARDVMEMFULL))
#endif
{
/* set vmemfull state */
if (*VMEM_FULL_STATE_word == NIL) {
int_state = (INTSTAT *)Addr68k_from_LADDR(*INTERRUPTSTATE_word);
int_state->vmemfull = T;
*PENDINGINTERRUPT_word = ATOM_T;
}
#ifdef BIGVM
if (InterfacePage->nactivepages < ((*LASTVMEMFILEPAGE_word)))
#else
if (InterfacePage->nactivepages < ((*LASTVMEMFILEPAGE_word) & 0xffff))
#endif
{
*VMEM_FULL_STATE_word = S_POSITIVE; /* set 0 */
} else if (InterfacePage->key == IFPVALID_KEY) {
*VMEM_FULL_STATE_word = ATOM_T;
} else
*VMEM_FULL_STATE_word = make_atom("DIRTY", 0, 5, 0);
}
return (base);
} /* newpage */
/*****************************************************************/
/*
Func Name : init_storage()
Description:
Set values which are referenced by
Lisp Storage handling funcs
Created : Apr-23 1990 Takeshi Shimizu
Changed :
*/
/*****************************************************************/
void init_storage(void) {
#ifdef BIGVM
*SecondMDSPage_word = (InterfacePage->dllastvmempage - PAGESPER_MDSUNIT - 1);
#else
*SecondMDSPage_word = S_POSITIVE | (InterfacePage->dllastvmempage - PAGESPER_MDSUNIT - 1);
#endif
} /* init_storage */
Reference in New Issue View Git Blame Copy Permalink