Replaced dis and new with modern implementations donated by erik@backerud.se.
This commit is contained in:
parent
075cb488a3
commit
45ee287136
|
@ -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;
|
||||
|
||||
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;
|
||||
extern void _trp(int);
|
||||
|
||||
/*
|
||||
* 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 */
|
||||
|
|
|
@ -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 */
|
||||
|
|
Loading…
Reference in a new issue