Replaced dis and new with modern implementations donated by erik@backerud.se.

This commit is contained in:
dtrg 2010-10-02 21:52:29 +00:00
parent 075cb488a3
commit 45ee287136
2 changed files with 156 additions and 91 deletions

View file

@ -1,3 +1,15 @@
/*
* File: - dis.c
*
* dispose() built in standard procedure in Pascal (6.6.5.3)
*
* Re-implementation of storage allocator for Ack Pascal compiler
* under Linux, and other UNIX-like systems.
*
* Written by Erik Backerud, 2010-10-01
*
* Original copyright and author info below:
*/
/* $Id$ */
/*
* (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
@ -23,65 +35,67 @@
#define assert() /* nothing */
/*
* use circular list of free blocks from low to high addresses
* _highp points to free block with highest address
* use a singly linked list of free blocks.
*/
struct adm {
struct adm *next;
int size;
};
extern struct adm *_lastp;
extern struct adm *_highp;
extern _trp();
struct adm *freep = 0; /* first element on free list */
static int merge(p1,p2) struct adm *p1,*p2; {
struct adm *p;
extern void _trp(int);
p = (struct adm *)((char *)p1 + p1->size);
if (p > p2)
_trp(EFREE);
if (p != p2)
return(0);
p1->size += p2->size;
p1->next = p2->next;
return(1);
}
_dis(n,pp) int n; struct adm **pp; {
struct adm *p1,*p2;
/*
* NOTE: dispose only objects whose size is a multiple of sizeof(*pp).
* this is always true for objects allocated by _new()
/*
* Dispose
* Called with two arguments:
* n the size of the block to be freed, in bytes,
* pp address of pointer to data.
*/
n = ((n+sizeof(*p1)-1) / sizeof(*p1)) * sizeof(*p1);
if (n == 0)
return;
if ((p1= *pp) == (struct adm *) 0)
void
_dis(int n, struct adm **pp)
{
struct adm *block; /* the block of data being freed (inc. header) */
struct adm *p, *q;
if (*pp == 0) {
_trp(EFREE);
p1->size = n;
if ((p2 = _highp) == 0) /*p1 is the only free block*/
p1->next = p1;
else {
if (p2 > p1) {
/*search for the preceding free block*/
if (_lastp < p1) /*reduce search*/
p2 = _lastp;
while (p2->next < p1)
p2 = p2->next;
}
/* if p2 preceeds p1 in the circular list,
* try to merge them */
p1->next = p2->next; p2->next = p1;
if (p2 <= p1 && merge(p2,p1))
p1 = p2;
p2 = p1->next;
/* p1 preceeds p2 in the circular list */
if (p2 > p1) merge(p1,p2);
block = *pp - 1;
if (freep == 0) {
freep = block;
block->next = 0;
} else {
q = 0; /* trail one behind */
for (p = freep; p < block; p = p->next) {
if (p == 0) { /* We reached the end of the free list. */
break;
}
if (p1 >= p1->next)
_highp = p1;
_lastp = p1;
*pp = (struct adm *) 0;
}
q = p;
/* check if block is contained in the free block p */
if (p+p->size > block) {
_trp(EFREE);
}
}
if (p == block) { /* this block already freed */
_trp(EFREE);
}
if (q == 0) { /* block is first */
freep = block;
block->next = p;
} else {
q->next = block;
}
block->next = p;
/* merge with successor on free list? */
if (block + block->size == p) {
block->size = block->size + p->size;
block->next = p->next;
}
/* merge with preceding block on free list? */
if (q != 0 && q+q->size == block) {
q->size = q->size + block->size;
q->next = block->next;
}
}
} /* _dis */

View file

@ -1,3 +1,15 @@
/*
* File: - new.c
*
* new() built in standard procedure in Pascal (6.6.5.3)
*
* Re-implementation of storage allocator for Ack Pascal compiler
* under Linux, and other UNIX-like systems.
*
* Written by Erik Backerud, 2010-10-01
*
* Original copyright and author info below:
*/
/* $Id$ */
/*
* (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
@ -17,53 +29,92 @@
*/
/* Author: J.W. Stevenson */
extern _sav();
extern _rst();
#include <em_abs.h>
#include <pc_err.h>
#define assert(x) /* nothing */
#define UNDEF 0x8000
#define NALLOC (1024) /* request this many units from OS */
/*
* use a singly linked list of free blocks.
*/
struct adm {
struct adm *next;
int size;
};
struct adm *_lastp = 0;
struct adm *_highp = 0;
extern struct adm *freep;
_new(n,pp) int n; struct adm **pp; {
extern void _trp(int); /* called on error */
extern void _dis(int, struct adm **);
/*
* Helper function to request 'nu' units of memory from the OS.
* A storage unit is sizeof(struct adm). Typically 8 bytes
* on a 32-bit machine like i386 etc.
*/
static struct adm *
morecore(unsigned nu)
{
char *cp, *sbrk(int);
struct adm *up;
if (nu < NALLOC)
nu = NALLOC;
cp = sbrk(nu * sizeof(struct adm));
if (cp == (char *) -1) /* no space at all */
return 0;
up = (struct adm*) cp;
up->size = nu;
up = up + 1;
_dis((nu - 1) * sizeof(struct adm), &up);
return freep;
} /* morecore */
/*
* Dispose
* Called with two arguments:
* n the size of the block to be freed, in bytes,
* pp address of pointer to data.
*/
void
_new(int n, struct adm **pp)
{
int nunits; /* the unit of storage is sizeof(struct adm) */
struct adm *p,*q;
int *ptmp;
n = ((n+sizeof(*p)-1) / sizeof(*p)) * sizeof(*p);
if ((p = _lastp) != 0)
do {
q = p->next;
if (q->size >= n) {
assert(q->size%sizeof(adm) == 0);
if ((q->size -= n) == 0) {
if (p == q)
p = 0;
else
p->next = q->next;
if (q == _highp)
_highp = p;
/* round up size of request */
nunits = (n + sizeof(struct adm) - 1) / sizeof(struct adm) + 1;
q = 0;
for (p = freep; ; p = p->next) {
if (p == 0) {
p = morecore(nunits);
if (p == 0)
_trp(EHEAP);
q = 0;
}
_lastp = p;
p = (struct adm *)((char *)q + q->size);
q = (struct adm *)((char *)p + n);
goto initialize;
if (p->size >= nunits) {
if (p->size == nunits) { /* exact fit */
if (q == 0) { /* first element on free list. */
freep = p->next;
} else {
q->next = p->next;
}
p = q;
} while (p != _lastp);
/*no free block big enough*/
_sav(&p);
q = (struct adm *)((char *)p + n);
_rst(&q);
initialize:
*pp = p;
ptmp = (int *)p;
while (ptmp < (int *)q)
*ptmp++ = UNDEF;
}
} else { /* allocate tail end */
q = p;
q->size = q->size - nunits;
p = q + q->size;
p->next = 0;
p->size = nunits;
}
break;
}
q = p;
}
*pp = p + 1;
} /* _new */