github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-01-15 15:57:13 +00:00
Code Issues Projects Releases Wiki Activity
Interlisp.maiko/src/conspage.c
Nick Briggs c60b522012
Files should explicitly include the definitions they directly depend on (#355) 
... start by fixing the include files and the fallout in C source from
removing includes not directly needed by headers that previously included
them.
2021-02-13 21:41:31 -08: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
*/
/************************************************************************/
/* */
/* (C) Copyright 1989-94 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/************************************************************************/
#include "version.h"
/**
* @file conspage.c
*/
#include <stddef.h>
#include "lispemul.h"
#include "address.h"
#include "adr68k.h"
#include "lsptypes.h"
#include "cell.h"
#include "lispmap.h"
#include "lspglob.h"
#include "gcdata.h"
#include "conspagedefs.h"
#include "allocmdsdefs.h"
#include "car-cdrdefs.h"
#include "commondefs.h"
#include "gchtfinddefs.h"
/**
* Initializes a page of CONS cells, sets up the free count and
* chains the cells together for ease of searching.
*
* A fresh CONS page looks like this:
*
* +--------+--------+----------------+
* 0 | count |nextcell| (padding) | nextcell = 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 (16-bit) word offset within page as the chain.
* Cells are chained from the top of the page down.
*
* Experimental version goes nextcell = 248
* count/nextcell in cell 4, next_page in cell 6
* Chain up 4 down 8 ( ^ 6 into word count)
*
* @param[in,out] base Native pointer to cons page
* @param[in] link Lisp page number of next cons page
*/
static void init_conspage(register struct conspage *base, unsigned int link)
{
register ConsCell *cell;
register int j; /* DL-> int */
#ifdef TRACE2
printf("TRACE: init_conspage()\n");
#endif
#ifdef NEWCDRCODING
j = 254;
base->next_cell = 6 ^ j;
while (j > 8) {
cell = (ConsCell *)((DLword *)base + (6 ^ j));
cell->car_field = NIL_PTR;
j -= 2;
((freecons *)cell)->next_free = (6 ^ j);
}
cell = (ConsCell *)((DLword *)base + (6 ^ j));
cell->car_field = NIL_PTR;
((freecons *)cell)->next_free = 0;
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;
}
cell = (ConsCell *)((DLword *)base + j);
cell->car_field = NIL_PTR;
((freecons *)cell)->next_free = 0;
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
/* Allocate 2 conspages and get 1st page base */
page1 = (struct conspage *)alloc_mdspage(TYPE_LISTP);
/* Calculate next conspage's base address */
page2 = (struct conspage *)((DLword *)page1 + DLWORDSPER_PAGE);
init_conspage(page2, 0); /* No next page */
init_conspage(page1, LPAGE_from_68k(page2));
priorpg = NULL;
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; /* /!\ Note no exit condition /!\ */ /* get next free conspage */
; ListpDTD->dtd_nextpage = next = page1->next_page, page1->next_page = 0xffff) {
if (next == 0) {
/* Allocate 2 conspages and get 1st page base */
page1 = (struct conspage *)alloc_mdspage(TYPE_LISTP);
/* Calculate next conspage's base address */
page2 = (struct conspage *)((DLword *)page1 + DLWORDSPER_PAGE);
/* XXX: why is the link for page2's next here?
* when it was previously commented as "Doesn't exist next page"
*/
init_conspage(page2, ListpDTD->dtd_nextpage);
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, noffset, nprior, poffset;
if (pg->count < 2) return ((ConsCell *)0);
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);
}
}
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;
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;
#ifndef NEWCDRCODING
register ConsCell *temp_cell;
#endif
register int new_page; /* hold the return val of nextconspage ,DL->int */
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