github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-01-20 17:47:48 +00:00
Code Issues Projects Releases Wiki Activity
Interlisp.maiko/src/conspage.c
Nick Briggs 0371f19167 Create conspage.h to declare functions defined in conspage.c 
Update files that depend on conspage functions to include conspage.h
Declare as static all functions in conspage.c that are not needed externally.
Add dependencies to makefile.

	modified:   bin/makefile-darwin.386-x
	modified:   bin/makefile-tail
	new file:   inc/conspage.h
	modified:   src/conspage.c
	modified:   src/mvs.c
	modified:   src/rplcons.c
	modified:   src/xc.c
	modified:   src/z2.c
2017-06-29 22:33:35 -07:00

446 lines
15 KiB
C
Raw Blame History

/* $Id: conspage.c,v 1.3 1999/05/31 23:35:27 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved
*/
static char *id = "$Id: conspage.c,v 1.3 1999/05/31 23:35:27 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 :conspage.c
*/
/************************************************************************/
#include "lispemul.h"
#include "address.h"
#include "adr68k.h"
#include "lsptypes.h"
#include "cell.h"
#include "lispmap.h"
#include "lspglob.h"
#include "gc.h"
#include "conspage.h"
/************************************************************************/
/* */
/* i n i t _ c o n s p a g e */
/* */
/* Initialize a fresh page of CONS cells. Sets the count field */
/* and chains the cells together for ease of searching. */
/* */
/* A fresh CONS page looks like this: */
/* */
/* +--------+--------+----------------+ */
/* 0 | count | nxtcell| (padding) | nxtcell = 254. */
/* +--------+--------+----------------+ */
/* 2 | next_page | */
/* +--------+-------------------------+ */
/* 4 | 0 | N I L | */
/* +--------+-------------------------+ */
/* 6 | 4 | N I L | */
/* +--------+-------------------------+ */
/* ... | ... | N I L | */
/* +--------+-------------------------+ */
/* 254 | 252 | N I L | */
/* +--------+-------------------------+ */
/* */
/* The cells are chained together thru their high 8 bits, */
/* using the word offset within page as the chain. Cells */
/* are chained from the top of the page down. */
/* */
/* Experimental version goes nxtcell = 248 */
/* count/nxtcell in cell 4, next_page in cell 6
*/
/* Chain up 4 down 8 ( ^ 6 into word count)
*/
/* */
/* */
/* */
/* */
/************************************************************************/
static void init_conspage(register struct conspage *base, unsigned int link)
/* Page Base */
/* Prev Link page number DL->int*/
{
register ConsCell *cell;
register int j; /* DL-> int */
#ifdef TRACE2
printf("TRACE: init_conspage()\n");
#endif
#ifdef NEWCDRCODING
base->next_cell = 6 ^ (j = 254);
while (j > 8) {
cell = (ConsCell *)((DLword *)base + (6 ^ j));
cell->car_field = NIL_PTR;
j -= 2;
((freecons *)cell)->next_free = (6 ^ j);
}
base->count = 124;
#else
base->next_cell = j = 254;
while (j != 0) {
cell = (ConsCell *)((DLword *)base + (j));
cell->car_field = NIL_PTR;
j -= 2;
((freecons *)cell)->next_free = (j);
}
base->count = 127;
#endif /* NEWCDRCODING */
base->next_page = link;
} /* init_conspage end */
/**********************************************************************/
/*
Func name : next_conspage
GET NEXT CONS PAGE .
Date : January 13, 1987
Edited by : Takeshi Shimizu
Changed : January 20, 1987 (take)
Changed : Feb-12-87 take
Changed : Feb-13-87 take
*/
/**********************************************************************/
struct conspage *next_conspage(void) {
extern struct dtd *ListpDTD;
register struct conspage *page1; /* Allocated 1st MDS page */
register struct conspage *page2; /* Allocated 2nd MDS page */
struct conspage *pg, *priorpg;
register int next, prior;
#ifdef NEWCDRCODING
/* Alloc 2 Conspages and get 1st page base */
page1 = (struct conspage *)alloc_mdspage(TYPE_LISTP);
/* Culc. next Conspage's Base address */
page2 = (struct conspage *)((DLword *)page1 + DLWORDSPER_PAGE);
init_conspage(page2, 0); /* Doesn't exst next page */
init_conspage(page1, LPAGE_from_68k(page2));
prior = 0;
for (pg = (struct conspage *)Addr68k_from_LPAGE(next = ListpDTD->dtd_nextpage);
next && (next != CONSPAGE_LAST);
pg = (struct conspage *)Addr68k_from_LPAGE(next = pg->next_page)) {
priorpg = pg;
prior = next;
}
if (prior)
priorpg->next_page = LPAGE_from_68k(page1);
else
ListpDTD->dtd_nextpage = LPAGE_from_68k(page1);
if (page2->next_page) error("page2 has a next page??");
if (page2 == priorpg) error("loop in conspage next_pages");
#else
for (next = (int)ListpDTD->dtd_nextpage; /* getnext free conspage */
; ListpDTD->dtd_nextpage = next = page1->next_page, page1->next_page = 0xffff) {
if (next == 0) {
/* Alloc 2 Conspages and get 1st page base */
page1 = (struct conspage *)alloc_mdspage(TYPE_LISTP);
/* Culc. next Conspage's Base address */
page2 = (struct conspage *)((DLword *)page1 + DLWORDSPER_PAGE);
init_conspage(page2, ListpDTD->dtd_nextpage); /* Doesn't exst next page */
init_conspage(page1, LPAGE_from_68k(page2));
ListpDTD->dtd_nextpage = LPAGE_from_68k(page1);
goto ex; /* replaced break */
} else {
page1 = (struct conspage *)Addr68k_from_LPAGE(next); /*Jan-21*/
}
if (page1->count > 1) break;
} /* for loop end */
#endif /* NEWCDRCODING */
ex:
return (page1);
} /* next_conspage end */
/************************************************************************/
/* */
/* f i n d _ c d r c o d a b l e _ p a i r */
/* */
/* Find a pair of CONS cells that are close enough (within 7) */
/* that the second can be cdr-coded as the cdr of the first. */
/* Set up the cdr code in the first cell, and return it.
*/
/* */
/* First searches the CONS page given, then the free-page chain */
/* finally, calls conspage to get a fresh (and guaranteed useful) page. */
/* */
/************************************************************************/
static ConsCell *find_pair_in_page(struct conspage *pg, LispPTR cdrval) {
ConsCell *carcell, *cdrcell;
unsigned int offset, prior, priorprior, ppriorprior, noffset, nprior, poffset;
if (pg->count < 2) return ((ConsCell *)0);
ppriorprior = priorprior = prior = nprior = 0;
for (offset = pg->next_cell; offset; offset = FREECONS(pg, offset)->next_free) {
if (prior) {
/* if ((6^prior) <= (6^offset)) error("free list in CONS page corrupt."); */
if ((prior > offset) && (prior <= offset + 14)) {
poffset = offset;
noffset = FREECONS(pg, offset)->next_free;
while ((noffset > offset) && (noffset < prior)) {
nprior = offset;
poffset = prior;
offset = noffset;
noffset = FREECONS(pg, offset)->next_free;
}
carcell = (ConsCell *)((DLword *)pg + offset);
cdrcell = (ConsCell *)((DLword *)pg + prior);
if (priorprior)
FREECONS(pg, priorprior)->next_free = FREECONS(pg, poffset)->next_free;
else
pg->next_cell = FREECONS(pg, poffset)->next_free;
if (nprior) FREECONS(pg, nprior)->next_free = FREECONS(pg, offset)->next_free;
carcell->cdr_code = cdrcell - carcell;
#ifdef NEWCDRCODING
if ((cdrcell - carcell) > 7) error("in find_pair_in_page, cdr code too big.");
if (254 < (offset + (carcell->cdr_code << 1))) error("in fpip, page overflow.");
#endif /* NEWCDRCODING */
pg->count -= 2;
*((LispPTR *)cdrcell) = cdrval;
return (carcell);
} else if ((offset > prior) && (offset <= prior + 14)) {
carcell = (ConsCell *)((DLword *)pg + prior);
cdrcell = (ConsCell *)((DLword *)pg + offset);
if (priorprior)
FREECONS(pg, priorprior)->next_free = ((freecons *)cdrcell)->next_free;
else
pg->next_cell = ((freecons *)cdrcell)->next_free;
carcell->cdr_code = cdrcell - carcell;
#ifdef NEWCDRCODING
if ((cdrcell - carcell) > 7) error("in find_pair_in_page, cdr code too big.");
if (254 < (prior + (carcell->cdr_code << 1))) error("in fpip, page overflow.");
#endif /* NEWCDRCODING */
pg->count -= 2;
*((LispPTR *)cdrcell) = cdrval;
return (carcell);
}
}
ppriorprior = priorprior;
priorprior = prior;
prior = offset;
}
return ((ConsCell *)0);
}
static ConsCell *find_cdrcodable_pair(LispPTR cdrval) {
ConsCell *cell;
struct conspage *pg;
unsigned pgno = ListpDTD->dtd_nextpage;
for (pg = (struct conspage *)Addr68k_from_LPAGE(pgno); pgno;
pg = (struct conspage *)Addr68k_from_LPAGE(pgno = pg->next_page))
if ((cell = find_pair_in_page(pg, cdrval))) return (cell);
pg = next_conspage();
cell = find_pair_in_page(pg, cdrval);
return (cell);
} /* end of find_cdrcodable_pair */
static ConsCell *find_free_cons_cell(void) {
ConsCell *cell;
struct conspage *pg, *priorpg;
unsigned pgno = ListpDTD->dtd_nextpage;
for (pg = (struct conspage *)Addr68k_from_LPAGE(pgno); pgno;
pg = (struct conspage *)Addr68k_from_LPAGE(pgno))
if (pg->count) {
pg->count--;
cell = (ConsCell *)(((DLword *)pg) + (pg->next_cell));
pg->next_cell = ((freecons *)cell)->next_free;
return (cell);
} else { /* remove the empty page from the free chain */
pgno = ListpDTD->dtd_nextpage = pg->next_page;
pg->next_page = CONSPAGE_LAST;
}
return ((ConsCell *)0);
} /* end of find_free_cons_cell */
/**********************************************************************/
/*
Func name :N_OP_cons
Execute CONS OPCODE
Date : March 29 1988
Edited by : Bob Krivacic
*/
/**********************************************************************/
LispPTR N_OP_cons(register int cons_car, register int cons_cdr) {
extern struct dtd *ListpDTD;
register struct conspage *new_conspage;
register ConsCell *new_cell;
register ConsCell *temp_cell;
register int new_page; /* hold the return val of nextconspage ,DL->int */
extern ConsCell *find_close_prior_cell(struct conspage * page, LispPTR oldcell);
GCLOOKUP(cons_cdr &= POINTERMASK, ADDREF);
GCLOOKUP(cons_car, ADDREF);
if (cons_cdr == NIL_PTR) {
#ifdef NEWCDRCODING
if ((new_cell = find_free_cons_cell())) { /* next page has 1 or more free cells */
#else
if ((ListpDTD->dtd_nextpage != 0) &&
(GetCONSCount(ListpDTD->dtd_nextpage) > 0)) { /* next page has 1 or more free cells */
new_page = ListpDTD->dtd_nextpage;
new_conspage = (struct conspage *)Addr68k_from_LPAGE(new_page);
if (new_conspage->next_cell == 0) error("count ne 0, but nothing on free chain.");
new_cell = GetNewCell_68k(new_conspage); /* get new cell */
new_conspage->count--; /* decrement free cnt. */
new_conspage->next_cell = ((freecons *)new_cell)->next_free; /* update free cell chain */
#endif /* NEWCDRCODING */
/* filling new cell with the data */
new_cell->car_field = cons_car;
new_cell->cdr_code = CDR_NIL;
ListpDTD->dtd_cnt0++;
} /* if (ListpDTD.. end */
else { /* Need to get a new CONS page */
new_conspage = next_conspage();
new_cell = GetNewCell_68k(new_conspage);
new_conspage->count--; /* decrement free cnt. */
new_conspage->next_cell = ((freecons *)new_cell)->next_free; /* update free cell chain */
/* filling new cell with the data */
new_cell->car_field = cons_car;
new_cell->cdr_code = CDR_NIL;
ListpDTD->dtd_oldcnt++;
} /* else 1 end */
} /* if(cons_cdr.. end */
else /* cons_cdr != NIL */
{
new_page = POINTER_PAGE(cons_cdr); /* Y's page num */
new_conspage = (struct conspage *)Addr68k_from_LPAGE(new_page);
#ifdef NEWCDRCODING
if (Listp(cons_cdr) && (new_conspage->count > 0) &&
(new_cell = find_close_prior_cell(new_conspage, cons_cdr)))
#else
if (Listp(cons_cdr) && (new_conspage->count > 0))
#endif /* NEWCDRCODING */
{ /* The cdr is itself a CONS cell, and can be */
/* represented using CDR_ONPAGE representation */
#ifndef NEWCDRCODING
new_cell = GetNewCell_68k(new_conspage);
#ifdef DEBUG
if (new_cell->car_field != NIL) {
printf("CELL 0x%x has non-NIL car = 0x%x \n", LADDR_from_68k(new_cell),
new_cell->car_field);
error("QUIT from N_OP_cons");
}
#endif
new_conspage->count--; /* decrement free cnt. */
new_conspage->next_cell = ((freecons *)new_cell)->next_free; /* update free cell chain */
#endif /*NEWCDRCODING */
new_cell->car_field = cons_car;
/* cdr_onpage + cell offset in this conspage */
#ifdef NEWCDRCODING
#else
new_cell->cdr_code = CDR_ONPAGE | ((cons_cdr & 0xff) >> 1);
#endif /* NEWCDRCODING */
ListpDTD->dtd_cnt0++;
} /* if (listp.. end */
else {
/* UFN case : CDR_INDIRECT */
#ifdef NEWCDRCODING
new_cell = find_cdrcodable_pair(cons_cdr);
#else
new_conspage = next_conspage();
/* get 2 cells from conspage */
temp_cell = GetNewCell_68k(new_conspage);
#ifdef DEBUG
if (temp_cell->car_field != NIL) {
printf("CDR indirect CELL 0x%x has non-NIL car 0x%x \n", LADDR_from_68k(new_cell),
temp_cell->car_field);
error("QUIT from N_OP_cons");
}
#endif
new_conspage->next_cell = ((freecons *)temp_cell)->next_free; /* update free cell chain */
new_cell = GetNewCell_68k(new_conspage);
#ifdef DEBUG
if (new_cell->car_field != NIL) {
printf("CDR ind-2 CELL 0x%x has non-NIL car = 0x%x \n", LADDR_from_68k(new_cell),
new_cell->car_field);
error("QUIT from N_OP_cons");
}
#endif
new_conspage->next_cell = ((freecons *)new_cell)->next_free; /* update free cell chain */
new_conspage->count -= 2; /* decrement free cnt. */
/* filling cell */
*((LispPTR *)temp_cell) = cons_cdr; /* Indirect CDR ptr */
#endif /* NEWCDRCODING */
new_cell->car_field = cons_car;
#ifndef NEWCDRCODING
/* culc. cdr code */
new_cell->cdr_code = (((LispPTR)LADDR_from_68k(temp_cell)) & 0xff) >> 1;
#endif /* NEWCDRCODING */
ListpDTD->dtd_oldcnt++; /* added feb-12 take */
} /* else end */
} /* else (cons_cdr==NIL end) */
new_page = LADDR_from_68k(new_cell);
GCLOOKUP(new_page, DELREF);
#ifdef NEWCDRCODING
if (254 < ((new_page & 0xff) + ((new_cell->cdr_code & 7) << 1)))
error("in CONS, cdr code too big.");
#endif /* NEWCDROCDING */
return (new_page);
} /* N_OP_cons() end */
/**********************************************************************/
/* function cons same as N_OP_cons */
/**********************************************************************/
LispPTR cons(LispPTR cons_car, LispPTR cons_cdr) { return (N_OP_cons(cons_car, cons_cdr)); }
Reference in New Issue View Git Blame Copy Permalink