From 79e9c535970a1887e1b6b2196cd90775955ea486 Mon Sep 17 00:00:00 2001 From: Taco Hoekwater Date: Thu, 16 Apr 2009 07:36:46 +0000 Subject: This is an initial import of the current trunk state of MPlib (version 1.110 and a few minor patches). For the moment, the mplib.am builds the executable "newmpost", that should be fixed soon. git-svn-id: svn://tug.org/texlive/trunk@12732 c570f23f-e606-0410-a88d-b1316a301751 --- Build/source/texk/web2c/mplibdir/am/mplib.am | 52 + Build/source/texk/web2c/mplibdir/avl.c | 2636 +++ Build/source/texk/web2c/mplibdir/avl.h | 467 + Build/source/texk/web2c/mplibdir/lmplib.c | 1238 ++ Build/source/texk/web2c/mplibdir/memio.w | 405 + Build/source/texk/web2c/mplibdir/mp.w | 26427 +++++++++++++++++++++++++ Build/source/texk/web2c/mplibdir/mpost.w | 939 + Build/source/texk/web2c/mplibdir/mpxout.w | 4312 ++++ Build/source/texk/web2c/mplibdir/psout.w | 6246 ++++++ Build/source/texk/web2c/mplibdir/svgout.w | 1314 ++ Build/source/texk/web2c/mplibdir/tfmin.w | 242 + 11 files changed, 44278 insertions(+) create mode 100644 Build/source/texk/web2c/mplibdir/avl.c create mode 100644 Build/source/texk/web2c/mplibdir/avl.h create mode 100644 Build/source/texk/web2c/mplibdir/lmplib.c create mode 100644 Build/source/texk/web2c/mplibdir/memio.w create mode 100644 Build/source/texk/web2c/mplibdir/mp.w create mode 100644 Build/source/texk/web2c/mplibdir/mpost.w create mode 100644 Build/source/texk/web2c/mplibdir/mpxout.w create mode 100644 Build/source/texk/web2c/mplibdir/psout.w create mode 100644 Build/source/texk/web2c/mplibdir/svgout.w create mode 100644 Build/source/texk/web2c/mplibdir/tfmin.w (limited to 'Build') diff --git a/Build/source/texk/web2c/mplibdir/am/mplib.am b/Build/source/texk/web2c/mplibdir/am/mplib.am index 12f7dc33e13..c979b25f7d8 100644 --- a/Build/source/texk/web2c/mplibdir/am/mplib.am +++ b/Build/source/texk/web2c/mplibdir/am/mplib.am @@ -1,2 +1,54 @@ ## texk/web2c/mplibdir/am/mplib.am: Makefile fragment for MetaPost. +## metapost +## +bin_PROGRAMS += newmpost + +EXTRA_PROGRAMS += newmpost + +EXTRA_LIBRARIES += libmplib.a + +newmpost_c_h = mpost.c mpxout.c +newmpost_web = mplibdir/mpost.w mplibdir/mpxout.w + +newmpost_CPPFLAGS = -I. -I$(srcdir)/mplibdir +newmpost_DEPENDENCIES = libmplib.a +newmpost_LDADD = libmplib.a $(KPATHSEA_LIBS) -lm +newmpost_SOURCES = $(newmpost_c_h) + +$(newmpost_c_h): mpost-ctangle libmplib.a +mpost-ctangle: ctangle$(EXEEXT) $(newmpost_web) + CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mpost.w + CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mpxout.w + echo timestamp >$@ + touch $(newmpost_c_h) + +DISTCLEANFILES += $(newmpost_c_h) mpost-ctangle + +## These files are mutually dependent +libmplib_c_h = mp.c mplib.h mpmp.h mppsout.h psout.c mplibps.h svgout.c memio.c tfmin.c +libmplib_true_c = mplibdir/avl.h mplibdir/avl.c +libmplib_web = $(libmplib_true_c) mplibdir/mp.w mplibdir/psout.w +libmplib_web += mplibdir/svgout.w mplibdir/memio.w mplibdir/tfmin.w + +libmplib_a_CPPFLAGS = -I. -I$(srcdir)/mplibdir +libmplib_a_SOURCES = $(libmplib_c_h) $(libmplib_true_c) + +$(libmplib_c_h): mplib-ctangle $(libmplib_true_c) +mplib-ctangle: ctangle$(EXEEXT) $(libmplib_web) + CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mp.w + CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) psout.w + CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) svgout.w + CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) tfmin.w + CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) memio.w + echo timestamp >$@ + touch $(libmplib_c_h) + +EXTRA_DIST += $(libmplib_web) + +DISTCLEANFILES += $(libmplib_c_h) mplib-ctangle + +# only used by luatex, perhaps should not be mentioned here +EXTRA_DIST += mplibdir/lmplib.c + + diff --git a/Build/source/texk/web2c/mplibdir/avl.c b/Build/source/texk/web2c/mplibdir/avl.c new file mode 100644 index 00000000000..a8421d4c93d --- /dev/null +++ b/Build/source/texk/web2c/mplibdir/avl.c @@ -0,0 +1,2636 @@ + +/* pyavl -- File "avl.c" */ + +/* AVL trees with RANK field and parent pointers */ + +#include "avl.h" + +#ifdef AVL_SHOW_ERROR_ON +#define AVL_SHOW_ERROR(fmt,arg) fprintf(stderr, "! avl.c: " fmt, arg) +#else +#define AVL_SHOW_ERROR(fmt,arg) (void) (fmt), (void) (arg) +#endif + +void * +avl_default_item_copy (const void *item) +{ + return (void *) item; +} + +void * +avl_default_item_dispose (void *item) +{ + return (void *) NULL; +} + +#ifndef MPW_C +typedef uint32_t rbal_t; /* integral type to encode rank and skew bits */ +#else +typedef UInt32 rbal_t; +#endif + +/* + * avl_node structure + */ + +typedef struct avl_node +{ + struct avl_node *sub[2]; + struct avl_node *up; + rbal_t rbal; + void *item; +} +avl_node; + +/* + * avl_tree structure + */ + +struct avl_tree_ +{ + avl_node *root; + avl_size_t count; /* how many nodes in tree rooted at [root] */ + avl_compare_func compare; /* compare items */ + avl_item_copy_func copy; + avl_item_dispose_func dispose; + avl_alloc_func alloc; /* to allocate memory (same signature as malloc) */ + avl_dealloc_func dealloc; /* to deallocate memory (same signature as free) */ + void *param; +}; + +#define Item_Compare(cmp, tree, item1, item2)\ + (*cmp)(tree->param, item1, item2) + +/* patches (November 2004) */ + +#if AVL_CMPERR != 0 +#define CMPERR_CHECK__FIND(param) if (avl_errcmp_occurred(param)) return NULL +#define CMPERR_CHECK__INDEX(param) if (avl_errcmp_occurred(param)) return 0 +#define CMPERR_CHECK__SPAN(param) if (avl_errcmp_occurred(param)) return -2 +#define CMPERR_CHECK__INS(param) if (avl_errcmp_occurred(param)) return -2 +#define CMPERR_CHECK__DEL(param) (avl_errcmp_occurred(param) ? -2 : 0) +#define CMPERR_CHECK__SPLIT(param) if (avl_errcmp_occurred(param)) return -2 +#define CMPERR_CHECK__VERIFY(param) && (!avl_errcmp_occurred(param)) +#else +#define CMPERR_CHECK__FIND(param) (void) param +#define CMPERR_CHECK__INDEX(param) (void) param +#define CMPERR_CHECK__SPAN(param) (void) param +#define CMPERR_CHECK__INS(param) (void) param +#define CMPERR_CHECK__DEL(param) 0 +#define CMPERR_CHECK__SPLIT(param) (void) param +#define CMPERR_CHECK__VERIFY(param) /* nothing */ +#endif + +#define sub_left(a) (a)->sub[0] +#define sub_right(a) (a)->sub[1] +#define get_item(a) (a)->item + +/* RANK(a) = size of left subtree + 1 */ + +#define rbal(a)\ + (a)->rbal +#define rzero(a)\ + ( rbal(a) & ~3 ) +#define get_bal(a)\ + ( rbal(a) & 3 ) +#define is_lskew(a)\ + ( rbal(a) & 1 ) +#define is_rskew(a)\ + ( rbal(a)>>1 & 1) +#define set_lskew(a)\ + ( rbal(a) |= 1 ) +#define set_rskew(a)\ + ( rbal(a) |= 2 ) +#define set_skew(a,d)\ + ( rbal(a) |= (1 << d) ) +#define unset_lskew(a)\ + ( rbal(a) &= ~1 ) +#define unset_rskew(a)\ + ( rbal(a) &= ~2 ) +#define get_rank(a)\ + ( rbal(a) >> 2 ) +#define set_rank(a,r)\ + ( rbal(a) = (r<<2 | get_bal(a)) ) +#define incr_rank(a,r)\ + ( rbal(a) += r<<2 ) +#define decr_rank(a,r)\ + ( rbal(a) -= r<<2 ) + +#define AVL_MIN_DEPTH 0 + +/*** Node management ***/ + +#define DETACH_FUNC 1 /* nonzero to use function not macro */ + +/* helper structure */ +typedef enum +{ + OP_BACKUP, OP_DETACH, OP_FREE +} +whichop_t; +struct ptr_handler +{ + whichop_t whichop; + void *ptr; +}; + +#define ini_ptr_handler(h,op) struct ptr_handler h = { OP_##op, NULL } +#define clear_node(a) \ + sub_left(a) = NULL; \ + sub_right(a) = NULL; \ + (a)->up = NULL; \ + rbal(a) = 4u + +/* Called by 'avl_ins', 'avl_dup', 'node_slice' */ +static avl_node * +new_node (void *item, avl_node * up, avl_tree t) +{ + avl_node *a = (*t->alloc) (sizeof (avl_node)); + + if (a != NULL) + { + sub_left (a) = NULL; + sub_right (a) = NULL; + a->up = up; + a->rbal = 4u; + a->item = (*t->copy) (item); + } + return a; +} + +static void +free_node (avl_node * a, avl_tree t) +{ + a->item = (*t->dispose) (a->item); + (*t->dealloc) (a); +} + +#define backup_item(backup,item,t) if (backup == NULL) ; else *backup = (*t->copy)(item) + +#if ! DETACH_FUNC + +/* macro to detach node [a] from tree [t] */ +#define detach_node(a,t,h) { struct ptr_handler *ch = h; \ + clear_node(a); \ + do { \ + if (ch == NULL) ; \ + else if (ch->whichop == OP_DETACH){ \ + ch->ptr = a; \ + break; \ + } else if (ch->whichop == OP_BACKUP){ \ + ch->ptr = (*t->copy)(a->item); \ + } \ + free_node(a, t); \ + } while (0);} \ + t->count-- +#else + +/* function to detach node [a] from tree [t] */ +static void +detach_node (avl_node * a, avl_tree t, struct ptr_handler *h) +{ + clear_node (a); + do + { + if (h == NULL); + else if (h->whichop == OP_DETACH) + { + h->ptr = a; + break; + } + else if (h->whichop == OP_BACKUP) + { + h->ptr = (*t->copy) (a->item); + } + free_node (a, t); + } + while (0); + t->count--; +} +#endif /* DETACH_FUNC */ + +/*** Tree methods ***/ + +avl_tree +avl_create (avl_compare_func compare, avl_item_copy_func copy, + avl_item_dispose_func dispose, avl_alloc_func alloc, + avl_dealloc_func dealloc, void *param) +{ + avl_tree t = (*alloc) (sizeof (struct avl_tree_)); + + if (t == NULL) + AVL_SHOW_ERROR ("%s\n", "couldn't create new handle in avl_create()"); + else + { + t->root = NULL; + t->count = 0; + t->param = param; + t->compare = compare; + t->copy = copy; + t->dispose = dispose; + t->alloc = alloc; + t->dealloc = dealloc; + } + return t; +} + +/* Empty the tree, using rotations */ + +static void +node_empty (avl_tree t) +{ + avl_node *a, *p; + + for (a = t->root; a != NULL;) + { + p = a; + if (sub_right (a) == NULL) + a = sub_left (a); + else + { + while (sub_left (a) != NULL) + { + /* rotR(a) */ + a = sub_left (a); + sub_left (p) = sub_right (a); + sub_right (a) = p; + p = a; + } + a = sub_right (p); + } + free_node (p, t); + t->count--; + } + t->root = NULL; +} + +/* [t] is an existing tree handle */ + +/* this function invokes node_empty() */ + +void +avl_reset (avl_tree t, + avl_compare_func compare, + avl_item_copy_func copy, + avl_item_dispose_func dispose, + avl_alloc_func alloc, avl_dealloc_func dealloc) +{ + if (t == NULL) + return; + node_empty (t); + t->compare = compare; + t->copy = copy; + t->dispose = dispose; + t->alloc = alloc; + t->dealloc = dealloc; +} + +void +avl_empty (avl_tree t) +{ + if (t != NULL) + node_empty (t); +} + +/* Destroy nodes, free handle */ + +void +avl_destroy (avl_tree t) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL) + return; +#endif + node_empty (t); + (*t->dealloc) (t); +} + +avl_tree +avl_dup (avl_tree t, void *param) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL) + return NULL; +#endif + { + avl_tree tt = avl_create ( + /*(avl_compare_func) */ t->compare, + /*(avl_item_copy_func) */ t->copy, + /*(avl_item_dispose_func) */ t->dispose, + /*(avl_alloc_func) */ t->alloc, + /*(avl_dealloc_func) */ t->dealloc, + param); + + if (tt == NULL) + { + AVL_SHOW_ERROR ("%s\n", "couldn't create new handle in avl_dup()"); + return NULL; + } + + tt->count = t->count; + + if (t->root == NULL) + return tt; + + { + avl_node *a, *c, *s; + + a = t->root; + tt->root = c = new_node (get_item (a), NULL, t); + if (c == NULL) + goto abort; + + sub_right (c) = NULL; /*!!! */ + rbal (c) = rbal (a); + + while (1) + { + while (sub_left (a) != NULL) + { + a = sub_left (a); + sub_left (c) = s = new_node (get_item (a), NULL, t); + if (s == NULL) + goto recover; + s->up = c; + sub_right (s) = c; + c = s; + rbal (c) = rbal (a); + } + + sub_left (c) = NULL; + + while (sub_right (a) == NULL) + { + s = sub_right (c); + sub_right (c) = NULL; + c = s; + /* Find successor of [a] in original tree */ + do + { + s = a; + a = s->up; + if (a == NULL) + return tt; + } + while (s != sub_left (a)); + } + + a = sub_right (a); + s = new_node (get_item (a), NULL, t); + if (s == NULL) + goto recover; + sub_right (s) = sub_right (c); + sub_right (c) = s; + s->up = c; + c = s; + rbal (c) = rbal (a); + } + /* recovery code */ + recover: + while (1) + { + s = sub_right (c); + sub_right (c) = NULL; + if (s == NULL) + break; + c = s; + } + node_empty (tt); + + abort: + (*t->dealloc) (tt); + AVL_SHOW_ERROR ("%s\n", "couldn't allocate node in avl_dup()"); + return NULL; + } + } +} + +avl_bool_t +avl_isempty (avl_tree t) +{ +#ifndef AVL_NULLCHECKS + return t == NULL || t->root == NULL; +#else + return t->root == NULL; +#endif +} + +avl_size_t +avl_size (avl_tree t) +{ +#ifndef AVL_NULLCHECKS + return t == NULL ? 0 : t->count; +#else + return t->count; +#endif +} + +static int +depth (avl_node * a) +{ + int h = AVL_MIN_DEPTH; + + for (; a != NULL; ++h) + a = a->sub[is_rskew (a)]; + return h; +} + +static avl_node * +node_first (avl_node * a) +{ + while (sub_left (a) != NULL) + a = sub_left (a); + return a; +} + +static avl_node * +node_last (avl_node * a) +{ + while (sub_right (a) != NULL) + a = sub_right (a); + return a; +} + +/* [a] : non-null */ + +static avl_node * +node_next (avl_node * a) +{ + if (sub_right (a) != NULL) + return node_first (sub_right (a)); + { + avl_node *p; + + do + { + p = a; + a = p->up; + } + while (a != NULL && sub_right (a) == p); + return a; + } +} + +/* [a] : non-null */ + +static avl_node * +node_prev (avl_node * a) +{ + if (sub_left (a) != NULL) + return node_last (sub_left (a)); + { + avl_node *p; + + do + { + p = a; + a = p->up; + } + while (a != NULL && sub_left (a) == p); + return a; + } +} + +static avl_node * +node_find (const void *item, avl_tree t) +{ + avl_node *a = t->root; + avl_compare_func cmp = t->compare; + int c; + + while (a != NULL) + { + c = Item_Compare (cmp, t, item, get_item (a)); + CMPERR_CHECK__FIND (t->param); + if (c < 0) + a = a->sub[0]; + else if (c) + a = a->sub[1]; + else + break; + } + return a; +} + +#if 0==1 +static avl_node ** +avl_search (const void *item, avl_tree t, int *dir) +{ + if (t->root == NULL) + return &t->root; + { + avl_node **r = &t->root; + avl_node *a = *r; + avl_compare_func cmp = t->compare; + int c; + + while (1) + { + c = Item_Compare (cmp, t, item, get_item (a)); + if (!c) + break; + r = &a->sub[c = c > 0]; + if (*r == NULL) + { + *dir = c; + break; + } + a = *r; + } + + return r; + } +} +#endif + +static avl_size_t +get_index (avl_node * a) +{ + avl_size_t n = get_rank (a); + avl_node *p; + + while ((p = a->up) != NULL) + { + if (a != sub_left (p)) + n += get_rank (p); + a = p; + } + return n; +} + +/* Find item by index */ + +static avl_node * +node_find_index (avl_size_t idx, avl_tree t) +{ + avl_node *a = t->root; + int c; + + if (idx == 0 || idx > t->count) + return NULL; + if (idx == 1) + return node_first (a); + if (idx == t->count) + return node_last (a); + + while ((c = idx - get_rank (a)) != 0) + { + if (c < 0) + a = sub_left (a); + else + { + idx = c; + a = sub_right (a); + } + } + + return a; +} + +/* Rebalance starting from node [a] where a->sub[d_] + * is deeper post-insertion + */ + +static avl_code_t +rebalance_ins (avl_node * a, int dir, avl_tree t) +{ + if (a != NULL) + { + avl_node *p; + + while (1) + { + incr_rank (a, !dir); + if (get_bal (a)) + break; + set_skew (a, dir); + p = a->up; + if (p == NULL) + return 2; + dir = a != sub_left (p); + a = p; + } + + /* Now bal(a) == -1 or +1 */ + /* Rotate if need be */ + + if (0 == dir) + { + if (is_rskew (a)) + unset_rskew (a); + + else + { + avl_node *u = a->up; + avl_node **r = + u != NULL ? &u->sub[a != sub_left (u)] : &t->root; + + p = a; + + if (is_lskew (sub_left (p))) + { + /* rotR(p) */ + a = sub_left (p); + sub_left (p) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = p; + sub_right (a) = p; + unset_lskew (p); + rbal (p) -= rzero (a); + } + else + { + /* rotLR(p) */ + a = sub_right (sub_left (p)); + sub_right (sub_left (p)) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = sub_left (p); + sub_left (p)->up = a; + sub_left (a) = sub_left (p); + sub_left (p) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = p; + sub_right (a) = p; + switch (get_bal (a)) + { + case 0: /* not skewed */ + unset_lskew (p); + unset_rskew (sub_left (a)); + break; + case 1: /* left skew */ + unset_lskew (p); + set_rskew (p); + unset_rskew (sub_left (a)); + break; + case 2: /* right skew */ + unset_lskew (p); + unset_rskew (sub_left (a)); + set_lskew (sub_left (a)); + } /* switch */ + rbal (a) += rzero (sub_left (a)); + rbal (p) -= rzero (a); + } /* which rot */ + rbal (a) &= ~3; + a->up = u; + p->up = a; + *r = a; + } /* rot or no rot ? */ + } + else + { + /* direction == 1 */ + + if (is_lskew (a)) + unset_lskew (a); + + else + { + avl_node *u = a->up; + avl_node **r = + u != NULL ? &u->sub[a != sub_left (u)] : &t->root; + + p = a; + if (is_rskew (sub_right (p))) + { + /* rotL(p) */ + a = sub_right (p); + sub_right (p) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = p; + sub_left (a) = p; + unset_rskew (p); + rbal (a) += rzero (p); + } + else + { + /* rotRL(p) */ + a = sub_left (sub_right (p)); + sub_left (sub_right (p)) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = sub_right (p); + sub_right (p)->up = a; + sub_right (a) = sub_right (p); + sub_right (p) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = p; + sub_left (a) = p; + switch (get_bal (a)) + { + case 0: /* not skewed */ + unset_rskew (p); + unset_lskew (sub_right (a)); + break; + case 1: /* left skew */ + unset_rskew (p); + unset_lskew (sub_right (a)); + set_rskew (sub_right (a)); + break; + case 2: /* right skew */ + unset_rskew (p); + set_lskew (p); + unset_lskew (sub_right (a)); + } /* switch */ + rbal (sub_right (a)) -= rzero (a); + rbal (a) += rzero (p); + + } /* which rot */ + + rbal (a) &= ~3; + a->up = u; + p->up = a; + *r = a; + } /* rot or not rot ? */ + } /* if 0==dir */ + + /* The tree rooted at 'a' is now valid */ + /* Finish adjusting ranks */ + + while ((p = a->up) != NULL) + { + incr_rank (p, (a == sub_left (p))); + a = p; + } + + return 1; + + } /* if a != 0 */ + return 2; +} + +/* detach [p] : non-null */ + +/* only the linkage is tweaked */ + +static avl_code_t +rebalance_del (avl_node * p, avl_tree t, void **backup) +{ + avl_node **r, *a, *c; + int dir, bal; + + a = p->up; + if (a == NULL) + r = &t->root; + else + r = &a->sub[dir = p != sub_left (a)]; + + c = sub_right (p); + if (c == NULL && sub_left (p) == NULL) + *r = NULL; + else if (c == NULL || sub_left (p) == NULL) + { + *r = c != NULL ? c : sub_left (p); + (*r)->up = a; + } + else + { + if (sub_left (c) == NULL) + { + a = c; + dir = 1; + } + else + { + do + c = sub_left (c); + while (sub_left (c) != NULL); + a = c->up; + dir = 0; + sub_left (a) = sub_right (c); + if (sub_right (c) != NULL) + sub_right (c)->up = a; + sub_right (c) = sub_right (p); + sub_right (c)->up = c; + } + sub_left (c) = sub_left (p); + sub_left (c)->up = c; + c->up = p->up; + rbal (c) = rbal (p); + *r = c; + } + + backup_item (backup, p->item, t); + detach_node (p, t, NULL); + + /* Start backtracking : subtree of [a] in direction [dir] is less deep */ + + for (;; a = (*r)->up) + { + if (a == NULL) + return 2; + + decr_rank (a, !dir); + bal = get_bal (a); + + if (0 == dir) + { + if (bal == 0) + { + set_rskew (a); + break; + } + if (a->up == NULL) + r = &t->root; + else + { + dir = a != sub_left (a->up); + r = &a->up->sub[dir]; + } + if (bal & 1) + unset_lskew (a); + if (get_bal (a)) + { + p = a; + bal = get_bal (sub_right (p)); + if (!(bal & 1)) + { + /* bal = 0 or +1 */ + /* rotL(p) */ + a = sub_right (p); + sub_right (p) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = p; + sub_left (a) = p; + if (bal) + { + unset_rskew (p); + unset_rskew (a); + } + else + set_lskew (a); + rbal (a) += rzero (p); + } + else + { + /* rotRL(p) */ + a = sub_left (sub_right (p)); + sub_left (sub_right (p)) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = sub_right (p); + sub_right (p)->up = a; + sub_right (a) = sub_right (p); + sub_right (p) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = p; + sub_left (a) = p; + switch (get_bal (a)) + { + case 0: /* not skewed */ + unset_rskew (p); + unset_lskew (sub_right (a)); + break; + case 1: /* left skew */ + unset_rskew (p); + unset_lskew (sub_right (a)); + set_rskew (sub_right (a)); + break; + case 2: /* right skew */ + unset_rskew (p); + set_lskew (p); + unset_lskew (sub_right (a)); + } /* switch */ + rbal (a) &= ~3; + rbal (sub_right (a)) -= rzero (a); + rbal (a) += rzero (p); + + } /* which rot */ + + a->up = p->up; + p->up = a; + /* Done with rotation */ + *r = a; + if (bal == 0) + break; + } /* if getbal(a) */ + } + else + { + /* dir == 1 */ + + if (bal == 0) + { + set_lskew (a); + break; + } + if (a->up == NULL) + r = &t->root; + else + { + dir = a != sub_left (a->up); + r = &a->up->sub[dir]; + } + if (bal & 2) + unset_rskew (a); + if (get_bal (a)) + { + p = a; + bal = get_bal (sub_left (p)); + if (!(bal & 2)) + { + /* bal = 0 or -1 */ + /* rotR(p) */ + a = sub_left (p); + sub_left (p) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = p; + sub_right (a) = p; + if (bal) + { + unset_lskew (p); + unset_lskew (a); + } + else + set_rskew (a); + rbal (p) -= rzero (a); + } + else + { + /* rotLR(p) */ + a = sub_right (sub_left (p)); + sub_right (sub_left (p)) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = sub_left (p); + sub_left (p)->up = a; + sub_left (a) = sub_left (p); + sub_left (p) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = p; + sub_right (a) = p; + switch (get_bal (a)) + { + case 0: /* not skewed */ + unset_lskew (p); + unset_rskew (sub_left (a)); + break; + case 1: /* left skew */ + unset_lskew (p); + set_rskew (p); + unset_rskew (sub_left (a)); + break; + case 2: /* right skew */ + unset_lskew (p); + unset_rskew (sub_left (a)); + set_lskew (sub_left (a)); + } /* switch */ + rbal (a) &= ~3; + rbal (a) += rzero (sub_left (a)); + rbal (p) -= rzero (a); + } /* which rot */ + + a->up = p->up; + p->up = a; + /* Done with rotation */ + *r = a; + if (bal == 0) + break; + } /* if getbal(a) */ + } /* if dir==0 else 1 */ + } /* for */ + + /* Finish adjusting ranks */ + while ((p = a->up) != NULL) + { + decr_rank (p, (a == sub_left (p))); + a = p; + } + + return 1; +} + +void * +avl_first (avl_tree t) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return NULL; + return get_item (node_first (t->root)); +} + +void * +avl_last (avl_tree t) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return NULL; + return get_item (node_last (t->root)); +} + +void * +avl_find (const void *item, avl_tree t) +{ + avl_node *a; + +#ifndef AVL_NULLCHECKS + if (t == NULL) + return NULL; +#endif + a = node_find (item, t); + return a != NULL ? get_item (a) : NULL; +} + +/* + * Return smallest index i in [1:len] s.t. tree[i] matches [item], + * or zero if not found + */ + +avl_size_t +avl_index (const void *item, avl_tree t) +{ +#ifndef AVL_NULLCHECKS + if (item == NULL || t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return 0; + + { + avl_compare_func cmp = t->compare; + avl_node *a, *p; + avl_size_t idx = 0, n = 0; + int c; + + for (a = t->root;;) + { + c = Item_Compare (cmp, t, item, get_item (a)); + CMPERR_CHECK__INDEX (t->param); + if (!c) + idx = n + get_rank (a); + else if (c > 0) + n += get_rank (a); + p = a->sub[c > 0]; + if (p == NULL) + return idx; + a = p; + } + } +} + +/* (lo,hi) where + * lo smallest index s.t. t[lo] >= lo_item, or t->count+1 and + * hi greatest index s.t. t[hi] <= hi_item, or 0 + */ +avl_code_t +avl_span (const void *lo_item, + const void *hi_item, + avl_tree t, avl_size_t * lo_idx, avl_size_t * hi_idx) +{ + *lo_idx = t->count + 1; + *hi_idx = 0; + +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return -1; + + { + avl_compare_func cmp = t->compare; + avl_node *a; + avl_size_t n = 0; + int c; + + c = Item_Compare (cmp, t, lo_item, hi_item) > 0; + CMPERR_CHECK__SPAN (t->param); + if (c > 0) + { + const void *temp = lo_item; + + lo_item = hi_item; + hi_item = temp; + } + + a = t->root; + do + { + c = Item_Compare (cmp, t, lo_item, get_item (a)); + CMPERR_CHECK__SPAN (t->param); + if (c > 0) + { + n += get_rank (a); + a = sub_right (a); + } + else + { + *lo_idx = n + get_rank (a); + a = sub_left (a); + } + } + while (a); + + a = t->root; + do + { + c = Item_Compare (cmp, t, hi_item, get_item (a)); + CMPERR_CHECK__SPAN (t->param); + if (c < 0) + { + a = sub_left (a); + } + else + { + *hi_idx += get_rank (a); + a = sub_right (a); + } + } + while (a); + return 0; + } +} + +/* + * Find the smallest item in tree [t] that is GEQ the passed item + */ + +void * +avl_find_atleast (const void *item, avl_tree t) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return NULL; + { + avl_compare_func cmp = t->compare; + avl_node *a = t->root; + void *p = NULL; + int c; + + do + { + c = Item_Compare (cmp, t, item, get_item (a)); + CMPERR_CHECK__FIND (t->param); + if (c > 0) + { + a = sub_right (a); + } + else + { + p = get_item (a); + a = sub_left (a); + } + } + while (a); + return p; + } +} + +/* + * Find the greatest item in tree [t] that is LEQ the passed item + */ + +void * +avl_find_atmost (const void *item, avl_tree t) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return NULL; + { + avl_compare_func cmp = t->compare; + avl_node *a = t->root; + void *p = NULL; + int c; + + do + { + c = Item_Compare (cmp, t, item, get_item (a)); + CMPERR_CHECK__FIND (t->param); + if (c < 0) + { + a = sub_left (a); + } + else + { + p = get_item (a); + a = sub_right (a); + } + } + while (a); + return p; + } +} + +/* Retrieve item of index [idx] in tree [t] */ + +void * +avl_find_index (avl_size_t idx, avl_tree t) +{ + avl_node *a; + +#ifndef AVL_NULLCHECKS + if (t == NULL) + return NULL; +#endif + a = node_find_index (idx, t); + return a != NULL ? get_item (a) : NULL; +} + +#define attach_node(ptr,up,t)\ + ptr = new_node(item, up, t);\ + if (ptr == NULL){\ + AVL_SHOW_ERROR("%s\n", "couldn't allocate node");\ + return -1;\ + }\ + t->count++ + +/* Iterative insertion */ + +avl_code_t +avl_ins (void *item, avl_tree t, avl_bool_t allow_duplicates) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL) + return NULL; + { +#endif + avl_compare_func cmp = t->compare; + avl_node **r, *a; + int dir; + + for (r = &t->root, a = NULL; *r != NULL; r = &a->sub[dir = dir > 0]) + { + a = *r; + dir = Item_Compare (cmp, t, item, get_item (a)); + CMPERR_CHECK__INS (t->param); + if (!dir && !allow_duplicates) + return 0; + } + + attach_node (*r, a, t); + + return rebalance_ins (a, dir, t); + +#ifndef AVL_NULLCHECKS + } /* end if non-empty tree */ +#endif +} + +avl_code_t +avl_del (void *item, avl_tree t, void **backup) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return 0; + { + avl_node *a = node_find (item, t); + + if (a == NULL) + return CMPERR_CHECK__DEL (t->param); + return rebalance_del (a, t, backup); + } +} + +/* helper function */ +static avl_code_t +node_del_first (avl_tree t, struct ptr_handler *h) +{ + avl_node *p, *a, *c; + int bal; + + p = node_first (t->root); + a = p->up; + if (sub_right (p) != NULL) + sub_right (p)->up = a; + if (a == NULL) + t->root = sub_right (p); + else + sub_left (a) = sub_right (p); + + detach_node (p, t, h); + + /* Start backtracking : subtree of [a] in direction [0] is less deep */ + + for (;; a = c) + { + if (a == NULL) + return 2; + + decr_rank (a, 1); + bal = get_bal (a); + + if (bal == 0) + { + set_rskew (a); + break; + } + if (bal & 1) + unset_lskew (a); + c = a->up; + if (get_bal (a)) + { + p = a; + bal = get_bal (sub_right (p)); + if (!(bal & 1)) + { + /* bal = 0 or +1 */ + /* rotL(p) */ + a = sub_right (p); + sub_right (p) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = p; + sub_left (a) = p; + if (bal) + { + unset_rskew (p); + unset_rskew (a); + } + else + set_lskew (a); + rbal (a) += rzero (p); + } + else + { + /* rotRL(p) */ + a = sub_left (sub_right (p)); + sub_left (sub_right (p)) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = sub_right (p); + sub_right (p)->up = a; + sub_right (a) = sub_right (p); + sub_right (p) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = p; + sub_left (a) = p; + switch (get_bal (a)) + { + case 0: /* not skewed */ + unset_rskew (p); + unset_lskew (sub_right (a)); + break; + case 1: /* left skew */ + unset_rskew (p); + unset_lskew (sub_right (a)); + set_rskew (sub_right (a)); + break; + case 2: /* right skew */ + unset_rskew (p); + set_lskew (p); + unset_lskew (sub_right (a)); + } /* switch */ + rbal (a) &= ~3; + rbal (sub_right (a)) -= rzero (a); + rbal (a) += rzero (p); + } /* which rot */ + + a->up = p->up; + p->up = a; + /* Done with rotation */ + if (c != NULL) + sub_left (c) = a; + else + t->root = a; + if (bal == 0) + break; + } /* if getbal(a) */ + } /* for */ + + /* Finish adjusting ranks */ + while ((a = a->up) != NULL) + { + decr_rank (a, 1); + } + + return 1; +} + +/* helper function */ +static avl_code_t +node_del_last (avl_tree t, struct ptr_handler *h) +{ + + avl_node *p, *a, *c; + int bal; + + p = node_last (t->root); + a = p->up; + if (sub_left (p) != NULL) + sub_left (p)->up = a; + if (a == NULL) + t->root = sub_left (p); + else + sub_right (a) = sub_left (p); + + detach_node (p, t, h); + + /* Start backtracking : subtree of [a] in direction [1] is less deep */ + + for (;; a = c) + { + if (a == NULL) + return 2; + + bal = get_bal (a); + if (bal == 0) + { + set_lskew (a); + break; + } + if (bal & 2) + unset_rskew (a); + c = a->up; + if (get_bal (a)) + { + p = a; + bal = get_bal (sub_left (p)); + if (!(bal & 2)) + { + /* bal = 0 or -1 */ + /* rotR(p) */ + a = sub_left (p); + sub_left (p) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = p; + sub_right (a) = p; + if (bal) + { + unset_lskew (p); + unset_lskew (a); + } + else + set_rskew (a); + rbal (p) -= rzero (a); + } + else + { + /* rotLR(p) */ + a = sub_right (sub_left (p)); + sub_right (sub_left (p)) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = sub_left (p); + sub_left (p)->up = a; + sub_left (a) = sub_left (p); + sub_left (p) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = p; + sub_right (a) = p; + switch (get_bal (a)) + { + case 0: /* not skewed */ + unset_lskew (p); + unset_rskew (sub_left (a)); + break; + case 1: /* left skew */ + unset_lskew (p); + set_rskew (p); + unset_rskew (sub_left (a)); + break; + case 2: /* right skew */ + unset_lskew (p); + unset_rskew (sub_left (a)); + set_lskew (sub_left (a)); + } /* switch */ + rbal (a) &= ~3; + rbal (a) += rzero (sub_left (a)); + rbal (p) -= rzero (a); + } /* which rot */ + + a->up = p->up; + p->up = a; + /* Done with rotation */ + if (c != NULL) + sub_right (c) = a; + else + t->root = a; + if (bal == 0) + break; + } /* if getbal(a) */ + } /* for */ + + return 1; +} + +/* [p] : juncture node (zeroed out) */ + +/* [n] : rank of [p] in resulting tree */ + +/* [delta] = depth_1 - depth_0 */ + +static avl_code_t +join_left (avl_node * p, avl_node ** r0, avl_node * r1, int delta, int n) +{ + avl_node *a = NULL, **r = r0; + + if (r1 == NULL) + { + while (*r != NULL) + { + a = *r; + n -= get_rank (a); + r = &sub_right (a); + } + } + else + { + while (delta < -1) + { + a = *r; + delta += is_lskew (a) + 1; + n -= get_rank (a); + r = &sub_right (a); + } + r1->up = p; + if (*r != NULL) + (*r)->up = p; + if (delta) + set_lskew (p); + } + + /* at this point bal(*r) = -1 or 0 */ + sub_left (p) = *r; + sub_right (p) = r1; + p->up = a; + set_rank (p, n); + *r = p; + + for (;;) + { + if (a == NULL) + return 2; + if (get_bal (a)) + break; + set_rskew (a); + a = a->up; + } + + /* Rotate if need be */ + /* No (+2,0) rotation to do */ + + if (is_lskew (a)) + unset_lskew (a); + + else + { + avl_node *p = a; + + if (is_rskew (sub_right (p))) + { + /* rotL(p) */ + a = sub_right (p); + sub_right (p) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = p; + sub_left (a) = p; + unset_rskew (p); + rbal (a) += rzero (p); + } + else + { + /* rotRL(p) */ + a = sub_left (sub_right (p)); + sub_left (sub_right (p)) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = sub_right (p); + sub_right (p)->up = a; + sub_right (a) = sub_right (p); + sub_right (p) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = p; + sub_left (a) = p; + switch (get_bal (a)) + { + case 0: /* not skewed */ + unset_rskew (p); + unset_lskew (sub_right (a)); + break; + case 1: /* left skew */ + unset_rskew (p); + unset_lskew (sub_right (a)); + set_rskew (sub_right (a)); + break; + case 2: /* right skew */ + unset_rskew (p); + set_lskew (p); + unset_lskew (sub_right (a)); + } /* switch */ + rbal (sub_right (a)) -= rzero (a); + rbal (a) += rzero (p); + } /* which rot */ + + rbal (a) &= ~3; + a->up = p->up; + p->up = a; + if (a->up != NULL) + sub_right (a->up) = a; + else + *r0 = a; + } /* rot or not rot */ + + return 1; +} + +/* [p] : juncture node */ + +/* [n] : rank of [p] in resulting tree */ + +static avl_code_t +join_right (avl_node * p, avl_node * r0, avl_node ** r1, int delta, int n) +{ + avl_node *a = NULL, **r = r1; + + if (r0 == NULL) + { + while (*r != NULL) + { + a = *r; + incr_rank (a, n); + r = &sub_left (a); + } + n = 1; + } + else + { + while (delta > +1) + { + a = *r; + delta -= is_rskew (a) + 1; + incr_rank (a, n); + r = &sub_left (a); + } + r0->up = p; + if (*r != NULL) + (*r)->up = p; + if (delta) + set_rskew (p); + } + + /* at this point bal(*r) = +1 or 0 */ + sub_left (p) = r0; + sub_right (p) = *r; + set_rank (p, n); + p->up = a; + *r = p; + + for (;;) + { + if (a == NULL) + return 2; + if (get_bal (a)) + break; + set_lskew (a); + a = a->up; + } + + /* Rotate if need be */ + /* No (-2,0) rotation to do */ + + if (is_rskew (a)) + unset_rskew (a); + + else + { + avl_node *p = a; + + if (is_lskew (sub_left (p))) + { + /* rotR(p) */ + a = sub_left (p); + sub_left (p) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = p; + sub_right (a) = p; + unset_lskew (p); + rbal (p) -= rzero (a); + } + else + { + /* rotLR(p) */ + a = sub_right (sub_left (p)); + sub_right (sub_left (p)) = sub_left (a); + if (sub_left (a) != NULL) + sub_left (a)->up = sub_left (p); + sub_left (p)->up = a; + sub_left (a) = sub_left (p); + sub_left (p) = sub_right (a); + if (sub_right (a) != NULL) + sub_right (a)->up = p; + sub_right (a) = p; + switch (get_bal (a)) + { + case 0: /* not skewed */ + unset_lskew (p); + unset_rskew (sub_left (a)); + break; + case 1: /* left skew */ + unset_lskew (p); + set_rskew (p); + unset_rskew (sub_left (a)); + break; + case 2: /* right skew */ + unset_lskew (p); + unset_rskew (sub_left (a)); + set_lskew (sub_left (a)); + } /* end switch */ + rbal (a) += rzero (sub_left (a)); + rbal (p) -= rzero (a); + } /* end which rot */ + + rbal (a) &= ~3; + a->up = p->up; + p->up = a; + if (a->up != NULL) + sub_left (a->up) = a; + else + *r1 = a; + } /* end rot or not rot */ + + return 1; +} + +avl_code_t +avl_del_first (avl_tree t, void **backup) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return 0; + { + avl_code_t rv; + + if (backup == NULL) + { + rv = node_del_first (t, NULL); + } + else + { + ini_ptr_handler (h, BACKUP); + rv = node_del_first (t, &h); + *backup = h.ptr; + } + return rv; + } +} + +avl_code_t +avl_del_last (avl_tree t, void **backup) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return 0; + { + avl_code_t rv; + + if (backup == NULL) + { + rv = node_del_last (t, NULL); + } + else + { + ini_ptr_handler (h, BACKUP); + rv = node_del_last (t, &h); + *backup = h.ptr; + } + return rv; + } +} + +avl_code_t +avl_ins_index (void *item, avl_size_t idx, avl_tree t) +{ + avl_node *p; + + if (idx == 0 || t == NULL || idx > t->count + 1) + return 0; + + attach_node (p, NULL, t); + /* Note: 'attach_node' macro increments t->count */ + + if (idx == 1) + { + return join_right (p, (avl_node *) NULL, &t->root, /*delta= */ 0, 1); + } + else if (idx == t->count) + { + return + join_left (p, &t->root, (avl_node *) NULL, /*delta= */ 0, t->count); + } + else + { + avl_node *a = node_find_index (idx - 1, t); + int dir; + + if (sub_right (a) != NULL) + { + a = node_first (sub_right (a)); + sub_left (a) = p; + dir = 0; + } + else + { + sub_right (a) = p; + dir = 1; + } + + p->up = a; + return rebalance_ins (a, dir, t); + } +} + +avl_code_t +avl_del_index (avl_size_t idx, avl_tree t, void **backup) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL) + return 0; +#endif + + if (idx == 0 || idx > t->count) + return 0; + if (idx == 1) + return avl_del_first (t, backup); + if (idx == t->count) + return avl_del_last (t, backup); + { + avl_node *a = node_find_index (idx, t); + + return rebalance_del (a, t, backup); + } +} + +/* + * Outcome: [t0] handles the concatenation of [t0] and [t1] + */ + +void +avl_cat (avl_tree t0, avl_tree t1) +{ +#ifndef AVL_NULLCHECKS + if (t0 == NULL || t1 == NULL || t1->root == NULL) +#else + if (t1->root == NULL) +#endif + return; + + if (t0->root == NULL) + { + t0->root = t1->root; + t0->count = t1->count; + t1->root = NULL; + t1->count = 0; + + } + else + { + int delta = depth (t1->root) - depth (t0->root); + + ini_ptr_handler (h, DETACH); + + if (delta <= 0) + { + if (node_del_first (t1, &h) == 2) + --delta; + (void) join_left ((avl_node *) h.ptr, &t0->root, t1->root, delta, + t0->count + 1); + } + else + { + if (node_del_last (t0, &h) == 2) + ++delta; + (void) join_right ((avl_node *) h.ptr, t0->root, &t1->root, delta, + t0->count + 1); + t0->root = t1->root; + } + + t1->root = NULL; + t0->count += t1->count + 1; + t1->count = 0; + } +} + +/* + * - [t0] and [t1] are existing handles + * - See Donald Knuth, TAOCP Vol.3 "Sorting and searching" + */ + +avl_code_t +avl_split (const void *item, avl_tree t, avl_tree t0, avl_tree t1) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif /* AVL_NULLCHECKS */ + return 0; + + t0->root = NULL; + t1->root = NULL; + t0->count = 0; + t1->count = 0; + + { + avl_compare_func cmp = t->compare; + avl_node *a, *p, *sn; /* sn: split node */ + int d_, k, na, an[AVL_STACK_CAPACITY]; + + /* invariant: [na]= size of tree rooted at [a] plus one */ + + for (a = t->root, na = t->count + 1, k = 0;;) + { + d_ = Item_Compare (cmp, t, item, get_item (a)); + CMPERR_CHECK__SPLIT (t->param); + if (!d_) + break; + p = a->sub[d_ = d_ > 0]; + if (p == NULL) + return 0; + an[k++] = na; + if (d_) + na -= get_rank (a); + else + na = get_rank (a); + a = p; + } + + /* record split node */ + sn = a; + + if (k == 0) + { + t0->root = sub_left (a); + t1->root = sub_right (a); + if (t0->root != NULL) + t0->root->up = NULL; + if (t1->root != NULL) + t1->root->up = NULL; + t0->count = get_rank (a) - 1; + t1->count = t->count - get_rank (a); + } + else + { + avl_node *r[2], *rr; + int h[2], ha, hh; + avl_size_t n[2], nn; + + r[0] = sub_left (a); + r[1] = sub_right (a); + if (r[0] != NULL) + r[0]->up = NULL; + if (r[1] != NULL) + r[1]->up = NULL; + ha = depth (a); + h[0] = ha - (is_rskew (a) ? 2 : 1); + h[1] = ha - (is_lskew (a) ? 2 : 1); + n[0] = get_rank (a); /* size of r[0] plus one */ + n[1] = na - n[0]; /* size of r[1] plus one */ + + for (p = a->up, d_ = a != sub_left (p);;) + { + + a = p; /* a: juncture node */ + p = a->up; + + if (d_ == 0) + { + hh = h[1]; + ha += (is_rskew (a) ? 2 : 1); + h[1] = ha - (is_lskew (a) ? 2 : 1); + nn = n[1]; + n[1] += an[k - 1] - get_rank (a); + if (p != NULL) + d_ = a != sub_left (p); + rbal (a) = 0; + + if (h[1] >= hh) + { + rr = r[1]; + r[1] = sub_right (a); + if (r[1] != NULL) + r[1]->up = NULL; + h[1] += (2 == join_right (a, rr, r + 1, h[1] - hh, nn)); + } + else + { + h[1] = + hh + (2 == + join_left (a, r + 1, sub_right (a), h[1] - hh, + nn)); + } + } + else + { + hh = h[0]; + ha += (is_lskew (a) ? 2 : 1); + h[0] = ha - (is_rskew (a) ? 2 : 1); + nn = get_rank (a); + n[0] += nn; + if (p != NULL) + d_ = a != sub_left (p); + rbal (a) = 0; + + if (h[0] >= hh) + { + rr = r[0]; + r[0] = sub_left (a); + if (r[0] != NULL) + r[0]->up = NULL; + h[0] += (2 == join_left (a, r, rr, hh - h[0], nn)); + } + else + { + h[0] = + hh + (2 == + join_right (a, sub_left (a), r, hh - h[0], nn)); + } + } + + if (--k == 0) + break; + } /* for p */ + + t0->root = r[0]; + t1->root = r[1]; + t0->count = n[0] - 1; + t1->count = n[1] - 1; + } /* if k==0 */ + + /* Detach split node */ + detach_node (sn, t, NULL); + t->root = NULL; + t->count = 0; + + return 1; + } +} + +/* Inorder traversal */ + +void +avl_walk (avl_tree t, avl_item_func proc, void *param) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL || t->root == NULL) +#else + if (t->root == NULL) +#endif + return; + + { + avl_node *a = t->root, *p; + + while (1) + { + while (sub_left (a) != NULL) + a = sub_left (a); + + while (1) + { + (*proc) (get_item (a), param); + if (sub_right (a) != NULL) + break; + do + { + p = a; + a = p->up; + if (a == NULL) + return; + } + while (p != sub_left (a)); + } + a = sub_right (a); + } + } +} + +/* recursive helper for 'avl_slice' */ +static int +node_slice (avl_node ** root, avl_node ** cur, avl_tree tree, avl_size_t len) +{ + avl_size_t mid = len / 2; + + if (mid == 0) + { + if ((*root = new_node ((*cur)->item, /*parent */ NULL, tree)) == NULL) + return -1; + sub_left (*root) = NULL; + sub_right (*root) = NULL; + rbal (*root) = 4; + *cur = node_next (*cur); + return 0; + + } + else if ((*root = new_node (NULL, /*parent */ NULL, tree)) == NULL) + { + return -1; + } + else + { + avl_node *p = *root; + int h0, h1 = -1; + + rbal (p) = (mid + 1) << 2; + + if ((h0 = node_slice (&sub_left (p), cur, tree, mid)) < 0) + return -1; + + p->item = (*tree->copy) ((*cur)->item); + sub_left (p)->up = p; + + *cur = node_next (*cur); + + if (len -= mid + 1) + { + if ((h1 = node_slice (&sub_right (p), cur, tree, len)) < 0) + return -1; + sub_right (p)->up = p; + } + + if (h0 > h1) + set_lskew (p); + else if (h0 < h1) + { + set_rskew (p); + return 1 + h1; + } + return 1 + h0; + } +} + +/* Return a slice t[lo,hi) as a new tree */ + +avl_tree +avl_slice (avl_tree t, avl_size_t lo_idx, avl_size_t hi_idx, void *param) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL) + return NULL; +#endif /* AVL_NULLCHECKS */ + + if (lo_idx > hi_idx || lo_idx > t->count) + return NULL; + if (lo_idx < 1) + lo_idx = 1; + if (hi_idx > t->count + 1) + hi_idx = t->count + 1; + + { + avl_tree tt = avl_create (t->compare, + t->copy, + t->dispose, + t->alloc, + t->dealloc, + param); + + if (tt == NULL) + { + AVL_SHOW_ERROR ("%s\n", + "couldn't allocate new handle in avl_slice()"); + return NULL; + } + + if (lo_idx < hi_idx) + { + avl_node *cur = node_find_index (lo_idx, t); + + if (node_slice (&tt->root, &cur, t, tt->count = hi_idx - lo_idx) < 0) + { + AVL_SHOW_ERROR ("%s\n", "couldn't allocate node in avl_slice()"); + node_empty (tt); + (*t->dealloc) (tt); + return NULL; + } + tt->root->up = NULL; + } + return tt; + } +} + +/* recursive helper for 'avl_xload' */ + +static int +node_load (avl_node ** root, avl_itersource cur, void **pres, avl_tree desc, + avl_size_t len) +{ + avl_size_t mid = len / 2; + + if (mid == 0) + { + if (0 != (*cur->f) (cur, pres) + || (*root = new_node (*pres, /*parent */ NULL, desc)) == NULL) + return -1; + sub_left (*root) = NULL; + sub_right (*root) = NULL; + rbal (*root) = 4; + return 0; + + } + else if ((*root = new_node (NULL, /*parent */ NULL, desc)) == NULL) + { + return -1; + } + else + { + avl_node *p = *root; + int h0, h1 = -1; + + rbal (p) = (mid + 1) << 2; + + if ((h0 = node_load (&sub_left (p), cur, pres, desc, mid)) < 0) + return -1; + + if (0 != (*cur->f) (cur, pres)) + return -1; + + p->item = (*desc->copy) (*pres); + sub_left (p)->up = p; + + if (len -= mid + 1) + { + if ((h1 = node_load (&sub_right (p), cur, pres, desc, len)) < 0) + return -1; + sub_right (p)->up = p; + } + + if (h0 > h1) + set_lskew (p); + else if (h0 < h1) + { + set_rskew (p); + return 1 + h1; + } + return 1 + h0; + } +} + +/* Load 'len' items from itersource */ + +avl_tree +avl_xload (avl_itersource src, void **pres, avl_size_t len, avl_config conf, + void *tree_param) +{ +#ifndef AVL_NULLCHECKS + if (src == NULL) + return NULL; + { +#endif /* AVL_NULLCHECKS */ + + avl_tree tt = avl_create (conf->compare, + conf->copy, + conf->dispose, + conf->alloc, + conf->dealloc, + tree_param); + + if (tt == NULL) + { + AVL_SHOW_ERROR ("%s\n", "couldn't allocate new handle in avl_load()"); + return NULL; + } + + if (len) + { + if (node_load (&tt->root, src, pres, tt, tt->count = len) < 0) + { + AVL_SHOW_ERROR ("%s\n", "couldn't allocate node in avl_load()"); + node_empty (tt); + (*tt->dealloc) (tt); + return NULL; + } + tt->root->up = NULL; + } + return tt; +#ifndef AVL_NULLCHECKS + } +#endif +} + +#ifdef HAVE_AVL_VERIFY + +/* Verification routine */ +typedef enum +{ + okay = 0, + bad_parent = 1, + bad_rank = 2, + out_of_balance = 3, + out_of_order = 4, + diff_mismatch = 5, + count_mismatch = 6 +} +avl_verify_code; + +static avl_bool_t +avl_error (avl_verify_code err) +{ + static char *errmess[] = { + "Bad parent link", + "Rank error", + "Out of balance", + "Out of order", + "Differential mismatch", + "Count mismatch" + }; + + AVL_SHOW_ERROR ("Invalid avl_tree: %s\n", errmess[err - 1]); + return avl_false; +} + +static int bals[] = { 1, 0, 2 }; + +/* + helper for recursive 'avl_verify' function + return 0 iff okay + */ + +static avl_verify_code +node_verify (avl_node * root, avl_tree tree, int *h, avl_size_t * c, + avl_node * up) +{ + avl_verify_code err = okay; + + if (root == NULL) + *h = AVL_MIN_DEPTH, *c = 0; + else + { +#define AVL_ASSERT(expr,n) if (expr) ; else { err = n; break; } +#define CHECK(err) if (err) break + + avl_node *left, *right; + avl_size_t c_[2]; + int h_[2], delta; + + left = sub_left (root); + right = sub_right (root); + do + { + AVL_ASSERT (root->up == up, bad_parent); + CHECK (err = node_verify (left, tree, h_, c_, root)); + AVL_ASSERT (get_rank (root) == *c_ + 1, bad_rank); + CHECK (err = node_verify (right, tree, h_ + 1, c_ + 1, root)); + delta = h_[1] - h_[0]; + AVL_ASSERT (delta >= -1 && delta <= +1, out_of_balance); + AVL_ASSERT (get_bal (root) == bals[delta + 1], diff_mismatch); + AVL_ASSERT (left == NULL + || (Item_Compare (tree->compare, tree, get_item (left), + get_item (root)) <= + 0 CMPERR_CHECK__VERIFY (tree->param)), + out_of_order); + AVL_ASSERT (right == NULL + || + (Item_Compare + (tree->compare, tree, get_item (root), + get_item (right)) <= + 0 CMPERR_CHECK__VERIFY (tree->param)), out_of_order); + *h = 1 + (h_[0] > h_[1] ? h_[0] : h_[1]); + *c = 1 + c_[0] + c_[1]; + } + while (0); + } + return err; +} + +avl_bool_t +avl_verify (avl_tree t) +{ +#ifndef AVL_NULLCHECKS + if (t == NULL) + return avl_false; +#endif /* AVL_NULLCHECKS */ + { + int h; + avl_size_t c; + avl_verify_code err; + + err = node_verify (t->root, t, &h, &c, (avl_node *) NULL); + if (err) + return avl_error (err); + if (c != t->count) + return avl_error (count_mismatch); + return avl_true; + } +} +#endif /* HAVE_AVL_VERIFY */ + +/**************** + * * + * ITERATORS * + * * + ****************/ + +typedef enum +{ + AVL_ITERATOR_PRE, + AVL_ITERATOR_POST, + AVL_ITERATOR_INTREE +} +avl_status_t; + +struct avl_iterator_ +{ + avl_node *pos; + avl_tree tree; + avl_status_t status; +}; + +#define get_root(i) i->tree->root +#define is_pre(i) i->status == AVL_ITERATOR_PRE +#define is_post(i) i->status == AVL_ITERATOR_POST +#define set_pre_iterator(i) i->status = AVL_ITERATOR_PRE +#define set_post_iterator(i) i->status = AVL_ITERATOR_POST +#define set_in_iterator(i) i->status = AVL_ITERATOR_INTREE + +/* Position existing iterator [iter] at node matching [item] in its own tree, + * if it exists ; otherwise do nothing + */ + +void +avl_iterator_seek (const void *item, avl_iterator iter) +{ + avl_node *p = node_find (item, iter->tree); + + if (p != NULL) + { + set_in_iterator (iter); + iter->pos = p; + } +} + +void +avl_iterator_seek_index (avl_size_t idx, avl_iterator iter) +{ + avl_node *p = node_find_index (idx, iter->tree); + + if (p != NULL) + { + set_in_iterator (iter); + iter->pos = p; + } +} + +/* Return item pointer at current position */ + +void * +avl_iterator_cur (avl_iterator iter) +{ + return iter->pos != NULL ? get_item (iter->pos) : NULL; +} + +avl_size_t +avl_iterator_count (avl_iterator iter) +{ + return iter->tree->count; +} + +avl_size_t +avl_iterator_index (avl_iterator iter) +{ + if (iter->pos != NULL) + return get_index (iter->pos); + else if (is_pre (iter)) + return 0; + else + return iter->tree->count + 1; +} + +/* Rustic: */ + +avl_iterator +avl_iterator_new (avl_tree t, avl_ini_t ini, ...) +{ + va_list args; + avl_iterator iter = NULL; + + va_start (args, ini); + + if (t == NULL) + goto finish; + + if ((iter = (*t->alloc) (sizeof (struct avl_iterator_))) == NULL) + { + AVL_SHOW_ERROR ("%s\n", "couldn't create iterator"); + goto finish; + } + + iter->pos = NULL; + iter->tree = t; + + if (ini != AVL_ITERATOR_INI_INTREE) + { + iter->status = + (ini == AVL_ITERATOR_INI_PRE) ? AVL_ITERATOR_PRE : AVL_ITERATOR_POST; + } + else + { + const void *item = NULL; + + item = va_arg (args, const void *); + + set_pre_iterator (iter); + + if (item == NULL) + AVL_SHOW_ERROR ("%s\n", "missing argument to avl_iterator_new()"); + else + avl_iterator_seek (item, iter); + } + +finish: + va_end (args); + return iter; +} + +/* + * The following used to write to memory after it was freed. + * Corrected by: David Turner + */ +void +avl_iterator_kill (avl_iterator iter) +{ + if (iter != NULL) + { + avl_dealloc_func dealloc = iter->tree->dealloc; + iter->pos = NULL; + iter->tree = NULL; + (*dealloc) (iter); + } +} + +void * +avl_iterator_next (avl_iterator iter) +{ + avl_node *a = iter->pos; + + if (is_post (iter)) + return NULL; + + if (is_pre (iter)) + { + a = get_root (iter); + if (a != NULL) + { + a = node_first (a); + set_in_iterator (iter); + } + } + else + { + a = node_next (a); + if (a == NULL) + set_post_iterator (iter); + } + + iter->pos = a; + return a != NULL ? get_item (a) : NULL; +} + +void * +avl_iterator_prev (avl_iterator iter) +{ + avl_node *a = iter->pos; + + if (is_pre (iter)) + return NULL; + + if (is_post (iter)) + { + a = get_root (iter); + if (a != NULL) + { + a = node_last (a); + set_in_iterator (iter); + } + } + else + { + a = node_prev (a); + if (a == NULL) + set_pre_iterator (iter); + } + + iter->pos = a; + return a != NULL ? get_item (a) : NULL; +} + +/* Remove node at current position */ + +/* Move cursor to next position */ + +avl_code_t +avl_iterator_del (avl_iterator iter, void **backup) +{ + if (iter == NULL || iter->pos == NULL) + return 0; + { + avl_node *a = iter->pos, *p; + + p = node_next (a); + if (p == NULL) + set_post_iterator (iter); + iter->pos = p; + return rebalance_del (a, iter->tree, backup); + } +} diff --git a/Build/source/texk/web2c/mplibdir/avl.h b/Build/source/texk/web2c/mplibdir/avl.h new file mode 100644 index 00000000000..a78d50b91cf --- /dev/null +++ b/Build/source/texk/web2c/mplibdir/avl.h @@ -0,0 +1,467 @@ + +/* + pyavl -- HEADER FILE "avl.h" + Interface to manipulate "objects" of type 'avl_tree' and 'avl_iterator' +*/ + +#ifndef __AVL__ +#define __AVL__ + +#include +#include +#include + +#define avl_del mp_avl_del +#define avl_ins mp_avl_ins +#define avl_tree mp_avl_tree +#define avl_entry mp_avl_entry +#define avl_find mp_avl_find +#define avl_probe mp_avl_probe +#define avl_create mp_avl_create +#define avl_destroy mp_avl_destroy + +typedef enum +{ avl_false, avl_true } avl_bool_t; + +#ifndef MPW_C +#include +typedef int8_t avl_code_t; +typedef int8_t avl_bal_t; +typedef uint32_t avl_size_t; +#else +#include +typedef SInt8 avl_code_t; +typedef SInt8 avl_bal_t; +typedef UInt32 avl_size_t; +#endif + +typedef int (*avl_compare_func) (void *param, const void *lhs, + const void *rhs); +typedef void *(*avl_item_copy_func) (const void *item); +typedef void *(*avl_item_dispose_func) (void *item); +typedef void (*avl_item_func) (const void *item, void *param); +typedef void *(*avl_alloc_func) (size_t); +typedef void (*avl_dealloc_func) (void *); + +#ifdef AVL_FOR_PYTHON +#undef AVL_CMPERR +#undef AVL_NULLCHECKS +#define AVL_CMPERR 1 +#define AVL_NULLCHECKS 1 +#else +#ifndef AVL_CMPERR +#define AVL_CMPERR 0 +#endif +#ifndef AVL_NULLCHECKS +#define AVL_NULLCHECKS 0 +#endif +#endif + +#if AVL_CMPERR != 0 +extern avl_code_t avl_errcmp_occurred(void *); +#endif + +/* At minimum, shallow copy */ + +void *avl_default_item_copy(const void *); +void *avl_default_item_dispose(void *); + +#define AVL_STACK_CAPACITY 32 /* for avl_split() function */ + +typedef enum +{ + AVL_ITERATOR_INI_PRE, + AVL_ITERATOR_INI_POST, + AVL_ITERATOR_INI_INTREE +} avl_ini_t; + +typedef struct avl_tree_ *avl_tree; +typedef struct avl_iterator_ *avl_iterator; + +typedef struct avl_itersource_ avl_itersource_struct, *avl_itersource; + +struct avl_itersource_ +{ + void *p; + /* return nonzero on error */ + avl_code_t(*f) (avl_itersource from, void **to); +}; + +typedef struct +{ + avl_compare_func compare; + avl_item_copy_func copy; + avl_item_dispose_func dispose; + avl_alloc_func alloc; + avl_dealloc_func dealloc; +} avl_config_struct, *avl_config; + +/* -------------------------------------------------------------------------------------------------/ + Public Functions +---------------------------------------------------------------------------------------------------*/ + +/* + --- CREATE --- + Return a new tree and set its config. + Return NULL on allocation failure. + * 'alloc' defaults to malloc from stdlib + * 'dealloc' defaults to free from stdlib + * 'param' user param/refcon +*/ + +avl_tree avl_create(avl_compare_func compare, + avl_item_copy_func copy, + avl_item_dispose_func dispose, + avl_alloc_func alloc, + avl_dealloc_func dealloc, void *param); + +/* + --- RESET --- + Empty tree 't' as in 'avl_empty()' and modify its config. +*/ + +void +avl_reset(avl_tree t, + avl_compare_func compare, + avl_item_copy_func copy, + avl_item_dispose_func dispose, + avl_alloc_func alloc, avl_dealloc_func dealloc); + +/* + --- EMPTY --- + Empty tree 't', calling its dispose_func for each item in 't'. + The config is untouched. +*/ + +void avl_empty(avl_tree t); + +/* + --- DESTROY --- + Empty tree 't' and free the handle. +*/ + +void avl_destroy(avl_tree t); + +/* + --- DUPLICATE (COPY) --- + Return a copy of tree 't', using its copy_func for each item in 't'. + Upon failure to allocate room for some item, return NULL. +*/ + +avl_tree avl_dup(avl_tree t, void *param); + +/* + --- EMPTYNESS --- + Return 'avl_true' iff tree 't' is empty (i.e. the handle is NULL or 't' contains no item). +*/ + +avl_bool_t avl_isempty(avl_tree t); + +/* + --- SIZE --- + Return number of items contained in tree 't'. +*/ + +avl_size_t avl_size(avl_tree t); + +/* + --- FIRST (MINIMUM) --- + Return first item in in-order traversal of 't'. + Return NULL if 't' is empty. +*/ + +void *avl_first(avl_tree t); + +/* + --- LAST (MAXIMUM) --- + Return last item in in-order traversal of 't'. + Return NULL if 't' is empty. +*/ + +void *avl_last(avl_tree t); + +/* + --- FIND MATCHING ITEM --- + Find item matching 'item' parameter in tree 't'. + Return NULL if it's not found. + If there are multiple matches, the first one that is encountered + during the search is returned; it may not be the one with lowest rank. +*/ + +void *avl_find(const void *item, avl_tree t); + +/* + --- INDEX (RANK) OF ITEM --- + Return smallest index 'i' s.t. 't[i]' matches 'item', + or zero if 'item' is not found. +*/ + +avl_size_t avl_index(const void *item, avl_tree t); + +/* + --- SPAN ITEMS --- + Return integers 'i,j' s.t. 't[i,j]' + i smallest index s.t. t[i] >= lo_item, or t->count+1 and + j greatest one s.t. t[j] <= hi_item, or 0. + If 'hi_item' is less than 'lo_item' those are swapped. + Return codes: + 0 success + -1 error: tree had no root + -2 error: compare failed +*/ + +avl_code_t +avl_span(const void *lo_item, + const void *hi_item, + avl_tree t, avl_size_t * lo_idx, avl_size_t * hi_idx); + +/* + --- FIND AT LEAST --- + Return smallest item in 't' that is GEQ 'item', or NULL. +*/ + +void *avl_find_atleast(const void *item, avl_tree t); + +/* + --- FIND AT MOST --- + Return largest item in 't' that is LEQ 'item', or NULL. +*/ + +void *avl_find_atmost(const void *item, avl_tree t); + +/* + --- FIND BY INDEX (RANK) --- + Find item in 't' by index, that is return 't[idx]'. + If 'idx' is not in '[1,avl_size(t)]' then return NULL. + If a compare failed then return NULL. +*/ + +void *avl_find_index(avl_size_t idx, avl_tree t); + +/* + --- INSERTION --- + Insert 'item' in tree 't' with regard to its compare_func. + Say 'avl_ins(item,t,avl_true)' to insert 'item' in 't' + even if it is there already. + If 'item' is a duplicate and 'allow_duplicates' is avl_false, + nothing is done. + Return codes: + -1 error: allocation of new node failed + -2 error: compare failed, tree unchanged + 0 nothing was done, no error + +1 operation successful + +2 the same and height(t) increased by one. +*/ + +avl_code_t avl_ins(void *item, avl_tree t, avl_bool_t allow_duplicates); + +/* + --- DELETION --- + Remove 'item' from tree 't', calling its dispose_func. + To make a backup of 'item' involving its copy_func, + say 't(item,backup)' where 'backup' is some pointer to pointer to item. + Otherwise set it to NULL. + Return codes: + 0 item not found + -2 error: compare failed, tree unchanged + +1 operation successful + +2 the same and height(t) decreased by one. +*/ + +avl_code_t avl_del(void *item, avl_tree t, void **backup); + +/* + --- DELETE FIRST --- + Remove first item in in-order traversal from tree 't'. + Note that only one item is removed. + Return +1 or +2 as above. +*/ + +avl_code_t avl_del_first(avl_tree t, void **backup); + +/* + --- DELETE LAST --- + Remove last item in in-order traversal from tree 't'. + Note that only one item is removed. + Return +1 or +2 as above. +*/ + +avl_code_t avl_del_last(avl_tree t, void **backup); + +/* + --- INSERT IN FRONT OF INDEX --- + Insert 'item' in tree 't' so that afterwards, + 't[idx]=item' except if 'idx<=0' or 'idx>size(t)+1'. + To append 'item' to 't' regardless of order, + say 'avl_ins_index(item,size+1,t)'. +*/ + +avl_code_t avl_ins_index(void *item, avl_size_t idx, avl_tree t); + +/* + --- DELETE ITEM BY INDEX --- + Remove item of rank 'idx' from tree 't' and + return +1 or +2 as above except if 'idx' is not in + '[1,avl_size(t)]' in which case return 0. +*/ + +avl_code_t avl_del_index(avl_size_t idx, avl_tree t, void **backup); + +/* + --- IN-PLACE CONCATENATION --- + Pre-condition: 't0' and 't1' are valid avl_trees + Note that the code does not check whether the maximal item in 't0' is LEQ than + the minimal item in 't1'. + Post-condition: 't0' handles the concatenation of + 't0' and 't1' which becomes empty (but its config is untouched). +*/ + +void avl_cat(avl_tree t0, avl_tree t1); + +/* + --- SPLITTING --- + Pre-condition: 't0' and 't1' are existing handles. + Post-condition: items in 't0' all compare LEQ than 'item' + and items in 't1' all compare GEQ than 'item'. + This implementation removes one item. + Return codes: + 0 item not found, no-op + -2 compare failed, tree unchanged + +1 success +*/ + +avl_code_t avl_split(const void *item, avl_tree t, avl_tree t0, avl_tree t1); + +/* + --- IN-ORDER TRAVERSAL --- + Walk tree 't' in in-order, applying 'proc' at each node. + The 'param' pointer is passed to 'proc', like this: + '(*proc) (item_at_node,param)'. +*/ + +void avl_walk(avl_tree t, avl_item_func proc, void *param); + +/* + --- SLICE --- + Create a _new tree_ from the slice 't[lo_idx,hi_idx)' + provided 'lo_idx <= hi_idx' and these indices + are both in range. If a new tree can't be created + or if some item can't be allocated, return NULL. + Otherwise if the indices are inconsistent return NULL. +*/ + +avl_tree +avl_slice(avl_tree t, avl_size_t lo_idx, avl_size_t hi_idx, void *param); + +/* ----------------------------------------------------------/ + ITERATORS + + An iterator assigned to a tree 't' is still usable after + any item is inserted into 't' and after any item + not located at this iterator's current position is + deleted. The 'avl_iterator_del()' function may be used + to remove the item at the iterator's current position. +------------------------------------------------------------*/ + +/* + --- ITERATOR --- SEEK + Find 'item' in this iterator's tree as in 'avl_find()' + and make it the current position. +*/ + +void avl_iterator_seek(const void *item, avl_iterator iter); + +/* + --- ITERATOR --- COUNT + Return size of this iterator's tree +*/ + +avl_size_t avl_iterator_count(avl_iterator iter); + +/* + --- ITERATOR --- SEEK BY INDEX + Set the current position of 'iter' to 't[idx]' + where 't' is the tree that is iterated over. +*/ + +void avl_iterator_seek_index(avl_size_t idx, avl_iterator iter); + +/* + --- ITERATOR --- CURRENT POSITION + Return item at current position of 'iter'. +*/ + +void *avl_iterator_cur(avl_iterator iter); + +/* + --- ITERATOR --- INDEX + Return rank of current item of 'iter' (as a result of computation) + except it returns 0 or size of tree plus one if 'iter' is a pre- or post- iterator. +*/ + +avl_size_t avl_iterator_index(avl_iterator iter); + +/* + --- ITERATOR --- CREATE + Return a new cursor for tree 't'. + If allocation of an iterator struct is impossible, return NULL. + Say 'avl_iterator_new(t, ini)' with 'ini==AVL_ITERATOR_INI_PRE' or 'ini==AVL_ITERATOR_INI_POST' + or say 'avl_iterator_new(t, AVL_ITERATOR_INI_INTREE, item_pointer)' + to set the iterator's current position via 'avl_iterator_seek(item_pointer,the_iterator)'. + In the latter case, the iterator is flagged + as pre-iterator if the item is not found. +*/ + +avl_iterator avl_iterator_new(avl_tree t, avl_ini_t ini, ...); + +/* + --- ITERATOR --- KILL + Cleanup: free the iterator struct. +*/ + +void avl_iterator_kill(avl_iterator iter); + +/* + --- ITERATOR --- SUCCESSOR + Get next item pointer in iterator or NULL. + 'iter' is flagged as post-iterator if it's in post-position. +*/ + +void *avl_iterator_next(avl_iterator iter); + +/* + --- ITERATOR --- PREDECESSOR + Get next item pointer in iterator or NULL. + 'iter' is flagged as pre-iterator if it's in pre-position. +*/ + +void *avl_iterator_prev(avl_iterator iter); + +/* + --- ITERATOR --- DELETION + Remove item at current position of iterator 'iter' from its tree, if there is one. + Current position is set to next item or iterator is flagged as post-iterator. +*/ + +avl_code_t avl_iterator_del(avl_iterator iter, void **backup); + +/* + --- VERIFICATION --- + Return avl_true iff 't' is a valid avl_tree. + Note that 'avl_verify(NULL)==avl_false'. +*/ + +#ifdef HAVE_AVL_VERIFY +avl_bool_t avl_verify(avl_tree t); +#endif /* HAVE_AVL_VERIFY */ + +/* + --- LOAD --- + More general version of avl_slice +*/ + +avl_tree +avl_xload(avl_itersource src, + void **pres, avl_size_t len, avl_config conf, void *param); + +#endif /* __AVL__ */ diff --git a/Build/source/texk/web2c/mplibdir/lmplib.c b/Build/source/texk/web2c/mplibdir/lmplib.c new file mode 100644 index 00000000000..8e0823ece06 --- /dev/null +++ b/Build/source/texk/web2c/mplibdir/lmplib.c @@ -0,0 +1,1238 @@ +/* lmplib.c + + Copyright 2006-2008 Taco Hoekwater + + This file is part of LuaTeX. + + LuaTeX is free software; you can redistribute it and/or modify it under + the terms of the GNU Lesser General Public License as published by the Free + Software Foundation; either version 3 of the License, or (at your + option) any later version. + + LuaTeX is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public + License for more details. + + You should have received a copy of the GNU Lesser General Public License along + with LuaTeX; if not, see . */ + +#include "config.h" +#include +#include +#include +#include /* temporary */ + +#ifndef pdfTeX +# include +# include +# include +#else +# include <../lua51/lua.h> +# include <../lua51/lauxlib.h> +# include <../lua51/lualib.h> +#endif + +#include "mplib.h" +#include "mplibps.h" + + /*@unused@*/ static const char _svn_version[] = + "$Id: lmplib.c 1364 2008-07-04 16:09:46Z taco $ $URL: http://scm.foundry.supelec.fr/svn/luatex/trunk/src/texk/web2c/luatexdir/lua/lmplib.c $"; + +/* metatable identifiers and tests */ + +#define MPLIB_METATABLE "MPlib" +#define MPLIB_FIG_METATABLE "MPlib.fig" +#define MPLIB_GR_METATABLE "MPlib.gr" + +#define is_mp(L,b) (MP *)luaL_checkudata(L,b,MPLIB_METATABLE) +#define is_fig(L,b) (struct mp_edge_object **)luaL_checkudata(L,b,MPLIB_FIG_METATABLE) +#define is_gr_object(L,b) (struct mp_graphic_object **)luaL_checkudata(L,b,MPLIB_GR_METATABLE) + +/* Lua string pre-hashing */ + +#define mplib_init_S(a) do { \ + lua_pushliteral(L,#a); \ + mplib_##a##_ptr = (char *)lua_tostring(L,-1); \ + mplib_##a##_index = luaL_ref (L,LUA_REGISTRYINDEX); \ + } while (0) + +#define mplib_push_S(a) do { \ + lua_rawgeti(L,LUA_REGISTRYINDEX,mplib_##a##_index); \ + } while (0) + +#define mplib_is_S(a,i) (mplib_##a##_ptr==(char *)lua_tostring(L,i)) + +#define mplib_make_S(a) \ + static int mplib_##a##_index = 0; \ + static char *mplib_##a##_ptr = NULL + +static int mplib_type_Ses[mp_special_code + 1] = { 0 }; /* [0] is not used */ + +mplib_make_S(fill); +mplib_make_S(outline); +mplib_make_S(text); +mplib_make_S(special); +mplib_make_S(start_bounds); +mplib_make_S(stop_bounds); +mplib_make_S(start_clip); +mplib_make_S(stop_clip); + +mplib_make_S(left_type); +mplib_make_S(right_type); +mplib_make_S(x_coord); +mplib_make_S(y_coord); +mplib_make_S(left_x); +mplib_make_S(left_y); +mplib_make_S(right_x); +mplib_make_S(right_y); + +mplib_make_S(color); +mplib_make_S(dash); +mplib_make_S(depth); +mplib_make_S(dsize); +mplib_make_S(font); +mplib_make_S(height); +mplib_make_S(htap); +mplib_make_S(linecap); +mplib_make_S(linejoin); +mplib_make_S(miterlimit); +mplib_make_S(path); +mplib_make_S(pen); +mplib_make_S(postscript); +mplib_make_S(prescript); +mplib_make_S(transform); +mplib_make_S(type); +mplib_make_S(width); + +static void mplib_init_Ses(lua_State * L) +{ + mplib_init_S(fill); + mplib_init_S(outline); + mplib_init_S(text); + mplib_init_S(start_bounds); + mplib_init_S(stop_bounds); + mplib_init_S(start_clip); + mplib_init_S(stop_clip); + mplib_init_S(special); + + mplib_type_Ses[mp_fill_code] = mplib_fill_index; + mplib_type_Ses[mp_stroked_code] = mplib_outline_index; + mplib_type_Ses[mp_text_code] = mplib_text_index; + mplib_type_Ses[mp_start_bounds_code] = mplib_start_bounds_index; + mplib_type_Ses[mp_stop_bounds_code] = mplib_stop_bounds_index; + mplib_type_Ses[mp_start_clip_code] = mplib_start_clip_index; + mplib_type_Ses[mp_stop_clip_code] = mplib_stop_clip_index; + mplib_type_Ses[mp_special_code] = mplib_special_index; + + mplib_init_S(left_type); + mplib_init_S(right_type); + mplib_init_S(x_coord); + mplib_init_S(y_coord); + mplib_init_S(left_x); + mplib_init_S(left_y); + mplib_init_S(right_x); + mplib_init_S(right_y); + + mplib_init_S(color); + mplib_init_S(dash); + mplib_init_S(depth); + mplib_init_S(dsize); + mplib_init_S(font); + mplib_init_S(height); + mplib_init_S(htap); + mplib_init_S(linecap); + mplib_init_S(linejoin); + mplib_init_S(miterlimit); + mplib_init_S(path); + mplib_init_S(pen); + mplib_init_S(postscript); + mplib_init_S(prescript); + mplib_init_S(transform); + mplib_init_S(type); + mplib_init_S(width); +} + + +/* Enumeration arrays to map MPlib enums to Lua strings */ + +static const char *interaction_options[] = + { "unknown", "batch", "nonstop", "scroll", "errorstop", NULL }; + +static const char *mplib_filetype_names[] = + { "term", "error", "mp", "log", "ps", "mem", "tfm", "map", "pfb", "enc", NULL }; + +static const char *knot_type_enum[] = + { "endpoint", "explicit", "given", "curl", "open", "end_cycle" }; + +static const char *fill_fields[] = + { "type", "path", "htap", "pen", "color", "linejoin", "miterlimit", + "prescript", "postscript", NULL }; + +static const char *stroked_fields[] = + { "type", "path", "pen", "color", "linejoin", "miterlimit", "linecap", + "dash", "prescript", "postscript", NULL }; + +static const char *text_fields[] = + { "type", "text", "dsize", "font", "color", "width", "height", "depth", + "transform", "prescript", "postscript", NULL }; + +static const char *special_fields[] = + { "type", "prescript", NULL }; + +static const char *start_bounds_fields[] = + { "type", "path", NULL }; + +static const char *start_clip_fields[] = + { "type", "path", NULL }; + +static const char *stop_bounds_fields[] = + { "type", NULL }; + +static const char *stop_clip_fields[] = + { "type", NULL }; + +static const char *no_fields[] = + { NULL }; + + +/* The list of supported MPlib options (not all make sense) */ + +typedef enum { + P_ERROR_LINE, P_MAX_LINE, + P_MAIN_MEMORY, P_HASH_SIZE, P_PARAM_SIZE, P_IN_OPEN, P_RANDOM_SEED, + P_INTERACTION, P_INI_VERSION, P_MEM_NAME, P_JOB_NAME, P_FIND_FILE, + P__SENTINEL } mplib_parm_idx; + +typedef struct { + const char *name; /* parameter name */ + mplib_parm_idx idx; /* parameter index */ +} mplib_parm_struct; + +static mplib_parm_struct mplib_parms[] = { + {"error_line", P_ERROR_LINE }, + {"print_line", P_MAX_LINE }, + {"main_memory", P_MAIN_MEMORY }, + {"hash_size", P_HASH_SIZE }, + {"param_size", P_PARAM_SIZE }, + {"max_in_open", P_IN_OPEN }, + {"random_seed", P_RANDOM_SEED }, + {"interaction", P_INTERACTION }, + {"ini_version", P_INI_VERSION }, + {"mem_name", P_MEM_NAME }, + {"job_name", P_JOB_NAME }, + {"find_file", P_FIND_FILE }, + {NULL, P__SENTINEL } +}; + + +/* Start by defining the needed callback routines for the library */ + +static char *mplib_find_file(MP mp, const char *fname, const char *fmode, int ftype) +{ + lua_State *L = (lua_State *)mp_userdata(mp); + lua_checkstack(L, 4); + lua_getfield(L, LUA_REGISTRYINDEX, "mplib_file_finder"); + if (lua_isfunction(L, -1)) { + char *s = NULL, *x = NULL; + lua_pushstring(L, fname); + lua_pushstring(L, fmode); + if (ftype >= mp_filetype_text) { + lua_pushnumber(L, (lua_Number)(ftype - mp_filetype_text)); + } else { + lua_pushstring(L, mplib_filetype_names[ftype]); + } + if (lua_pcall(L, 3, 1, 0) != 0) { + fprintf(stdout, "Error in mp.find_file: %s\n", + (char *) lua_tostring(L, -1)); + return NULL; + } + x = (char *) lua_tostring(L, -1); + if (x != NULL) + s = strdup(x); + lua_pop(L, 1); /* pop the string */ + return s; + } else { + lua_pop(L, 1); + } + if (fmode[0] != 'r' || (!access(fname, R_OK)) || ftype) { + return strdup(fname); + } + return NULL; +} + +static int mplib_find_file_function(lua_State * L) +{ + if (!(lua_isfunction(L, -1) || lua_isnil(L, -1))) { + return 1; /* error */ + } + lua_pushstring(L, "mplib_file_finder"); + lua_pushvalue(L, -2); + lua_rawset(L, LUA_REGISTRYINDEX); + return 0; +} + +#define xfree(A) if ((A)!=NULL) { free((A)); A = NULL; } + +static int mplib_new(lua_State * L) +{ + MP *mp_ptr; + mp_ptr = lua_newuserdata(L, sizeof(MP *)); + if (mp_ptr) { + int i; + struct MP_options *options = mp_options(); + options->userdata = (void *) L; + options->noninteractive = 1; /* required ! */ + options->find_file = mplib_find_file; + options->print_found_names = 1; + if (lua_type(L, 1) == LUA_TTABLE) { + for (i = 0; mplib_parms[i].name != NULL; i++) { + lua_getfield(L, 1, mplib_parms[i].name); + if (lua_isnil(L, -1)) { + lua_pop(L, 1); + continue; /* skip unset */ + } + switch (mplib_parms[i].idx) { + case P_ERROR_LINE: + options->error_line = (int)lua_tointeger(L, -1); + if (options->error_line<60) options->error_line =60; + if (options->error_line>250) options->error_line = 250; + options->half_error_line = (options->error_line/2)+10; + break; + case P_MAX_LINE: + options->max_print_line = (int)lua_tointeger(L, -1); + if (options->max_print_line<60) options->max_print_line = 60; + break; + case P_MAIN_MEMORY: + options->main_memory = (int)lua_tointeger(L, -1); + break; + case P_HASH_SIZE: + options->hash_size = (unsigned)lua_tointeger(L, -1); + break; + case P_PARAM_SIZE: + options->param_size = (int)lua_tointeger(L, -1); + break; + case P_IN_OPEN: + options->max_in_open = (int)lua_tointeger(L, -1); + break; + case P_RANDOM_SEED: + options->random_seed = (int)lua_tointeger(L, -1); + break; + case P_INTERACTION: + options->interaction = + luaL_checkoption(L, -1, "errorstopmode", + interaction_options); + break; + case P_INI_VERSION: + options->ini_version = lua_toboolean(L, -1); + break; + case P_MEM_NAME: + options->mem_name = strdup((char *) lua_tostring(L, -1)); + break; + case P_JOB_NAME: + options->job_name = strdup((char *) lua_tostring(L, -1)); + break; + case P_FIND_FILE: + if (mplib_find_file_function(L)) { /* error here */ + fprintf(stdout, + "Invalid arguments to mp.new({find_file=...})\n"); + } + break; + default: + break; + } + lua_pop(L, 1); + } + } + *mp_ptr = mp_initialize(options); + xfree(options->command_line); + xfree(options->mem_name); + free(options); + if (*mp_ptr) { + luaL_getmetatable(L, MPLIB_METATABLE); + lua_setmetatable(L, -2); + return 1; + } + } + lua_pushnil(L); + return 1; +} + +static int mplib_collect(lua_State * L) +{ + MP *mp_ptr = is_mp(L, 1); + if (*mp_ptr != NULL) { + (void)mp_finish(*mp_ptr); + *mp_ptr = NULL; + } + return 0; +} + +static int mplib_tostring(lua_State * L) +{ + MP *mp_ptr = is_mp(L, 1); + if (*mp_ptr != NULL) { + (void)lua_pushfstring(L, "", *mp_ptr); + return 1; + } + return 0; +} + +static int mplib_wrapresults(lua_State * L, mp_run_data *res, int status) +{ + lua_checkstack(L, 5); + lua_newtable(L); + if (res->term_out.size != 0) { + lua_pushstring(L, res->term_out.data); + lua_setfield(L, -2, "term"); + } + if (res->error_out.size != 0) { + lua_pushstring(L, res->error_out.data); + lua_setfield(L, -2, "error"); + } + if (res->log_out.size != 0) { + lua_pushstring(L, res->log_out.data); + lua_setfield(L, -2, "log"); + } + if (res->edges != NULL) { + struct mp_edge_object **v; + struct mp_edge_object *p = res->edges; + int i = 1; + lua_newtable(L); + while (p != NULL) { + v = lua_newuserdata(L, sizeof(struct mp_edge_object *)); + *v = p; + luaL_getmetatable(L, MPLIB_FIG_METATABLE); + lua_setmetatable(L, -2); + lua_rawseti(L, -2, i); + i++; + p = p->next; + } + lua_setfield(L, -2, "fig"); + res->edges = NULL; + } + lua_pushnumber(L, (lua_Number)status); + lua_setfield(L, -2, "status"); + return 1; +} + +static int mplib_execute(lua_State * L) +{ + MP *mp_ptr = is_mp(L, 1); + if (*mp_ptr != NULL && lua_isstring(L, 2)) { + size_t l; + char *s = (char *) lua_tolstring(L, 2, &l); + int h = mp_execute(*mp_ptr, s, l); + mp_run_data *res = mp_rundata(*mp_ptr); + return mplib_wrapresults(L, res, h); + } else { + lua_pushnil(L); + } + return 1; +} + +static int mplib_finish(lua_State * L) +{ + MP *mp_ptr = is_mp(L, 1); + if (*mp_ptr != NULL) { + int i; + int h = mp_execute(*mp_ptr,NULL,0); + mp_run_data *res = mp_rundata(*mp_ptr); + i = mplib_wrapresults(L, res, h); + (void)mp_finish(*mp_ptr); + *mp_ptr = NULL; + return i; + } else { + lua_pushnil(L); + } + return 1; +} + +static int mplib_char_dimension(lua_State * L, int t) +{ + MP *mp_ptr = is_mp(L, 1); + if (*mp_ptr != NULL) { + char *fname = (char *)luaL_checkstring(L,2); + int charnum = (int)luaL_checkinteger(L,3); + if (charnum<0 || charnum>255) { + lua_pushnumber(L, (lua_Number)0); + } else { + lua_pushnumber(L,(lua_Number)mp_get_char_dimension(*mp_ptr,fname,charnum,t)); + } + } else { + lua_pushnumber(L, (lua_Number)0); + } + return 1; +} + +static int mplib_charwidth(lua_State * L) +{ + return mplib_char_dimension(L, 'w'); +} + +static int mplib_chardepth(lua_State * L) +{ + return mplib_char_dimension(L, 'd'); +} + +static int mplib_charheight(lua_State * L) +{ + return mplib_char_dimension(L, 'h'); +} + +static int mplib_version(lua_State * L) +{ + char *s = mp_metapost_version(); + lua_pushstring(L, s); + free(s); + return 1; +} + +static int mplib_statistics(lua_State * L) +{ + MP *mp_ptr = is_mp(L, 1); + if (*mp_ptr != NULL) { + lua_newtable(L); + lua_pushnumber(L, (lua_Number)mp_memory_usage(*mp_ptr)); + lua_setfield(L, -2, "main_memory"); + lua_pushnumber(L, (lua_Number)mp_hash_usage(*mp_ptr)); + lua_setfield(L, -2, "hash_size"); + lua_pushnumber(L, (lua_Number)mp_param_usage(*mp_ptr)); + lua_setfield(L, -2, "param_size"); + lua_pushnumber(L, (lua_Number)mp_open_usage(*mp_ptr)); + lua_setfield(L, -2, "max_in_open"); + } else { + lua_pushnil(L); + } + return 1; +} + + +/* figure methods */ + +static int mplib_fig_collect(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + if (*hh != NULL) { + mp_gr_toss_objects(*hh); + *hh = NULL; + } + return 0; +} + +static int mplib_fig_body(lua_State * L) +{ + int i = 1; + struct mp_graphic_object **v; + struct mp_graphic_object *p; + struct mp_edge_object **hh = is_fig(L, 1); + lua_newtable(L); + p = (*hh)->body; + while (p != NULL) { + v = lua_newuserdata(L, sizeof(struct mp_graphic_object *)); + *v = p; + luaL_getmetatable(L, MPLIB_GR_METATABLE); + lua_setmetatable(L, -2); + lua_rawseti(L, -2, i); + i++; + p = p->next; + } + (*hh)->body = NULL; /* prevent double free */ + return 1; +} + +static int mplib_fig_copy_body(lua_State * L) +{ + int i = 1; + struct mp_graphic_object **v; + struct mp_graphic_object *p; + struct mp_edge_object **hh = is_fig(L, 1); + lua_newtable(L); + p = (*hh)->body; + while (p != NULL) { + v = lua_newuserdata(L, sizeof(struct mp_graphic_object *)); + *v = mp_gr_copy_object((*hh)->parent, p); + luaL_getmetatable(L, MPLIB_GR_METATABLE); + lua_setmetatable(L, -2); + lua_rawseti(L, -2, i); + i++; + p = p->next; + } + return 1; +} + + +static int mplib_fig_tostring(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + (void)lua_pushfstring(L, "
", *hh); + return 1; +} + +static int mplib_fig_postscript(lua_State * L) +{ + mp_run_data *res; + struct mp_edge_object **hh = is_fig(L, 1); + int prologues = (int)luaL_optnumber(L, 2, (lua_Number)-1); + int procset = (int)luaL_optnumber(L, 3, (lua_Number)-1); + if (mp_ps_ship_out(*hh, prologues, procset) + && (res = mp_rundata((*hh)->parent)) + && (res->ps_out.size != 0)) { + lua_pushstring(L, res->ps_out.data); + } else { + lua_pushnil(L); + } + return 1; +} + +static int mplib_fig_filename(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + if (*hh != NULL) { + char *s = (*hh)->filename; + lua_pushstring(L, s); + } else { + lua_pushnil(L); + } + return 1; +} + +static int mplib_fig_width(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + if (*hh != NULL) { + lua_pushnumber(L, (double) (*hh)->width / 65536.0); + } else { + lua_pushnil(L); + } + return 1; +} + +static int mplib_fig_height(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + if (*hh != NULL) { + lua_pushnumber(L, (double) (*hh)->height / 65536.0); + } else { + lua_pushnil(L); + } + return 1; +} + +static int mplib_fig_depth(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + if (*hh != NULL) { + lua_pushnumber(L, (double) (*hh)->depth / 65536.0); + } else { + lua_pushnil(L); + } + return 1; +} + +static int mplib_fig_italcorr(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + if (*hh != NULL) { + lua_pushnumber(L, (double) (*hh)->ital_corr / 65536.0); + } else { + lua_pushnil(L); + } + return 1; +} + +static int mplib_fig_charcode(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + if (*hh != NULL) { + lua_pushnumber(L, (lua_Number)(*hh)->charcode); + } else { + lua_pushnil(L); + } + return 1; +} + + + +static int mplib_fig_bb(lua_State * L) +{ + struct mp_edge_object **hh = is_fig(L, 1); + lua_newtable(L); + lua_pushnumber(L, (double) (*hh)->minx / 65536.0); + lua_rawseti(L, -2, 1); + lua_pushnumber(L, (double) (*hh)->miny / 65536.0); + lua_rawseti(L, -2, 2); + lua_pushnumber(L, (double) (*hh)->maxx / 65536.0); + lua_rawseti(L, -2, 3); + lua_pushnumber(L, (double) (*hh)->maxy / 65536.0); + lua_rawseti(L, -2, 4); + return 1; +} + +/* object methods */ + +static int mplib_gr_collect(lua_State * L) +{ + struct mp_graphic_object **hh = is_gr_object(L, 1); + if (*hh != NULL) { + mp_gr_toss_object(*hh); + *hh = NULL; + } + return 0; +} + +static int mplib_gr_tostring(lua_State * L) +{ + struct mp_graphic_object **hh = is_gr_object(L, 1); + (void)lua_pushfstring(L, "", *hh); + return 1; +} + +#define pyth(a,b) (sqrt((a)*(a) + (b)*(b))) + +#define aspect_bound (10.0/65536.0) +#define aspect_default (1.0/65536.0) + +static double eps = 0.0001; + +static double coord_range_x (mp_knot *h, double dz) { + double z; + double zlo = 0.0, zhi = 0.0; + mp_knot *f = h; + while (h != NULL) { + z = (double)h->x_coord; + if (z < zlo) zlo = z; else if (z > zhi) zhi = z; + z = (double)h->right_x; + if (z < zlo) zlo = z; else if (z > zhi) zhi = z; + z = (double)h->left_x; + if (z < zlo) zlo = z; else if (z > zhi) zhi = z; + h = h->next; + if (h==f) + break; + } + return (zhi - zlo <= dz ? aspect_bound : aspect_default); +} + +static double coord_range_y (mp_knot *h, double dz) { + double z; + double zlo = 0.0, zhi = 0.0; + mp_knot *f = h; + while (h != NULL) { + z = (double)h->y_coord; + if (z < zlo) zlo = z; else if (z > zhi) zhi = z; + z = (double)h->right_y; + if (z < zlo) zlo = z; else if (z > zhi) zhi = z; + z = (double)h->left_y; + if (z < zlo) zlo = z; else if (z > zhi) zhi = z; + h = h->next; + if (h==f) + break; + } + return (zhi - zlo <= dz ? aspect_bound : aspect_default); +} + + +static int mplib_gr_peninfo(lua_State * L) { + double x_coord, y_coord, left_x, left_y, right_x, right_y; + double wx, wy; + double rx = 1.0, sx = 0.0, sy = 0.0, ry = 1.0, tx = 0.0, ty = 0.0; + double divider = 1.0; + double width = 1.0; + mp_knot *p = NULL, *path = NULL; + struct mp_graphic_object **hh = is_gr_object(L, -1); + if (!*hh) { + lua_pushnil(L); + return 1; + } + if ((*hh)->type == mp_fill_code) { + p = ((mp_fill_object *)(*hh))->pen_p; + path = ((mp_fill_object *)(*hh))->path_p; + } else if ((*hh)->type == mp_stroked_code) { + p = ((mp_stroked_object *)(*hh))->pen_p; + path = ((mp_stroked_object *)(*hh))->path_p; + } + if (p==NULL || path == NULL) { + lua_pushnil(L); + return 1; + } + x_coord = p->x_coord/65536.0; + y_coord = p->y_coord/65536.0; + left_x = p->left_x/65536.0; + left_y = p->left_y/65536.0; + right_x = p->right_x/65536.0; + right_y = p->right_y/65536.0; + if ((right_x == x_coord) && (left_y == y_coord)) { + wx = fabs(left_x - x_coord); + wy = fabs(right_y - y_coord); + } else { + wx = pyth(left_x - x_coord, right_x - x_coord); + wy = pyth(left_y - y_coord, right_y - y_coord); + } + if ((wy/coord_range_x(path, wx)) >= (wx/coord_range_y(path, wy))) + width = wy; + else + width = wx; + tx = x_coord; + ty = y_coord; + sx = left_x - tx; + rx = left_y - ty; + ry = right_x - tx; + sy = right_y - ty; + if (width !=1.0) { + if (width == 0.0) { + sx = 1.0; sy = 1.0; + } else { + rx/=width; ry/=width; sx/=width; sy/=width; + } + } + if (fabs(sx) < eps) sx = eps; + if (fabs(sy) < eps) sy = eps; + divider = sx*sy - rx*ry; + lua_newtable(L); + lua_pushnumber(L,width); lua_setfield(L,-2,"width"); + lua_pushnumber(L,rx); lua_setfield(L,-2,"rx"); + lua_pushnumber(L,sx); lua_setfield(L,-2,"sx"); + lua_pushnumber(L,sy); lua_setfield(L,-2,"sy"); + lua_pushnumber(L,ry); lua_setfield(L,-2,"ry"); + lua_pushnumber(L,tx); lua_setfield(L,-2,"tx"); + lua_pushnumber(L,ty); lua_setfield(L,-2,"ty"); + return 1; +} + + +static int mplib_gr_fields(lua_State * L) +{ + const char **fields; + int i; + struct mp_graphic_object **hh = is_gr_object(L, 1); + if (*hh) { + switch ((*hh)->type) { + case mp_fill_code: + fields = fill_fields; + break; + case mp_stroked_code: + fields = stroked_fields; + break; + case mp_text_code: + fields = text_fields; + break; + case mp_special_code: + fields = special_fields; + break; + case mp_start_clip_code: + fields = start_clip_fields; + break; + case mp_start_bounds_code: + fields = start_bounds_fields; + break; + case mp_stop_clip_code: + fields = stop_clip_fields; + break; + case mp_stop_bounds_code: + fields = stop_bounds_fields; + break; + default: + fields = no_fields; + } + lua_newtable(L); + for (i = 0; fields[i] != NULL; i++) { + lua_pushstring(L, fields[i]); + lua_rawseti(L, -2, (i + 1)); + } + } else { + lua_pushnil(L); + } + return 1; +} + + +#define mplib_push_number(L,x) lua_pushnumber(L,(lua_Number)(x)/65536.0) + +#define MPLIB_PATH 0 +#define MPLIB_PEN 1 + +static void mplib_push_path(lua_State * L, struct mp_knot *h, int is_pen) +{ + struct mp_knot *p; /* for scanning the path */ + int i = 1; + p = h; + if (p != NULL) { + lua_newtable(L); + do { + lua_createtable(L, 0, 6); + if (!is_pen) { + if (p->left_type != mp_explicit) { + mplib_push_S(left_type); + lua_pushstring(L, knot_type_enum[p->left_type]); + lua_rawset(L, -3); + } + if (p->right_type != mp_explicit) { + mplib_push_S(right_type); + lua_pushstring(L, knot_type_enum[p->right_type]); + lua_rawset(L, -3); + } + } + mplib_push_S(x_coord); + mplib_push_number(L, p->x_coord); + lua_rawset(L, -3); + mplib_push_S(y_coord); + mplib_push_number(L, p->y_coord); + lua_rawset(L, -3); + mplib_push_S(left_x); + mplib_push_number(L, p->left_x); + lua_rawset(L, -3); + mplib_push_S(left_y); + mplib_push_number(L, p->left_y); + lua_rawset(L, -3); + mplib_push_S(right_x); + mplib_push_number(L, p->right_x); + lua_rawset(L, -3); + mplib_push_S(right_y); + mplib_push_number(L, p->right_y); + lua_rawset(L, -3); + lua_rawseti(L, -2, i); + i++; + if (p->right_type == mp_endpoint) { + return; + } + p = p->next; + } while (p != h); + } else { + lua_pushnil(L); + } +} + +/* this assumes that the top of the stack is a table + or nil already in the case + */ +static void mplib_push_pentype(lua_State * L, struct mp_knot *h) +{ + struct mp_knot *p; /* for scanning the path */ + p = h; + if (p == NULL) { + /* do nothing */ + } else if (p == p->next) { + mplib_push_S(type); + lua_pushstring(L, "elliptical"); + lua_rawset(L, -3); + } else { + } +} + +#define set_color_objects(pq) \ + object_color_model = pq->color_model; \ + object_color_a = pq->color.a_val; \ + object_color_b = pq->color.b_val; \ + object_color_c = pq->color.c_val; \ + object_color_d = pq->color.d_val; + + +static void mplib_push_color(lua_State * L, struct mp_graphic_object *p) +{ + int object_color_model; + int object_color_a, object_color_b, object_color_c, object_color_d; + if (p != NULL) { + if (p->type == mp_fill_code) { + mp_fill_object *h = (mp_fill_object *) p; + set_color_objects(h); + } else if (p->type == mp_stroked_code) { + mp_stroked_object *h = (mp_stroked_object *) p; + set_color_objects(h); + } else { + mp_text_object *h = (mp_text_object *) p; + set_color_objects(h); + } + lua_newtable(L); + if (object_color_model >= mp_grey_model) { + mplib_push_number(L, object_color_a); + lua_rawseti(L, -2, 1); + if (object_color_model >= mp_rgb_model) { + mplib_push_number(L, object_color_b); + lua_rawseti(L, -2, 2); + mplib_push_number(L, object_color_c); + lua_rawseti(L, -2, 3); + if (object_color_model == mp_cmyk_model) { + mplib_push_number(L, object_color_d); + lua_rawseti(L, -2, 4); + } + } + } + } else { + lua_pushnil(L); + } +} + +/* the dash scale is not exported, the field has no external value */ +static void mplib_push_dash(lua_State * L, struct mp_stroked_object *h) +{ + mp_dash_object *d; + double ds; + if (h != NULL && h->dash_p != NULL) { + d = h->dash_p; + lua_newtable(L); + mplib_push_number(L, d->offset); + lua_setfield(L, -2, "offset"); + if (d->array != NULL) { + int i = 0; + lua_newtable(L); + while (*(d->array + i) != -1) { + ds = *(d->array + i) / 65536.0; + lua_pushnumber(L, ds); + i++; + lua_rawseti(L, -2, i); + } + lua_setfield(L, -2, "dashes"); + } + } else { + lua_pushnil(L); + } +} + +static void mplib_push_transform(lua_State * L, struct mp_text_object *h) +{ + int i = 1; + if (h != NULL) { + lua_createtable(L, 6, 0); + mplib_push_number(L, h->tx); + lua_rawseti(L, -2, i); + i++; + mplib_push_number(L, h->ty); + lua_rawseti(L, -2, i); + i++; + mplib_push_number(L, h->txx); + lua_rawseti(L, -2, i); + i++; + mplib_push_number(L, h->tyx); + lua_rawseti(L, -2, i); + i++; + mplib_push_number(L, h->txy); + lua_rawseti(L, -2, i); + i++; + mplib_push_number(L, h->tyy); + lua_rawseti(L, -2, i); + i++; + } else { + lua_pushnil(L); + } +} + +#define FIELD(A) (mplib_is_S(A,2)) + +static void mplib_fill(lua_State * L, struct mp_fill_object *h) +{ + if (FIELD(path)) { + mplib_push_path(L, h->path_p, MPLIB_PATH); + } else if (FIELD(htap)) { + mplib_push_path(L, h->htap_p, MPLIB_PATH); + } else if (FIELD(pen)) { + mplib_push_path(L, h->pen_p, MPLIB_PEN); + mplib_push_pentype(L, h->pen_p); + } else if (FIELD(color)) { + mplib_push_color(L, (mp_graphic_object *) h); + } else if (FIELD(linejoin)) { + lua_pushnumber(L, (lua_Number)h->ljoin); + } else if (FIELD(miterlimit)) { + mplib_push_number(L, h->miterlim); + } else if (FIELD(prescript)) { + lua_pushstring(L, h->pre_script); + } else if (FIELD(postscript)) { + lua_pushstring(L, h->post_script); + } else { + lua_pushnil(L); + } +} + +static void mplib_stroked(lua_State * L, struct mp_stroked_object *h) +{ + if (FIELD(path)) { + mplib_push_path(L, h->path_p, MPLIB_PATH); + } else if (FIELD(pen)) { + mplib_push_path(L, h->pen_p, MPLIB_PEN); + mplib_push_pentype(L, h->pen_p); + } else if (FIELD(color)) { + mplib_push_color(L, (mp_graphic_object *) h); + } else if (FIELD(dash)) { + mplib_push_dash(L, h); + } else if (FIELD(linecap)) { + lua_pushnumber(L, (lua_Number)h->lcap); + } else if (FIELD(linejoin)) { + lua_pushnumber(L, (lua_Number)h->ljoin); + } else if (FIELD(miterlimit)) { + mplib_push_number(L, h->miterlim); + } else if (FIELD(prescript)) { + lua_pushstring(L, h->pre_script); + } else if (FIELD(postscript)) { + lua_pushstring(L, h->post_script); + } else { + lua_pushnil(L); + } +} + +static void mplib_text(lua_State * L, struct mp_text_object *h) +{ + if (FIELD(text)) { + lua_pushstring(L, h->text_p); + } else if (FIELD(dsize)) { + mplib_push_number(L, (h->font_dsize / 16)); + } else if (FIELD(font)) { + lua_pushstring(L, h->font_name); + } else if (FIELD(color)) { + mplib_push_color(L, (mp_graphic_object *) h); + } else if (FIELD(width)) { + mplib_push_number(L, h->width); + } else if (FIELD(height)) { + mplib_push_number(L, h->height); + } else if (FIELD(depth)) { + mplib_push_number(L, h->depth); + } else if (FIELD(transform)) { + mplib_push_transform(L, h); + } else if (FIELD(prescript)) { + lua_pushstring(L, h->pre_script); + } else if (FIELD(postscript)) { + lua_pushstring(L, h->post_script); + } else { + lua_pushnil(L); + } +} + +static void mplib_special(lua_State * L, struct mp_special_object *h) +{ + if (FIELD(prescript)) { + lua_pushstring(L, h->pre_script); + } else { + lua_pushnil(L); + } +} + +static void mplib_start_bounds(lua_State * L, struct mp_bounds_object *h) +{ + if (FIELD(path)) { + mplib_push_path(L, h->path_p, MPLIB_PATH); + } else { + lua_pushnil(L); + } +} + +static void mplib_start_clip(lua_State * L, struct mp_clip_object *h) +{ + if (FIELD(path)) { + mplib_push_path(L, h->path_p, MPLIB_PATH); + } else { + lua_pushnil(L); + } +} + +static int mplib_gr_index(lua_State * L) +{ + struct mp_graphic_object **hh = is_gr_object(L, 1); + if (*hh) { + struct mp_graphic_object *h = *hh; + + if (mplib_is_S(type, 2)) { + lua_rawgeti(L, LUA_REGISTRYINDEX, mplib_type_Ses[h->type]); + } else { + switch (h->type) { + case mp_fill_code: + mplib_fill(L, (mp_fill_object *) h); + break; + case mp_stroked_code: + mplib_stroked(L, (mp_stroked_object *) h); + break; + case mp_text_code: + mplib_text(L, (mp_text_object *) h); + break; + case mp_special_code: + mplib_special(L, (mp_special_object *) h); + break; + case mp_start_clip_code: + mplib_start_clip(L, (mp_clip_object *) h); + break; + case mp_start_bounds_code: + mplib_start_bounds(L, (mp_bounds_object *) h); + break; + case mp_stop_clip_code: + case mp_stop_bounds_code: + default: + lua_pushnil(L); + } + } + } else { + lua_pushnil(L); + } + return 1; +} + + +static const struct luaL_reg mplib_meta[] = { + {"__gc", mplib_collect}, + {"__tostring", mplib_tostring}, + {NULL, NULL} /* sentinel */ +}; + +static const struct luaL_reg mplib_fig_meta[] = { + {"__gc", mplib_fig_collect}, + {"__tostring", mplib_fig_tostring}, + {"objects", mplib_fig_body}, + {"copy_objects", mplib_fig_copy_body}, + {"filename", mplib_fig_filename}, + {"postscript", mplib_fig_postscript}, + {"boundingbox", mplib_fig_bb}, + {"width", mplib_fig_width}, + {"height", mplib_fig_height}, + {"depth", mplib_fig_depth}, + {"italcorr", mplib_fig_italcorr}, + {"charcode", mplib_fig_charcode}, + {NULL, NULL} /* sentinel */ +}; + +static const struct luaL_reg mplib_gr_meta[] = { + {"__gc", mplib_gr_collect}, + {"__tostring", mplib_gr_tostring}, + {"__index", mplib_gr_index}, + {NULL, NULL} /* sentinel */ +}; + +static const struct luaL_reg mplib_d[] = { + {"execute", mplib_execute}, + {"finish", mplib_finish}, + {"char_width", mplib_charwidth}, + {"char_height", mplib_charheight}, + {"char_depth", mplib_chardepth}, + {"statistics", mplib_statistics}, + {NULL, NULL} /* sentinel */ +}; + + +static const struct luaL_reg mplib_m[] = { + {"new", mplib_new}, + {"version", mplib_version}, + {"fields", mplib_gr_fields}, + {"pen_info", mplib_gr_peninfo}, + {NULL, NULL} /* sentinel */ +}; + + +int luaopen_mplib(lua_State * L) +{ + mplib_init_Ses(L); + + luaL_newmetatable(L, MPLIB_GR_METATABLE); + lua_pushvalue(L, -1); /* push metatable */ + lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ + luaL_register(L, NULL, mplib_gr_meta); /* object meta methods */ + lua_pop(L, 1); + + luaL_newmetatable(L, MPLIB_FIG_METATABLE); + lua_pushvalue(L, -1); /* push metatable */ + lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ + luaL_register(L, NULL, mplib_fig_meta); /* figure meta methods */ + lua_pop(L, 1); + + luaL_newmetatable(L, MPLIB_METATABLE); + lua_pushvalue(L, -1); /* push metatable */ + lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ + luaL_register(L, NULL, mplib_meta); /* meta methods */ + luaL_register(L, NULL, mplib_d); /* dict methods */ + luaL_register(L, "mplib", mplib_m); /* module functions */ + return 1; +} diff --git a/Build/source/texk/web2c/mplibdir/memio.w b/Build/source/texk/web2c/mplibdir/memio.w new file mode 100644 index 00000000000..d2393d0fb96 --- /dev/null +++ b/Build/source/texk/web2c/mplibdir/memio.w @@ -0,0 +1,405 @@ +% $Id: psout.w 616 2008-07-09 14:05:55Z taco $ +% +% Copyright 2008 Taco Hoekwater. +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU Lesser General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU Lesser General Public License for more details. +% +% You should have received a copy of the GNU Lesser General Public License +% along with this program. If not, see . +% +% TeX is a trademark of the American Mathematical Society. +% METAFONT is a trademark of Addison-Wesley Publishing Company. +% PostScript is a trademark of Adobe Systems Incorporated. + +% Here is TeX material that gets inserted after \input webmac + +\font\tenlogo=logo10 % font used for the METAFONT logo +\def\MP{{\tenlogo META}\-{\tenlogo POST}} +\def\title{MetaPost MEM reading and writing} +\def\topofcontents{\hsize 5.5in + \vglue -30pt plus 1fil minus 1.5in + \def\?##1]{\hbox to 1in{\hfil##1.\ }} + } +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +\pdfoutput=1 +\pageno=3 + +@ As usual, need true and false. + +@d true 1 +@d false 0 +@d null 0 /* the null pointer */ +@d incr(A) (A)=(A)+1 /* increase a variable by unity */ +@d decr(A) (A)=(A)-1 /* decrease a variable by unity */ +@d qo(A) (A) /* to read eight bits from a quarterword */ +@d qi(A) (quarterword)(A) /* to store eight bits in a quarterword */ +@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */ +@d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */ +@d max_str_ref 127 /* ``infinite'' number of references */ + + +@c +#include "config.h" +#include +#include +#include +#include "mplib.h" +#include "mpmp.h" + +@ @c void mp_store_mem_file (MP mp) { + integer k; /* all-purpose index */ + pointer p,q; /* all-purpose pointers */ + integer x; /* something to dump */ + four_quarters w; /* four ASCII codes */ + memory_word WW; + @; + @; + @; + @; + @; + @; + @; +} + +@ Corresponding to the procedure that dumps a mem file, we also have a function +that reads~one~in. The function returns |false| if the dumped mem is +incompatible with the present \MP\ table sizes, etc. + +@d too_small(A) { wake_up_terminal; + wterm_ln("---! Must increase the "); wterm((A)); +@.Must increase the x@> + goto OFF_BASE; + } + +@c +boolean mp_load_mem_file (MP mp) { + integer k; /* all-purpose index */ + pointer p,q; /* all-purpose pointers */ + integer x; /* something undumped */ + str_number s; /* some temporary string */ + four_quarters w; /* four ASCII codes */ + memory_word WW; + @; + @; + @; + @; + return true; /* it worked! */ +OFF_BASE: + wake_up_terminal; + wterm_ln("(Fatal mem file error; I'm stymied)\n"); +@.Fatal mem file error@> + return false; +} + +@ Mem files consist of |memory_word| items, and we use the following +macros to dump words of different types: + +@d dump_wd(A) { WW=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); } +@d dump_int(A) { int cint=(A); (mp->write_binary_file)(mp,mp->mem_file,&cint,sizeof(cint)); } +@d dump_hh(A) { WW.hh=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); } +@d dump_qqqq(A) { WW.qqqq=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); } +@d dump_string(A) { dump_int((int)(strlen(A)+1)); + (mp->write_binary_file)(mp,mp->mem_file,A,strlen(A)+1); } + +@ The inverse macros are slightly more complicated, since we need to check +the range of the values we are reading in. We say `|undump(a)(b)(x)|' to +read an integer value |x| that is supposed to be in the range |a<=x<=b|. + +@d mgeti(A) do { + size_t wanted = sizeof(A); + void *A_ptr = &A; + (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted); + if (wanted!=sizeof(A)) goto OFF_BASE; +} while (0) + +@d mgetw(A) do { + size_t wanted = sizeof(A); + void *A_ptr = &A; + (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted); + if (wanted!=sizeof(A)) goto OFF_BASE; +} while (0) + +@d undump_wd(A) { mgetw(WW); A=WW; } +@d undump_int(A) { int cint; mgeti(cint); A=cint; } +@d undump_hh(A) { mgetw(WW); A=WW.hh; } +@d undump_qqqq(A) { mgetw(WW); A=WW.qqqq; } +@d undump_strings(A,B,C) { + undump_int(x); if ( (x<(A)) || (x>(B)) ) goto OFF_BASE; else C=str(x); } +@d undump(A,B,C) { undump_int(x); + if ( (x<(A)) || (x>(int)(B)) ) goto OFF_BASE; else C=x; } +@d undump_size(A,B,C,D) { undump_int(x); + if (x<(A)) goto OFF_BASE; + if (x>(B)) too_small((C)); else D=x; } +@d undump_string(A) { + size_t the_wanted; + void *the_string; + integer XX=0; + undump_int(XX); + the_wanted = (size_t)XX; + the_string = mp_xmalloc(mp,(size_t)XX,1); + (mp->read_binary_file)(mp,mp->mem_file,&the_string,&the_wanted); + A = (char *)the_string; + if (the_wanted!=(size_t)XX) goto OFF_BASE; +} + +@ The next few sections of the program should make it clear how we use the +dump/undump macros. + +@= +x = metapost_magic; dump_int(x); +dump_int(mp->mem_top); +dump_int((integer)mp->hash_size); +dump_int(mp->hash_prime) +dump_int(mp->param_size); +dump_int(mp->max_in_open); + +@ Sections of a \.{WEB} program that are ``commented out'' still contribute +strings to the string pool; therefore \.{INIMP} and \MP\ will have +the same strings. (And it is, of course, a good thing that they do.) +@.WEB@> +@^string pool@> + +@ @c +int mp_undump_constants (MP mp) { + integer x; + undump_int(x); + if (x!=metapost_magic) return x; + undump_int(x); mp->mem_top = x; + undump_int(x); mp->hash_size = (unsigned)x; + undump_int(x); mp->hash_prime = x; + undump_int(x); mp->param_size = x; + undump_int(x); mp->max_in_open = x; + return metapost_magic; + OFF_BASE: + return -1; +} + +@ We do string pool compaction to avoid dumping unused strings. + +@d dump_four_ASCII + w.b0=qi(mp->str_pool[k]); w.b1=qi(mp->str_pool[k+1]); + w.b2=qi(mp->str_pool[k+2]); w.b3=qi(mp->str_pool[k+3]); + dump_qqqq(w) + +@= +mp_do_compaction(mp, mp->pool_size); +dump_int(mp->pool_ptr); +dump_int(mp->max_str_ptr); +dump_int(mp->str_ptr); +k=0; +while ( (mp->next_str[k]==k+1) && (k<=mp->max_str_ptr) ) + k++; +dump_int(k); +while ( k<=mp->max_str_ptr ) { + dump_int(mp->next_str[k]); incr(k); +} +k=0; +while (1) { + dump_int(mp->str_start[k]); /* TODO: valgrind warning here */ + if ( k==mp->str_ptr ) { + break; + } else { + k=mp->next_str[k]; + } +} +k=0; +while (k+4pool_ptr ) { + dump_four_ASCII; k=k+4; +} +k=mp->pool_ptr-4; dump_four_ASCII; +mp_print_ln(mp); mp_print(mp, "at most "); mp_print_int(mp, mp->max_str_ptr); +mp_print(mp, " strings of total length "); +mp_print_int(mp, mp->pool_ptr) + +@ @d undump_four_ASCII + undump_qqqq(w); + mp->str_pool[k]=(ASCII_code)qo(w.b0); mp->str_pool[k+1]=(ASCII_code)qo(w.b1); + mp->str_pool[k+2]=(ASCII_code)qo(w.b2); mp->str_pool[k+3]=(ASCII_code)qo(w.b3) + +@= +undump_int(mp->pool_ptr); +mp_reallocate_pool(mp, mp->pool_ptr) ; +undump_int(mp->max_str_ptr); +mp_reallocate_strings (mp,mp->max_str_ptr) ; +undump(0,mp->max_str_ptr,mp->str_ptr); +undump(0,mp->max_str_ptr+1,s); +for (k=0;k<=s-1;k++) + mp->next_str[k]=k+1; +for (k=s;k<=mp->max_str_ptr;k++) + undump(s+1,mp->max_str_ptr+1,mp->next_str[k]); +mp->fixed_str_use=0; +k=0; +while (1) { + undump(0,mp->pool_ptr,mp->str_start[k]); + if ( k==mp->str_ptr ) break; + mp->str_ref[k]=max_str_ref; + incr(mp->fixed_str_use); + mp->last_fixed_str=k; k=mp->next_str[k]; +} +k=0; +while ( k+4pool_ptr ) { + undump_four_ASCII; k=k+4; +} +k=mp->pool_ptr-4; undump_four_ASCII; +mp->init_str_use=mp->fixed_str_use; mp->init_pool_ptr=mp->pool_ptr; +mp->max_pool_ptr=mp->pool_ptr; +mp->strs_used_up=mp->fixed_str_use; +mp->pool_in_use=mp->str_start[mp->str_ptr]; mp->strs_in_use=mp->fixed_str_use; +mp->max_pl_used=mp->pool_in_use; mp->max_strs_used=mp->strs_in_use; +mp->pact_count=0; mp->pact_chars=0; mp->pact_strs=0; + +@ By sorting the list of available spaces in the variable-size portion of +|mem|, we are usually able to get by without having to dump very much +of the dynamic memory. + +We recompute |var_used| and |dyn_used|, so that \.{INIMP} dumps valid +information even when it has not been gathering statistics. + +@= +mp_sort_avail(mp); mp->var_used=0; +dump_int(mp->lo_mem_max); dump_int(mp->rover); +p=0; q=mp->rover; x=0; +do { + for (k=p;k<= q+1;k++) + dump_wd(mp->mem[k]); + x=x+q+2-p; mp->var_used=mp->var_used+q-p; + p=q+node_size(q); q=rmp_link(q); +} while (q!=mp->rover); +mp->var_used=mp->var_used+mp->lo_mem_max-p; +mp->dyn_used=mp->mem_end+1-mp->hi_mem_min; +for (k=p;k<= mp->lo_mem_max;k++ ) + dump_wd(mp->mem[k]); +x=x+mp->lo_mem_max+1-p; +dump_int(mp->hi_mem_min); dump_int(mp->avail); +for (k=mp->hi_mem_min;k<=mp->mem_end;k++ ) + dump_wd(mp->mem[k]); +x=x+mp->mem_end+1-mp->hi_mem_min; +p=mp->avail; +while ( p!=null ) { + decr(mp->dyn_used); p=mp_link(p); +} +dump_int(mp->var_used); dump_int(mp->dyn_used); +mp_print_ln(mp); mp_print_int(mp, x); +mp_print(mp, " memory locations dumped; current usage is "); +mp_print_int(mp, mp->var_used); mp_print_char(mp, xord('&')); mp_print_int(mp, mp->dyn_used) + +@ @= +undump(lo_mem_stat_max+1000,hi_mem_stat_min-1,mp->lo_mem_max); +undump(lo_mem_stat_max+1,mp->lo_mem_max,mp->rover); +p=0; q=mp->rover; +do { + for (k=p;k<= q+1; k++) + undump_wd(mp->mem[k]); + p=q+node_size(q); + if ( (p>mp->lo_mem_max)||((q>=rmp_link(q))&&(rmp_link(q)!=mp->rover)) ) + goto OFF_BASE; + q=rmp_link(q); +} while (q!=mp->rover); +for (k=p;k<=mp->lo_mem_max;k++ ) + undump_wd(mp->mem[k]); +undump(mp->lo_mem_max+1,hi_mem_stat_min,mp->hi_mem_min); +undump(null,mp->mem_top,mp->avail); mp->mem_end=mp->mem_top; +mp->last_pending=spec_head; +for (k=mp->hi_mem_min;k<= mp->mem_end;k++) + undump_wd(mp->mem[k]); +undump_int(mp->var_used); undump_int(mp->dyn_used) + +@ A different scheme is used to compress the hash table, since its lower region +is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output three +words: |p|, |hash[p]|, and |eqtb[p]|. The hash table is, of course, densely +packed for |p>=hash_used|, so the remaining entries are output in~a~block. + +@= +dump_int(mp->hash_used); +mp->st_count=frozen_inaccessible-1-mp->hash_used; +for (p=1;p<=mp->hash_used;p++) { + if ( text(p)!=0 ) { + dump_int(p); dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]); incr(mp->st_count); + } +} +for (p=mp->hash_used+1;p<=(int)hash_end;p++) { + dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]); +} +dump_int(mp->st_count); +mp_print_ln(mp); mp_print_int(mp, mp->st_count); mp_print(mp, " symbolic tokens") + +@ @= +undump(1,frozen_inaccessible,mp->hash_used); +p=0; +do { + undump(p+1,mp->hash_used,p); + undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]); +} while (p!=mp->hash_used); +for (p=mp->hash_used+1;p<=(int)hash_end;p++ ) { + undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]); +} +undump_int(mp->st_count) + +@ We have already printed a lot of statistics, so we set |mp_tracing_stats:=0| +to prevent them appearing again. + +@= +dump_int(mp->max_internal); +dump_int(mp->int_ptr); +for (k=1;k<= mp->int_ptr;k++ ) { + dump_int(mp->internal[k]); + dump_string(mp->int_name[k]); +} +dump_int(mp->start_sym); +dump_int(mp->interaction); +dump_string(mp->mem_ident); +dump_int(mp->bg_loc); dump_int(mp->eg_loc); dump_int(mp->serial_no); dump_int(69073); +mp->internal[mp_tracing_stats]=0 + +@ @= +undump_int(x); +if (x>mp->max_internal) mp_grow_internals(mp,x); +undump_int(mp->int_ptr); +for (k=1;k<= mp->int_ptr;k++) { + undump_int(mp->internal[k]); + undump_string(mp->int_name[k]); +} +undump(0,frozen_inaccessible,mp->start_sym); +if (mp->interaction==mp_unspecified_mode) { + undump(mp_unspecified_mode,mp_error_stop_mode,mp->interaction); +} else { + undump(mp_unspecified_mode,mp_error_stop_mode,x); +} +undump_string(mp->mem_ident); +undump(1,hash_end,mp->bg_loc); +undump(1,hash_end,mp->eg_loc); +undump_int(mp->serial_no); +undump_int(x); +if (x!=69073) goto OFF_BASE + +@ @= +{ + char *tmp = mp_xmalloc(mp,11,1); + mp_xfree(mp->mem_ident); + mp->mem_ident = mp_xmalloc(mp,256,1); + mp_snprintf(tmp,11,"%04d.%02d.%02d", + (int)mp_round_unscaled(mp, mp->internal[mp_year]), + (int)mp_round_unscaled(mp, mp->internal[mp_month]), + (int)mp_round_unscaled(mp, mp->internal[mp_day])); + mp_snprintf(mp->mem_ident,256," (mem=%s %s)",mp->job_name, tmp); + mp_xfree(tmp); + mp_pack_job_name(mp, ".mem"); + while (! mp_w_open_out(mp, &mp->mem_file) ) + mp_prompt_file_name(mp, "mem file name", ".mem"); + mp_print_nl(mp, "Beginning to dump on file "); +@.Beginning to dump...@> + mp_print(mp, mp->name_of_file); + mp_print_nl(mp, mp->mem_ident); +} + +@ @= +(mp->close_file)(mp,mp->mem_file) diff --git a/Build/source/texk/web2c/mplibdir/mp.w b/Build/source/texk/web2c/mplibdir/mp.w new file mode 100644 index 00000000000..1303cf6f9e4 --- /dev/null +++ b/Build/source/texk/web2c/mplibdir/mp.w @@ -0,0 +1,26427 @@ +% $Id: mp.w 873 2009-03-19 07:44:11Z taco $ +% +% Copyright 2008 Taco Hoekwater. +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU Lesser General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU Lesser General Public License for more details. +% +% You should have received a copy of the GNU Lesser General Public License +% along with this program. If not, see . +% +% TeX is a trademark of the American Mathematical Society. +% METAFONT is a trademark of Addison-Wesley Publishing Company. +% PostScript is a trademark of Adobe Systems Incorporated. + +% Here is TeX material that gets inserted after \input webmac +\def\hang{\hangindent 3em\noindent\ignorespaces} +\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces} +\def\ps{PostScript} +\def\psqrt#1{\sqrt{\mathstrut#1}} +\def\k{_{k+1}} +\def\pct!{{\char`\%}} % percent sign in ordinary text +\font\tenlogo=logo10 % font used for the METAFONT logo +\font\logos=logosl10 +\def\MF{{\tenlogo META}\-{\tenlogo FONT}} +\def\MP{{\tenlogo META}\-{\tenlogo POST}} +\def\[#1]{\ignorespaces} % left over from pascal web +\def\<#1>{$\langle#1\rangle$} +\def\section{\mathhexbox278} +\let\swap=\leftrightarrow +\def\round{\mathop{\rm round}\nolimits} +\mathchardef\vbv="026A % synonym for `\|' +\def\vb{\relax\ifmmode\vbv\else$\vbv$\fi} + +\def\(#1){} % this is used to make section names sort themselves better +\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@> +\def\title{MetaPost} +\pdfoutput=1 +\pageno=3 + +@* \[1] Introduction. + +This is \MP\ by John Hobby, a graphics-language processor based on D. E. Knuth's \MF. + +Much of the original Pascal version of this program was copied with +permission from MF.web Version 1.9. It interprets a language very +similar to D.E. Knuth's METAFONT, but with changes designed to make it +more suitable for PostScript output. + +The main purpose of the following program is to explain the algorithms of \MP\ +as clearly as possible. However, the program has been written so that it +can be tuned to run efficiently in a wide variety of operating environments +by making comparatively few changes. Such flexibility is possible because +the documentation that follows is written in the \.{WEB} language, which is +at a higher level than C. + +A large piece of software like \MP\ has inherent complexity that cannot +be reduced below a certain level of difficulty, although each individual +part is fairly simple by itself. The \.{WEB} language is intended to make +the algorithms as readable as possible, by reflecting the way the +individual program pieces fit together and by providing the +cross-references that connect different parts. Detailed comments about +what is going on, and about why things were done in certain ways, have +been liberally sprinkled throughout the program. These comments explain +features of the implementation, but they rarely attempt to explain the +\MP\ language itself, since the reader is supposed to be familiar with +{\sl The {\logos METAFONT\/}book} as well as the manual +@.WEB@> +@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> +{\sl A User's Manual for MetaPost}, Computing Science Technical Report 162, +AT\AM T Bell Laboratories. + +@ The present implementation is a preliminary version, but the possibilities +for new features are limited by the desire to remain as nearly compatible +with \MF\ as possible. + +On the other hand, the \.{WEB} description can be extended without changing +the core of the program, and it has been designed so that such +extensions are not extremely difficult to make. +The |banner| string defined here should be changed whenever \MP\ +undergoes any modifications, so that it will be clear which version of +\MP\ might be the guilty party when a problem arises. +@^extensions to \MP@> +@^system dependencies@> + +@d default_banner "This is MetaPost, Version 1.110" /* printed when \MP\ starts */ +@d true 1 +@d false 0 + +@(mpmp.h@>= +#define metapost_version "1.110" +#define metapost_magic (('M'*256) + 'P')*65536 + 1110 +#define metapost_old_magic (('M'*256) + 'P')*65536 + 1080 + +@ The external library header for \MP\ is |mplib.h|. It contains a +few typedefs and the header defintions for the externally used +fuctions. + +The most important of the typedefs is the definition of the structure +|MP_options|, that acts as a small, configurable front-end to the fairly +large |MP_instance| structure. + +@(mplib.h@>= +typedef struct MP_instance * MP; +@ +typedef struct MP_options { + @