diff --git a/lang/pc/comp/chk_expr.c b/lang/pc/comp/chk_expr.c index 1c5cb58ea..a9e8ba73a 100644 --- a/lang/pc/comp/chk_expr.c +++ b/lang/pc/comp/chk_expr.c @@ -1183,13 +1183,6 @@ ChkStandard(expp,left) expp->nd_type = NULLTYPE; break; - case R_MARK: - case R_RELEASE: - if( !(left = getarg(&arg, T_POINTER, 1, name, NULLTYPE)) ) - return 0; - expp->nd_type = NULLTYPE; - break; - case R_HALT: if( !arg->nd_right ) /* insert 0 parameter */ arg->nd_right = ZeroParam(); diff --git a/lang/pc/comp/code.c b/lang/pc/comp/code.c index 1c916c3dc..5cdc6644a 100644 --- a/lang/pc/comp/code.c +++ b/lang/pc/comp/code.c @@ -1076,16 +1076,6 @@ CodeStd(nd) C_asp(pointer_size + word_size); break; - case R_MARK: - case R_RELEASE: - CodeDAddress(left); - if( req == R_MARK ) - C_cal("_sav"); - else - C_cal("_rst"); - C_asp(pointer_size); - break; - case R_HALT: if( left ) CodePExpr(left); diff --git a/lang/pc/comp/main.c b/lang/pc/comp/main.c index cef708fcd..46eabf855 100644 --- a/lang/pc/comp/main.c +++ b/lang/pc/comp/main.c @@ -189,10 +189,6 @@ AddRequired() /* DYNAMIC ALLOCATION PROCEDURES */ (void) Enter("new", D_PROCEDURE, std_type, R_NEW); (void) Enter("dispose", D_PROCEDURE, std_type, R_DISPOSE); - if( !options['s'] ) { - (void) Enter("mark", D_PROCEDURE, std_type, R_MARK); - (void) Enter("release", D_PROCEDURE, std_type, R_RELEASE); - } /* MISCELLANEOUS PROCEDURE(S) */ if( !options['s'] ) diff --git a/lang/pc/comp/required.h b/lang/pc/comp/required.h index 20b9a5fad..e8a4becbe 100644 --- a/lang/pc/comp/required.h +++ b/lang/pc/comp/required.h @@ -1,48 +1,51 @@ /* REQUIRED PROCEDURES AND FUNCTIONS */ -/* PROCEDURES */ -/* FILE HANDLING */ -#define R_REWRITE 1 -#define R_PUT 2 -#define R_RESET 3 -#define R_GET 4 -#define R_PAGE 5 +enum +{ + R__UNUSED = 0, -/* DYNAMIC ALLOCATION */ -#define R_NEW 6 -#define R_DISPOSE 7 -#define R_MARK 8 -#define R_RELEASE 9 + /* PROCEDURES */ + /* FILE HANDLING */ + R_REWRITE, + R_PUT, + R_RESET, + R_GET, + R_PAGE, -/* MISCELLANEOUS PROCEDURE(S) */ -#define R_HALT 10 + /* DYNAMIC ALLOCATION */ + R_NEW, + R_DISPOSE, -/* TRANSFER */ -#define R_PACK 11 -#define R_UNPACK 12 + /* MISCELLANEOUS PROCEDURE(S) */ + R_HALT, -/* FUNCTIONS */ -/* ARITHMETIC */ -#define R_ABS 13 -#define R_SQR 14 -#define R_SIN 15 -#define R_COS 16 -#define R_EXP 17 -#define R_LN 18 -#define R_SQRT 19 -#define R_ARCTAN 20 + /* TRANSFER */ + R_PACK, + R_UNPACK, -/* TRANSFER */ -#define R_TRUNC 21 -#define R_ROUND 22 + /* FUNCTIONS */ + /* ARITHMETIC */ + R_ABS, + R_SQR, + R_SIN, + R_COS, + R_EXP, + R_LN, + R_SQRT, + R_ARCTAN, -/* ORDINAL */ -#define R_ORD 23 -#define R_CHR 24 -#define R_SUCC 25 -#define R_PRED 26 + /* TRANSFER */ + R_TRUNC, + R_ROUND, -/* BOOLEAN */ -#define R_ODD 27 -#define R_EOF 28 -#define R_EOLN 29 + /* ORDINAL */ + R_ORD, + R_CHR, + R_SUCC, + R_PRED, + + /* BOOLEAN */ + R_ODD, + R_EOF, + R_EOLN, +}; diff --git a/lang/pc/libpc/build.lua b/lang/pc/libpc/build.lua index 61c4f7a3e..7845991e5 100644 --- a/lang/pc/libpc/build.lua +++ b/lang/pc/libpc/build.lua @@ -11,7 +11,6 @@ for _, plat in ipairs(vars.plats) do "./fif.e", "./gto.e", "./hol0.e", - "./sav.e", "./sig.e", "./trap.e", "./trp.e", diff --git a/lang/pc/libpc/dis.c b/lang/pc/libpc/dis.c deleted file mode 100644 index c6a9bd2e7..000000000 --- a/lang/pc/libpc/dis.c +++ /dev/null @@ -1,101 +0,0 @@ -/* - * 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. - * - * This product is part of the Amsterdam Compiler Kit. - * - * Permission to use, sell, duplicate or disclose this software must be - * obtained in writing. Requests for such permissions may be sent to - * - * Dr. Andrew S. Tanenbaum - * Wiskundig Seminarium - * Vrije Universiteit - * Postbox 7161 - * 1007 MC Amsterdam - * The Netherlands - * - */ - -/* Author: J.W. Stevenson */ - -#include - -#define assert() /* nothing */ - -/* - * use a singly linked list of free blocks. - */ -struct adm { - struct adm *next; - int size; -}; - -struct adm *freep = 0; /* first element on free list */ - -extern void _trp(int); - -/* - * Dispose - * Called with two arguments: - * n the size of the block to be freed, in bytes, - * pp address of pointer to data. - */ -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); - } - 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; - } - 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 */ diff --git a/lang/pc/libpc/new.c b/lang/pc/libpc/new.c index 427cb850c..b3425c176 100644 --- a/lang/pc/libpc/new.c +++ b/lang/pc/libpc/new.c @@ -1,120 +1,20 @@ -/* - * 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. - * - * This product is part of the Amsterdam Compiler Kit. - * - * Permission to use, sell, duplicate or disclose this software must be - * obtained in writing. Requests for such permissions may be sent to - * - * Dr. Andrew S. Tanenbaum - * Wiskundig Seminarium - * Vrije Universiteit - * Postbox 7161 - * 1007 MC Amsterdam - * The Netherlands - * - */ - -/* Author: J.W. Stevenson */ +#include #include #include -#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; -}; - -extern struct adm *freep; - 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) +void _new(int n, void** ptr) { - 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; - - /* 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) + void* p = malloc(n); + if (!p) _trp(EHEAP); - q = 0; - } - 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; - } - } 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 */ + + *ptr = p; +} + +void _dis(int n, void** ptr) +{ + free(*ptr); + *ptr = NULL; +} \ No newline at end of file diff --git a/lang/pc/libpc/sav.e b/lang/pc/libpc/sav.e deleted file mode 100644 index 3f5362f1c..000000000 --- a/lang/pc/libpc/sav.e +++ /dev/null @@ -1,49 +0,0 @@ -# -; $Id$ -; (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. -; -; This product is part of the Amsterdam Compiler Kit. -; -; Permission to use, sell, duplicate or disclose this software must be -; obtained in writing. Requests for such permissions may be sent to -; -; Dr. Andrew S. Tanenbaum -; Wiskundig Seminarium -; Vrije Universiteit -; Postbox 7161 -; 1007 MC Amsterdam -; The Netherlands -; - -/* Author: J.W. Stevenson */ - - - mes 2,EM_WSIZE,EM_PSIZE - -#define PTRAD 0 - -#define HP 2 - -; _sav called with one parameter: -; - address of pointer variable (PTRAD) - - exp $_sav - pro $_sav,0 - lor HP - lal PTRAD - loi EM_PSIZE - sti EM_PSIZE - ret 0 - end ? - -; _rst is called with one parameter: -; - address of pointer variable (PTRAD) - - exp $_rst - pro $_rst,0 - lal PTRAD - loi EM_PSIZE - loi EM_PSIZE - str HP - ret 0 - end ? diff --git a/plat/qemuppc/tests/build.lua b/plat/qemuppc/tests/build.lua index 024961fda..f0c2993c4 100644 --- a/plat/qemuppc/tests/build.lua +++ b/plat/qemuppc/tests/build.lua @@ -6,7 +6,7 @@ local tests = {} if os.execute("which "..qemu.." > /dev/null") ~= 0 then print("warning: skipping tests which require ", qemu) else - local testcases = filenamesof("./*.c", "./*.s", "./*.e") + local testcases = filenamesof("./*.c", "./*.s", "./*.e", "./*.p") for _, f in ipairs(testcases) do local fs = replace(basename(f), "%..$", "") diff --git a/plat/qemuppc/tests/newdispose_p.p b/plat/qemuppc/tests/newdispose_p.p new file mode 100644 index 000000000..36f09e99b --- /dev/null +++ b/plat/qemuppc/tests/newdispose_p.p @@ -0,0 +1,34 @@ +# +(*$U+ -- enables underscores in identifiers *) + +program markrelease; + +type + iptr = ^integer; + +var + ptr1 : iptr; + ptr2 : iptr; + +procedure finished; + extern; + +procedure fail(line: integer); + extern; + +#define ASSERT(cond) \ + if (not (cond)) then fail(__LINE__) + +begin + New(ptr1); + New(ptr2); + ASSERT(ptr1 <> ptr2); + + Dispose(ptr1); + Dispose(ptr2); + (* Not required by the Pascal standard, but our implementation sets the + * pointers to NULL after freeing them. *) + ASSERT(ptr1 = ptr2); + + finished +end.