summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/luatexdir/ocp
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/texk/web2c/luatexdir/ocp')
-rw-r--r--Build/source/texk/web2c/luatexdir/ocp/ocp.h52
-rw-r--r--Build/source/texk/web2c/luatexdir/ocp/ocp.w201
-rw-r--r--Build/source/texk/web2c/luatexdir/ocp/ocplist.h91
-rw-r--r--Build/source/texk/web2c/luatexdir/ocp/ocplist.w357
-rw-r--r--Build/source/texk/web2c/luatexdir/ocp/readocp.h61
-rw-r--r--Build/source/texk/web2c/luatexdir/ocp/readocp.w273
-rw-r--r--Build/source/texk/web2c/luatexdir/ocp/runocp.h60
-rw-r--r--Build/source/texk/web2c/luatexdir/ocp/runocp.w1069
8 files changed, 2164 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/luatexdir/ocp/ocp.h b/Build/source/texk/web2c/luatexdir/ocp/ocp.h
new file mode 100644
index 00000000000..3bdaab0e8c8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ocp/ocp.h
@@ -0,0 +1,52 @@
+/* ocp.h
+
+ Copyright 2009 Taco Hoekwater <taco@luatex.org>
+
+ This file is part of LuaTeX.
+
+ LuaTeX is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 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 General Public License along
+ with LuaTeX; if not, see <http://www.gnu.org/licenses/>. */
+
+/* $Id: ocp.h 3261 2009-12-18 11:38:21Z taco $ */
+
+#ifndef OCP_H
+
+# define OCP_H 1
+
+typedef int internal_ocp_number;
+typedef int ocp_index;
+
+extern int **ocp_tables;
+
+extern int ocp_maxint;
+
+extern internal_ocp_number ocp_ptr; /* largest internal ocp number in use */
+
+/* smallest internal ocp number; must not be less than |min_quarterword| */
+# define ocp_base 0
+# define number_ocps 32768
+
+# define null_ocp ocp_base
+
+extern void new_ocp(small_number a);
+
+# define ocp_trace_level equiv(ocp_trace_level_base)
+
+extern void allocate_ocp_table(int ocp_number, int ocp_size);
+
+extern void dump_ocp_info(void);
+extern void undump_ocp_info(void);
+extern void scan_ocp_ident(void);
+
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/ocp/ocp.w b/Build/source/texk/web2c/luatexdir/ocp/ocp.w
new file mode 100644
index 00000000000..60afca0f4c6
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ocp/ocp.w
@@ -0,0 +1,201 @@
+% ocp.w
+%
+% Copyright 2009-2010 Taco Hoekwater <taco@@luatex.org>
+
+% This file is part of LuaTeX.
+
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 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 General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+@ @c
+#include "ptexlib.h"
+
+static const char _svn_version[] =
+ "$Id: ocp.w 3584 2010-04-02 17:45:55Z hhenkel $ "
+"$URL: http://foundry.supelec.fr/svn/luatex/tags/beta-0.60.0/source/texk/web2c/luatexdir/ocp/ocp.w $";
+
+@ @c
+int **ocp_tables;
+
+static int ocp_entries = 0;
+int ocp_maxint = 10000000;
+
+@ When the user defines \.{\\ocp\\f}, say, \TeX\ assigns an internal number
+to the user's ocp~\.{\\f}. Adding this number to |ocp_id_base| gives the
+|eqtb| location of a ``frozen'' control sequence that will always select
+the ocp.
+
+@c
+internal_ocp_number ocp_ptr; /* largest internal ocp number in use */
+
+void new_ocp(small_number a)
+{
+ pointer u; /* user's ocp identifier */
+ internal_ocp_number f; /* runs through existing ocps */
+ str_number t; /* name for the frozen ocp identifier */
+ boolean external_ocp = false; /* external binary file */
+ if (job_name == 0)
+ open_log_file();
+ /* avoid confusing \.{texput} with the ocp name */
+ if (cur_chr == 1)
+ external_ocp = true;
+ get_r_token();
+ u = cur_cs;
+ if (u >= hash_base)
+ t = cs_text(u);
+ else
+ t = maketexstring("OCP");
+ define(u, set_ocp_cmd, null_ocp);
+ scan_optional_equals();
+ scan_file_name();
+ /* If this ocp has already been loaded, set |f| to the internal
+ ocp number and |goto common_ending| */
+ /* When the user gives a new identifier to a ocp that was previously loaded,
+ the new name becomes the ocp identifier of record. OCP names `\.{xyz}' and
+ `\.{XYZ}' are considered to be different.
+ */
+ for (f = ocp_base + 1; f <= ocp_ptr; f++) {
+ if (str_eq_str(ocp_name(f), cur_name)
+ && str_eq_str(ocp_area(f), cur_area)) {
+ flush_str(cur_name);
+ flush_str(cur_area);
+ cur_name = ocp_name(f);
+ cur_area = ocp_area(f);
+ goto COMMON_ENDING;
+ }
+ }
+ {
+ char *nam = makecstring(cur_name);
+ char *are = makecstring(cur_area);
+ char *ext = makecstring(cur_ext);
+ f = read_ocp_info(u, nam, are, ext, external_ocp);
+ free(nam);
+ free(are);
+ free(ext);
+ }
+ COMMON_ENDING:
+ equiv(u) = f;
+ eqtb[ocp_id_base + f] = eqtb[u];
+ cs_text(ocp_id_base + f) = t;
+ if (ocp_trace_level == 1) {
+ tprint_nl("");
+ tprint_esc("ocp");
+ print_esc(t);
+ tprint("=");
+ print(cur_name);
+ }
+}
+
+@ Before we forget about the format of these tables, let's deal with
+$\Omega$'s basic scanning routine related to ocp information.
+
+@c
+void scan_ocp_ident(void)
+{
+ internal_ocp_number f;
+ do {
+ get_x_token();
+ } while (cur_cmd == spacer_cmd);
+
+ if (cur_cmd == set_ocp_cmd) {
+ f = cur_chr;
+ } else {
+ const char *hlp[] = { "I was looking for a control sequence whose",
+ "current meaning has been defined by \\ocp.",
+ NULL
+ };
+ back_input();
+ tex_error("Missing ocp identifier", hlp);
+ f = null_ocp;
+ }
+ cur_val = f;
+}
+
+void allocate_ocp_table(int ocp_number, int ocp_size)
+{
+ int i;
+ if (ocp_entries == 0) {
+ ocp_tables = (int **) xmalloc(256 * sizeof(int **));
+ ocp_entries = 256;
+ } else if ((ocp_number == 256) && (ocp_entries == 256)) {
+ ocp_tables = xrealloc(ocp_tables, 65536);
+ ocp_entries = 65536;
+ }
+ ocp_tables[ocp_number] =
+ (int *) xmalloc((unsigned) ((1 + (unsigned) ocp_size) * sizeof(int)));
+ ocp_tables[ocp_number][0] = ocp_size;
+ for (i = 1; i <= ocp_size; i++) {
+ ocp_tables[ocp_number][i] = 0;
+ }
+}
+
+@ @c
+static void dump_ocp_table(int ocp_number)
+{
+ dump_things(ocp_tables[ocp_number][0], ocp_tables[ocp_number][0] + 1);
+}
+
+void dump_ocp_info(void)
+{
+ int k;
+ dump_int(123456);
+ dump_int(ocp_ptr);
+ for (k = null_ocp; k <= ocp_ptr; k++) {
+ dump_ocp_table(k);
+ if (ocp_ptr - ocp_base > 0) {
+ tprint_nl("\\ocp");
+ print_esc(cs_text(ocp_id_base + k));
+ print_char('=');
+ print_file_name(ocp_name(k), ocp_area(k), get_nullstr());
+ }
+ }
+ dump_int(123456);
+ if (ocp_ptr - ocp_base > 0) {
+ print_ln();
+ print_int(ocp_ptr - ocp_base);
+ tprint(" preloaded ocp");
+ if (ocp_ptr != ocp_base + 1)
+ print_char('s');
+ }
+}
+
+static void undump_ocp_table(int ocp_number)
+{
+ int sizeword;
+ if (ocp_entries == 0) {
+ ocp_tables = (int **) xmalloc(256 * sizeof(int **));
+ ocp_entries = 256;
+ } else if ((ocp_number == 256) && (ocp_entries == 256)) {
+ ocp_tables = xrealloc(ocp_tables, 65536);
+ ocp_entries = 65536;
+ }
+ undump_things(sizeword, 1);
+ ocp_tables[ocp_number] =
+ (int *) xmalloc((unsigned) ((1 + (unsigned) sizeword) * sizeof(int)));
+ ocp_tables[ocp_number][0] = sizeword;
+ undump_things(ocp_tables[ocp_number][1], sizeword);
+}
+
+
+void undump_ocp_info(void)
+{
+ int k;
+ int x;
+ undump_int(x);
+ assert(x == 123456);
+ undump_int(ocp_ptr);
+ for (k = null_ocp; k <= ocp_ptr; k++)
+ undump_ocp_table(k);
+ undump_int(x);
+ assert(x == 123456);
+}
diff --git a/Build/source/texk/web2c/luatexdir/ocp/ocplist.h b/Build/source/texk/web2c/luatexdir/ocp/ocplist.h
new file mode 100644
index 00000000000..f94f29adf03
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ocp/ocplist.h
@@ -0,0 +1,91 @@
+/* ocplist.h
+
+ Copyright 2009 Taco Hoekwater <taco@luatex.org>
+
+ This file is part of LuaTeX.
+
+ LuaTeX is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 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 General Public License along
+ with LuaTeX; if not, see <http://www.gnu.org/licenses/>. */
+
+/* $Id: ocplist.h 3302 2009-12-25 12:49:14Z oneiros $ */
+
+#ifndef OCPLIST_H
+
+# define OCPLIST_H 1
+
+# define ocp_list_base 0 /* smallest internal ocp list number; must not be less
+ than |min_quarterword| */
+# define number_ocp_lists 32768
+# define null_ocp_list ocp_list_base
+
+typedef int internal_ocp_list_number;
+typedef int ocp_list_index; /* index into |ocp_list_info| */
+typedef int ocp_lstack_index; /* index into |ocp_lstack_info| */
+
+extern memory_word *ocp_list_info;
+extern memory_word *ocp_lstack_info;
+extern internal_ocp_list_number ocp_list_ptr;
+extern ocp_list_index *ocp_list_list;
+
+# define ocp_list_lnext(A) ocp_list_info[(A)].hh.u.B0
+# define ocp_list_lstack(A) ocp_list_info[(A)].hh.u.B1
+# define ocp_list_lstack_no(A) ocp_list_info[(A)+1].cint
+# define ocp_lstack_lnext(A) ocp_lstack_info[(A)].hh.u.B0
+# define ocp_lstack_ocp(A) ocp_lstack_info[(A)].hh.u.B1
+# define make_null_ocp_list() make_ocp_list_node(0,ocp_maxint,0)
+# define is_null_ocp_list(A) (ocp_list_lstack_no(A)==ocp_maxint)
+
+# define make_null_ocp_lstack() 0
+# define is_null_ocp_lstack(A) ((A)==0)
+
+typedef enum {
+ add_before_op = 1,
+ add_after_op,
+ remove_before_op,
+ remove_after_op
+} ocplist_ops;
+
+
+extern void initialize_init_ocplists(void);
+extern void initialize_ocplist_arrays(int ocp_list_size);
+
+extern ocp_list_index make_ocp_list_node(ocp_lstack_index llstack,
+ scaled llstack_no,
+ ocp_list_index llnext);
+
+extern ocp_lstack_index make_ocp_lstack_node(internal_ocp_number locp,
+ ocp_lstack_index llnext);
+
+extern ocp_lstack_index copy_ocp_lstack(ocp_lstack_index llstack);
+
+extern ocp_list_index copy_ocp_list(ocp_list_index list);
+
+extern ocp_list_index ocp_ensure_lstack(ocp_list_index list, scaled llstack_no);
+
+extern void ocp_apply_add(ocp_list_index list_entry,
+ boolean lbefore, internal_ocp_number locp);
+
+extern void ocp_apply_remove(ocp_list_index list_entry, boolean lbefore);
+
+extern void print_ocp_lstack(ocp_lstack_index lstack_entry);
+extern void print_ocp_list(ocp_list_index list_entry);
+extern ocp_list_index scan_ocp_list(void);
+extern internal_ocp_list_number read_ocp_list(void);
+extern void scan_ocp_list_ident(void);
+
+extern void new_ocp_list(small_number a);
+
+extern void dump_ocplist_info(void);
+extern void undump_ocplist_info(void);
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/ocp/ocplist.w b/Build/source/texk/web2c/luatexdir/ocp/ocplist.w
new file mode 100644
index 00000000000..533678fd699
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ocp/ocplist.w
@@ -0,0 +1,357 @@
+% ocplist.w
+%
+% Copyright 2009-2010 Taco Hoekwater <taco@@luatex.org>
+
+% This file is part of LuaTeX.
+
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 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 General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+@ @c
+#include "ptexlib.h"
+
+static const char _svn_version[] =
+ "$Id: ocplist.w 3584 2010-04-02 17:45:55Z hhenkel $ "
+"$URL: http://foundry.supelec.fr/svn/luatex/tags/beta-0.60.0/source/texk/web2c/luatexdir/ocp/ocplist.w $";
+
+@ @c
+memory_word *ocp_list_info; /* the big collection of ocp list data */
+ocp_list_index ocp_listmem_ptr; /* first unused word of |ocp_list_info| */
+ocp_list_index ocp_listmem_run_ptr; /* temp unused word of |ocp_list_info| */
+memory_word *ocp_lstack_info; /* the big collection of ocp lstack data */
+ocp_lstack_index ocp_lstackmem_ptr; /* first unused word of |ocp_lstack_info| */
+ocp_lstack_index ocp_lstackmem_run_ptr; /* temp unused word of |ocp_lstack_info| */
+internal_ocp_list_number ocp_list_ptr; /* largest internal ocp list number in use */
+ocp_list_index *ocp_list_list;
+
+#define ocp_list_id_text(A) cs_text(ocp_list_id_base+(A))
+
+void initialize_init_ocplists(void)
+{
+ ocp_listmem_ptr = 2;
+ ocp_list_lstack(0) = 0;
+ ocp_list_lstack_no(0) = ocp_maxint;
+ ocp_list_lnext(0) = 0;
+ ocp_list_ptr = null_ocp_list;
+ ocp_list_list[null_ocp_list] = 0;
+ ocp_lstackmem_ptr = 1;
+}
+
+
+void initialize_ocplist_arrays(int ocp_list_size)
+{
+ ocp_list_info = xmallocarray(memory_word, (unsigned) ocp_list_size);
+ memset(ocp_list_info, 0, sizeof(memory_word) * (unsigned) ocp_list_size);
+ ocp_lstack_info = xmallocarray(memory_word, (unsigned) ocp_list_size);
+ memset(ocp_lstack_info, 0, sizeof(memory_word) * (unsigned) ocp_list_size);
+ ocp_list_list = xmallocarray(ocp_list_index, (unsigned) ocp_list_size);
+}
+
+
+@ @c
+ocp_list_index make_ocp_list_node(ocp_lstack_index llstack,
+ scaled llstack_no, ocp_list_index llnext)
+{
+ ocp_list_index p;
+ p = ocp_listmem_run_ptr;
+ ocp_list_lstack(p) = (quarterword) llstack;
+ ocp_list_lstack_no(p) = llstack_no;
+ ocp_list_lnext(p) = (quarterword) llnext;
+ ocp_listmem_run_ptr = ocp_listmem_run_ptr + 2;
+ if (ocp_listmem_run_ptr >= ocp_list_size)
+ overflow("ocp_list_size", (unsigned) ocp_list_size);
+ return p;
+}
+
+ocp_lstack_index make_ocp_lstack_node(internal_ocp_number locp,
+ ocp_lstack_index llnext)
+{
+ ocp_lstack_index p;
+ p = ocp_lstackmem_run_ptr;
+ ocp_lstack_ocp(p) = (quarterword) locp;
+ ocp_lstack_lnext(p) = (quarterword) llnext;
+ incr(ocp_lstackmem_run_ptr);
+ if (ocp_lstackmem_run_ptr >= ocp_stack_size)
+ overflow("ocp_stack_size", (unsigned) ocp_stack_size);
+ return p;
+}
+
+ocp_lstack_index copy_ocp_lstack(ocp_lstack_index llstack)
+{
+ if (is_null_ocp_lstack(llstack))
+ return make_null_ocp_lstack();
+ else
+ return make_ocp_lstack_node(ocp_lstack_ocp(llstack),
+ copy_ocp_lstack(ocp_lstack_lnext(llstack)));
+}
+
+ocp_list_index copy_ocp_list(ocp_list_index list)
+{
+ if (is_null_ocp_list(list))
+ return make_null_ocp_list();
+ else
+ return make_ocp_list_node(copy_ocp_lstack(ocp_list_lstack(list)),
+ ocp_list_lstack_no(list),
+ copy_ocp_list(ocp_list_lnext(list)));
+}
+
+ocp_list_index ocp_ensure_lstack(ocp_list_index list, scaled llstack_no)
+{
+ ocp_list_index p;
+ ocp_list_index q;
+ p = list;
+ if (is_null_ocp_list(p)) {
+ ocp_list_lstack_no(p) = llstack_no;
+ ocp_list_lnext(p) = (quarterword) make_null_ocp_list();
+ } else if (ocp_list_lstack_no(p) > llstack_no) {
+ ocp_list_lnext(p) = (quarterword)
+ make_ocp_list_node(ocp_list_lstack(p),
+ ocp_list_lstack_no(p), ocp_list_lnext(p));
+ ocp_list_lstack(p) = 0;
+ ocp_list_lstack_no(p) = llstack_no;
+ } else {
+ q = ocp_list_lnext(p);
+ while ((!(is_null_ocp_list(q))) && ocp_list_lstack_no(q) <= llstack_no) {
+ p = q;
+ q = ocp_list_lnext(q);
+ }
+ if (ocp_list_lstack_no(p) < llstack_no) {
+ ocp_list_lnext(p) =
+ (quarterword) make_ocp_list_node(0, llstack_no, q);
+ p = ocp_list_lnext(p);
+ }
+ }
+ return p;
+}
+
+void ocp_apply_add(ocp_list_index list_entry,
+ boolean lbefore, internal_ocp_number locp)
+{
+ ocp_lstack_index p;
+ ocp_lstack_index q;
+ p = ocp_list_lstack(list_entry);
+ if (lbefore || (p == 0)) {
+ ocp_list_lstack(list_entry) =
+ (quarterword) make_ocp_lstack_node(locp, p);
+ } else {
+ q = ocp_lstack_lnext(p);
+ while (q != 0) {
+ p = q;
+ q = ocp_lstack_lnext(q);
+ }
+ ocp_lstack_lnext(p) = (quarterword) make_ocp_lstack_node(locp, 0);
+ }
+}
+
+void ocp_apply_remove(ocp_list_index list_entry, boolean lbefore)
+{
+ ocp_lstack_index p;
+ ocp_lstack_index q;
+ ocp_lstack_index r;
+ p = ocp_list_lstack(list_entry);
+ if (p == 0) {
+ print_err("warning: stack entry already empty");
+ print_ln();
+ } else {
+ q = ocp_lstack_lnext(p);
+ if (lbefore || (q == 0)) {
+ ocp_list_lstack(list_entry) = (quarterword) q;
+ } else {
+ r = ocp_lstack_lnext(q);
+ while (r != 0) {
+ p = q;
+ q = r;
+ r = ocp_lstack_lnext(r);
+ }
+ ocp_lstack_lnext(p) = 0;
+ }
+ }
+}
+
+
+void print_ocp_lstack(ocp_lstack_index lstack_entry)
+{
+ ocp_lstack_index p;
+ p = lstack_entry;
+ while (p != 0) {
+ print_esc(cs_text(ocp_id_base + ocp_lstack_ocp(p)));
+ p = ocp_lstack_lnext(p);
+ if (p != 0)
+ print_char(',');
+ }
+}
+
+void print_ocp_list(ocp_list_index list_entry)
+{
+ ocp_list_index p;
+ print_char('[');
+ p = list_entry;
+ while (!(is_null_ocp_list(p))) {
+ print_char('(');
+ print_scaled(ocp_list_lstack_no(p));
+ tprint(" : ");
+ print_ocp_lstack(ocp_list_lstack(p));
+ print_char(')');
+ p = ocp_list_lnext(p);
+ if (!(is_null_ocp_list(p)))
+ tprint(", ");
+ }
+ print_char(']');
+}
+
+@ @c
+ocp_list_index scan_ocp_list(void)
+{
+ scaled llstack_no;
+ quarterword lop;
+ ocp_list_index lstack_entry;
+ ocp_list_index other_list;
+ internal_ocp_number ocp_ident = 0;
+ get_r_token();
+ if (cur_cmd == set_ocp_list_cmd) {
+ return copy_ocp_list(ocp_list_list[cur_chr]);
+ } else if (cur_cmd != ocp_list_op_cmd) {
+ const char *hlp[] =
+ { "I was looking for a ocp list specification.", NULL };
+ tex_error("Bad ocp list specification", hlp);
+ return make_null_ocp_list();
+ } else {
+ lop = (quarterword) cur_chr;
+ scan_scaled();
+ llstack_no = cur_val;
+ if ((llstack_no <= 0) || (llstack_no >= ocp_maxint)) {
+ tex_error("Stack numbers must be between 0 and 4096 (exclusive)",
+ NULL);
+ return make_null_ocp_list();
+ } else {
+ if (lop <= add_after_op) {
+ scan_ocp_ident();
+ ocp_ident = cur_val;
+ }
+ other_list = scan_ocp_list();
+ lstack_entry = ocp_ensure_lstack(other_list, llstack_no);
+ if (lop <= add_after_op) {
+ ocp_apply_add(lstack_entry, (lop = add_before_op), ocp_ident);
+ } else {
+ ocp_apply_remove(lstack_entry, (lop = remove_before_op));
+ }
+ return other_list;
+ }
+ }
+}
+
+@ @c
+internal_ocp_list_number read_ocp_list(void)
+{
+ internal_ocp_list_number f;
+ internal_ocp_list_number g;
+ g = null_ocp_list;
+ f = ocp_list_ptr + 1;
+ ocp_listmem_run_ptr = ocp_listmem_ptr;
+ ocp_lstackmem_run_ptr = ocp_lstackmem_ptr;
+ ocp_list_list[f] = scan_ocp_list();
+ ocp_list_ptr = f;
+ ocp_listmem_ptr = ocp_listmem_run_ptr;
+ ocp_lstackmem_ptr = ocp_lstackmem_run_ptr;
+ g = f;
+ return g;
+}
+
+@ @c
+void scan_ocp_list_ident(void)
+{
+ internal_ocp_list_number f;
+ do {
+ get_x_token();
+ } while (cur_cmd == spacer_cmd);
+
+ if (cur_cmd == set_ocp_list_cmd) {
+ f = cur_chr;
+ } else {
+ const char *hlp[] = { "I was looking for a control sequence whose",
+ "current meaning has been defined by \\ocplist.",
+ NULL
+ };
+ back_input();
+ tex_error("Missing ocp list identifier", hlp);
+ f = null_ocp_list;
+ }
+ cur_val = f;
+}
+
+@ @c
+void new_ocp_list(small_number a)
+{
+ pointer u; /* user's ocp list identifier */
+ internal_ocp_list_number f; /* runs through existing ocp lists */
+ str_number t; /* name for the frozen ocp list identifier */
+ if (job_name == 0)
+ open_log_file();
+ /* avoid confusing \.{texput} with the ocp list name */
+ get_r_token();
+ u = cur_cs;
+ if (u >= hash_base)
+ t = cs_text(u);
+ else
+ t = maketexstring("OCPLIST");
+ define(u, set_ocp_list_cmd, null_ocp_list);
+ scan_optional_equals();
+ f = read_ocp_list();
+ equiv(u) = f;
+ eqtb[ocp_list_id_base + f] = eqtb[u];
+ cs_text(ocp_list_id_base + f) = t;
+ if (ocp_trace_level == 1) {
+ tprint_nl("");
+ tprint_esc("ocplist");
+ print_esc(t);
+ tprint("=");
+ print_ocp_list(ocp_list_list[f]);
+ }
+}
+
+@ @c
+void dump_ocplist_info(void)
+{
+ int k;
+ dump_int(ocp_listmem_ptr);
+ for (k = 0; k <= ocp_listmem_ptr - 1; k++)
+ dump_wd(ocp_list_info[k]);
+ dump_int(ocp_list_ptr);
+ for (k = null_ocp_list; k <= ocp_list_ptr; k++) {
+ dump_int(ocp_list_list[k]);
+ if (null_ocp_list != ocp_list_ptr) {
+ tprint_nl("\\ocplist");
+ print_esc(ocp_list_id_text(k));
+ print_char('=');
+ print_ocp_list(ocp_list_list[k]);
+ }
+ }
+ dump_int(ocp_lstackmem_ptr);
+ for (k = 0; k <= ocp_lstackmem_ptr - 1; k++)
+ dump_wd(ocp_lstack_info[k]);
+}
+
+void undump_ocplist_info(void)
+{
+ int k;
+ initialize_ocplist_arrays(ocp_list_size);
+ undump_int(ocp_listmem_ptr);
+ for (k = 0; k <= ocp_listmem_ptr - 1; k++)
+ undump_wd(ocp_list_info[k]);
+ undump_int(ocp_list_ptr);
+ for (k = null_ocp_list; k <= ocp_list_ptr; k++)
+ undump_int(ocp_list_list[k]);
+ undump_int(ocp_lstackmem_ptr);
+ for (k = 0; k <= ocp_lstackmem_ptr - 1; k++)
+ undump_wd(ocp_lstack_info[k]);
+}
diff --git a/Build/source/texk/web2c/luatexdir/ocp/readocp.h b/Build/source/texk/web2c/luatexdir/ocp/readocp.h
new file mode 100644
index 00000000000..f16f464270f
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ocp/readocp.h
@@ -0,0 +1,61 @@
+/* readocp.h
+
+ Copyright 2006-2009 Taco Hoekwater <taco@luatex.org>
+
+ This file is part of LuaTeX.
+
+ LuaTeX is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 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 General Public License along
+ with LuaTeX; if not, see <http://www.gnu.org/licenses/>. */
+
+/* $Id: readocp.h 3127 2009-11-11 10:14:11Z taco $ */
+
+#ifndef READOCP_H
+
+# define READOCP_H 1
+
+# define ocp_info(A,B) ocp_tables[(A)][(B)]
+
+typedef enum {
+ offset_ocp_file_size = 0,
+ offset_ocp_name,
+ offset_ocp_area,
+ offset_ocp_external,
+ offset_ocp_external_arg,
+ offset_ocp_input,
+ offset_ocp_output,
+ offset_ocp_no_tables,
+ offset_ocp_no_states,
+ offset_ocp_table_base,
+ offset_ocp_state_base,
+ offset_ocp_info /* 11 */
+} ocp_offsets;
+
+# define ocp_file_size(A) ocp_info(A,offset_ocp_file_size)
+# define ocp_name(A) ocp_info(A,offset_ocp_name)
+# define ocp_area(A) ocp_info(A,offset_ocp_area)
+# define ocp_external(A) ocp_info(A,offset_ocp_external)
+# define ocp_external_arg(A) ocp_info(A,offset_ocp_external_arg)
+# define ocp_input(A) ocp_info(A,offset_ocp_input)
+# define ocp_output(A) ocp_info(A,offset_ocp_output)
+# define ocp_no_tables(A) ocp_info(A,offset_ocp_no_tables)
+# define ocp_no_states(A) ocp_info(A,offset_ocp_no_states)
+# define ocp_table_base(A) ocp_info(A,offset_ocp_table_base)
+# define ocp_state_base(A) ocp_info(A,offset_ocp_state_base)
+
+extern internal_ocp_number read_ocp_info(pointer u, char *nom,
+ char *aire, char *ext,
+ boolean external_ocp);
+
+extern void init_null_ocp(str_number a, str_number n);
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/ocp/readocp.w b/Build/source/texk/web2c/luatexdir/ocp/readocp.w
new file mode 100644
index 00000000000..7beee600347
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ocp/readocp.w
@@ -0,0 +1,273 @@
+% readocp.w
+%
+% Copyright 2009-2010 Taco Hoekwater <taco@@luatex.org>
+
+% This file is part of LuaTeX.
+
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 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 General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+@ @c
+#include "ptexlib.h"
+
+static const char _svn_version[] =
+ "$Id: readocp.w 3584 2010-04-02 17:45:55Z hhenkel $ "
+"$URL: http://foundry.supelec.fr/svn/luatex/tags/beta-0.60.0/source/texk/web2c/luatexdir/ocp/readocp.w $";
+
+@ @c
+static char *b_test_in(char *nam)
+{
+ if (program_name_set) {
+ return (char *) kpse_find_file(nam, kpse_program_binary_format, true);
+ }
+ return NULL;
+}
+
+
+static unsigned char *ocp_buffer = NULL; /* byte buffer for ocp files */
+static int ocp_size = 0; /* total size of the ocp file */
+static int ocp_cur = 0; /* index into |ocp_buffer| */
+
+@ @c
+void init_null_ocp(str_number a, str_number n)
+{
+ ocp_ptr = null_ocp;
+ allocate_ocp_table(null_ocp, 17);
+ ocp_file_size(null_ocp) = 17;
+ ocp_name(null_ocp) = n;
+ ocp_area(null_ocp) = a;
+ ocp_external(null_ocp) = 0;
+ ocp_external_arg(null_ocp) = 0;
+ ocp_input(null_ocp) = 1;
+ ocp_output(null_ocp) = 1;
+ ocp_no_tables(null_ocp) = 0;
+ ocp_no_states(null_ocp) = 1;
+ ocp_table_base(f) = offset_ocp_info;
+ ocp_state_base(f) = offset_ocp_info;
+ ocp_info(null_ocp, offset_ocp_info) = offset_ocp_info + 2; /* number of entries */
+ ocp_info(null_ocp, offset_ocp_info + 1) = offset_ocp_info + 5; /* number of entries */
+ ocp_info(null_ocp, offset_ocp_info + 2) = 23; /* |OTP_LEFT_START| */
+ ocp_info(null_ocp, offset_ocp_info + 3) = 3; /* |OTP_RIGHT_CHAR| */
+ ocp_info(null_ocp, offset_ocp_info + 4) = 36; /* |OTP_STOP| */
+}
+
+
+
+@ $\Omega$ checks the information of a \.{OCP} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. The somewhat tedious subroutine that does this
+is called |read_ocp_info|. It has three parameters: the user ocp
+identifier~|u|, and the file name and area strings |nom| and |aire|.
+
+The subroutine opens and closes a global file variable called |ocp_file|.
+It returns the value of the internal ocp number that was just loaded.
+If an error is detected, an error message is issued and no ocp
+information is stored; |null_ocp| is returned in this case.
+
+@c
+/* do this when the \.{OCP} data is wrong */
+#define ocp_abort(A) do { \
+ tprint("OCP file error ("); \
+ tprint(A); tprint(")"); print_ln(); \
+ goto BAD_OCP; \
+} while (0)
+
+/* macros for reading and storing ocp data */
+
+#define add_to_ocp_info(A) ocp_tables[f][ocpmem_run_ptr++]=(A)
+#define ocp_read(A) do { \
+ ocpword=ocp_buffer[ocp_cur++]; \
+ if (ocpword>127) ocp_abort("checking first octet"); \
+ ocpword=ocpword*0400+ocp_buffer[ocp_cur++]; \
+ ocpword=ocpword*0400+ocp_buffer[ocp_cur++]; \
+ ocpword=ocpword*0400+ocp_buffer[ocp_cur++]; \
+ (A)=ocpword; \
+ } while (0)
+
+#define ocp_read_all(A) ocp_read(A)
+#define ocp_read_info do { ocp_read_all(ocpword); add_to_ocp_info(ocpword); } while (0)
+
+
+
+@ Input a \.{OCP} file
+
+@c
+internal_ocp_number
+read_ocp_info(pointer u, char *nom, char *aire, char *ext, boolean external_ocp)
+{
+ boolean file_opened; /* was |ocp_file| successfully opened? */
+ boolean res;
+ int callback_id;
+ char *cnam; /* C version of file name */
+ internal_ocp_number f; /* the new ocp's number */
+ internal_ocp_number g; /* the number to return */
+ int ocpword;
+ ocp_index ocpmem_run_ptr;
+ int ocp_length, real_ocp_length; /* length of ocp file */
+ ocp_index previous_address;
+ int temp_ocp_input;
+ int temp_ocp_output;
+ int temp_ocp_no_tables;
+ int temp_ocp_no_states;
+ int i, new_offset, room_for_tables, room_for_states;
+ g = null_ocp;
+ f = null_ocp;
+ cnam = NULL;
+ file_opened = false;
+ if (external_ocp) {
+ /* Check |ocp_file| exists */
+ cnam =
+ xmalloc((unsigned) (strlen(nom) + strlen(aire) + strlen(ext) + 1));
+ sprintf(cnam, "%s%s%s", aire, nom, ext);
+ cnam = b_test_in(cnam);
+ if (!cnam)
+ ocp_abort("opening file");
+ f = ocp_ptr + 1;
+ allocate_ocp_table(f, 13);
+ ocp_file_size(f) = 13;
+ ocp_external(f) = maketexstring(cnam);
+ scan_string_argument();
+ ocp_external_arg(f) = cur_val;
+ ocp_name(f) = get_nullstr();
+ ocp_area(f) = get_nullstr();
+ ocp_state_base(f) = 0;
+ ocp_table_base(f) = 0;
+ ocp_input(f) = 1;
+ ocp_output(f) = 1;
+ ocp_info(f, offset_ocp_info) = 0;
+ ocp_ptr = f;
+ g = f;
+ goto DONE;
+
+ } else {
+ /* Open |ocp_file| for input */
+ char *cname = xmalloc((unsigned)
+ (strlen(nom) + strlen(aire) + strlen(".ocp") +
+ 1));
+ sprintf(cname, "%s%s.ocp", aire, nom);
+ xfree(ocp_buffer);
+ ocp_cur = 0;
+ ocp_size = 0;
+ cnam = luatex_find_file(cname, find_ocp_file_callback);
+ callback_id = callback_defined(read_ocp_file_callback);
+ if (cnam && callback_id > 0) {
+ res = run_callback(callback_id, "S->bSd", cnam,
+ &file_opened, &ocp_buffer, &ocp_size);
+ if (!res)
+ ocp_abort("callback error");
+ if (!file_opened)
+ ocp_abort("opening file");
+ } else {
+ FILE *ocp_file = NULL;
+ if (!cnam)
+ cnam = cname;
+ if (!luatex_open_input
+ (&ocp_file, cnam, kpse_ocp_format, FOPEN_RBIN_MODE, true))
+ ocp_abort("opening file");
+ file_opened = true;
+ res = read_ocp_file(ocp_file, &ocp_buffer, &ocp_size);
+ close_file(ocp_file);
+ if (!res)
+ ocp_abort("reading file");
+ }
+ if (ocp_size == 0)
+ ocp_abort("checking size");
+
+ /* Read the {\.{OCP}} file */
+ f = ocp_ptr + 1;
+ ocpmem_run_ptr = offset_ocp_info;
+ ocp_read(ocp_length);
+ real_ocp_length = ocp_length - 7;
+ ocp_read_all(temp_ocp_input);
+ ocp_read_all(temp_ocp_output);
+ ocp_read_all(temp_ocp_no_tables);
+ ocp_read_all(room_for_tables);
+ ocp_read_all(temp_ocp_no_states);
+ ocp_read_all(room_for_states);
+ if (real_ocp_length !=
+ (temp_ocp_no_tables + room_for_tables +
+ temp_ocp_no_states + room_for_states))
+ ocp_abort("checking size");
+ real_ocp_length = real_ocp_length + 12 +
+ temp_ocp_no_states + temp_ocp_no_tables;
+ allocate_ocp_table(f, real_ocp_length);
+ ocp_external(f) = 0;
+ ocp_external_arg(f) = 0;
+ ocp_file_size(f) = real_ocp_length;
+ ocp_input(f) = temp_ocp_input;
+ ocp_output(f) = temp_ocp_output;
+ ocp_no_tables(f) = temp_ocp_no_tables;
+ ocp_no_states(f) = temp_ocp_no_states;
+ ocp_table_base(f) = ocpmem_run_ptr;
+ if (ocp_no_tables(f) != 0) {
+ previous_address = ocpmem_run_ptr + 2 * (ocp_no_tables(f));
+ for (i = 1; i <= ocp_no_tables(f); i++) {
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address = previous_address + new_offset;
+ }
+ }
+ if (room_for_tables != 0) {
+ for (i = 1; i <= room_for_tables; i++) {
+ ocp_read_info;
+ }
+ }
+ ocp_state_base(f) = ocpmem_run_ptr;
+ if (ocp_no_states(f) != 0) {
+ previous_address = ocpmem_run_ptr + 2 * (ocp_no_states(f));
+ for (i = 1; i <= ocp_no_states(f); i++) {
+ add_to_ocp_info(previous_address);
+ ocp_read_all(new_offset);
+ add_to_ocp_info(new_offset);
+ previous_address = previous_address + new_offset;
+ }
+ }
+ if (room_for_states != 0) {
+ for (i = 1; i <= room_for_states; i++) {
+ ocp_read_info;
+ }
+ }
+ ocp_ptr = f;
+ g = f;
+ goto DONE;
+ }
+ BAD_OCP:
+ {
+ /* Report that the ocp won't be loaded */
+ /* $\Omega$ does not give precise details about why it
+ rejects a particular \.{OCP} file. */
+ const char *hlp[] = {
+ "I wasn't able to read the data for this ocp,",
+ "so I will ignore the ocp specification.",
+ NULL
+ };
+ char errmsg[256];
+ char *c = makecstring(cs_text(u));
+ if (file_opened) {
+ snprintf(errmsg, 255,
+ "Translation process \\%s=%s not loadable: Bad ocp file",
+ c, cnam);
+ } else {
+ snprintf(errmsg, 255,
+ "Translation process \\%s=%s not loadable: ocp file not found",
+ c, cnam);
+ }
+ free(c);
+ tex_error(errmsg, hlp);
+ }
+ DONE:
+ ocp_name(f) = maketexstring(nom);
+ ocp_area(f) = maketexstring(aire);
+ return g;
+}
diff --git a/Build/source/texk/web2c/luatexdir/ocp/runocp.h b/Build/source/texk/web2c/luatexdir/ocp/runocp.h
new file mode 100644
index 00000000000..bf94918dc2e
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ocp/runocp.h
@@ -0,0 +1,60 @@
+/* runocp.h
+
+ Copyright 2006-2009 Taco Hoekwater <taco@luatex.org>
+
+ This file is part of LuaTeX.
+
+ LuaTeX is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 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 General Public License along
+ with LuaTeX; if not, see <http://www.gnu.org/licenses/>. */
+
+/* $Id: runocp.h 3302 2009-12-25 12:49:14Z oneiros $ */
+
+#ifndef RUNOCP_H
+
+# define RUNOCP_H 1
+
+# define active_mem_size 50000 /* number of words of |active_info| for active ocps */
+
+typedef int active_index;
+
+extern memory_word active_info[(active_mem_size + 1)];
+extern active_index active_min_ptr;
+extern active_index active_max_ptr;
+extern active_index active_real;
+
+# define active_ocp(A) active_info[(A)].hh.u.B0
+# define active_counter(A) active_info[(A)].hh.u.B1
+# define active_lstack_no(A) active_info[(A)+1].cint
+
+extern boolean is_last_ocp(scaled llstack_no, int counter);
+
+extern void print_active_ocps(void);
+extern void add_ocp_stack(int min_index, scaled min_value);
+extern void active_compile(void);
+
+extern void run_ocp(void);
+extern void run_otp(void);
+
+extern void do_push_ocp_list(small_number a);
+extern void do_pop_ocp_list(small_number a);
+extern void do_clear_ocp_lists(small_number a);
+
+extern void dump_active_ocp_info(void);
+extern void undump_active_ocp_info(void);
+
+extern void initialize_ocp_buffers(int ocp_buf_size, int ocp_stack_size);
+
+/* for ocplist.h */
+/* typedef int ocp_list_index ; */
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/ocp/runocp.w b/Build/source/texk/web2c/luatexdir/ocp/runocp.w
new file mode 100644
index 00000000000..51d28c6ebc8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ocp/runocp.w
@@ -0,0 +1,1069 @@
+% runocp.w
+%
+% Copyright 2006-2009 Taco Hoekwater <taco@@luatex.org>
+
+% This file is part of LuaTeX.
+
+% LuaTeX is free software; you can redistribute it and/or modify it under
+% the terms of the GNU General Public License as published by the Free
+% Software Foundation; either version 2 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 General Public License along
+% with LuaTeX; if not, see <http://www.gnu.org/licenses/>.
+
+@ @c
+#include "ptexlib.h"
+
+
+static const char _svn_version[] =
+ "$Id: runocp.w 3584 2010-04-02 17:45:55Z hhenkel $ "
+"$URL: http://foundry.supelec.fr/svn/luatex/tags/beta-0.60.0/source/texk/web2c/luatexdir/ocp/runocp.w $";
+
+memory_word active_info[(active_mem_size + 1)];
+active_index active_min_ptr = 0; /* first unused word of |active_info| */
+active_index active_max_ptr = 0; /* last unused word of |active_info| */
+active_index active_real = 0;
+
+static ocp_list_index holding[(active_mem_size + 1)] = { 0 };
+
+@ Here we do the main work required for reading and interpreting
+ $\Omega$ Compiled Translation Processes.
+
+@c
+#define ocp_list_id_text(A) cs_text(ocp_list_id_base+(A))
+
+#define ocp_active_min_ptr_base (ocp_active_number_base+1)
+#define ocp_active_max_ptr_base (ocp_active_min_ptr_base+1)
+#define ocp_active_base (ocp_active_max_ptr_base+1)
+
+
+@ Here are all the instructions in our mini-assembler.
+
+@c
+typedef enum {
+ otp_right_output = 1,
+ otp_right_num = 2,
+ otp_right_char = 3,
+ otp_right_lchar = 4,
+ otp_right_some = 5,
+ otp_pback_output = 6,
+ otp_pback_num = 7,
+ otp_pback_char = 8,
+ otp_pback_lchar = 9,
+ otp_pback_some = 10,
+ otp_add = 11,
+ otp_sub = 12,
+ otp_mult = 13,
+ otp_div = 14,
+ otp_mod = 15,
+ otp_lookup = 16,
+ otp_push_num = 17,
+ otp_push_char = 18,
+ otp_push_lchar = 19,
+ otp_state_change = 20,
+ otp_state_push = 21,
+ otp_state_pop = 22,
+ otp_left_start = 23,
+ otp_left_return = 24,
+ otp_left_backup = 25,
+ otp_goto = 26,
+ otp_goto_ne = 27,
+ otp_goto_eq = 28,
+ otp_goto_lt = 29,
+ otp_goto_le = 30,
+ otp_goto_gt = 31,
+ otp_goto_ge = 32,
+ otp_goto_no_advance = 33,
+ otp_goto_beg = 34,
+ otp_goto_end = 35,
+ otp_stop = 36
+} otp_command_codes;
+
+#define check_buffer() do { \
+ if (last==buf_size-2) { \
+ check_buffer_overflow(buf_size+4); \
+ } \
+ } while (0)
+
+@ Of course we want to define macros that suppress the detail of how ocp
+information is actually packed, so that we don't have to write things like
+$$\hbox{|ocp_info[k+ocp_info[j+ocp_state_base[i]]]|}$$
+too often. The \.{WEB} definitions here make |ocp_state_entry(i)(j)(k)|
+(|ocp_table_entry(i)(j)(k)|) the |k|-th word in the |j|-th state (table)
+of the |i|-th ocp.
+@^inner loop@>
+
+@c
+#define ocp_state_entry(A,B,C) ocp_tables[(A)][ocp_tables[(A)][ocp_state_base((A))+((B)*2)]+(C)]
+
+#define ocp_state_no(A,B) ocp_tables[(A)][ocp_state_base(A)+((B)*2)+1]
+
+#define ocp_table_entry(A,B,C) ocp_tables[(A)][ocp_tables[(A)][ocp_table_base((A))+(B)*2]+(C)]
+
+#define ocp_table_no(A,B) ocp_tables[(A)][ocp_table_base((A))+((B)*2)+1]
+
+#define otp_cur_state otp_states[otp_state_ptr]
+
+#define tsuccumb pdftex_fail
+
+halfword otp_init_input_start;
+halfword otp_init_input_last;
+halfword otp_init_input_end;
+quarterword *otp_init_input_buf;
+
+halfword otp_input_start;
+halfword otp_input_last;
+halfword otp_input_end;
+quarterword *otp_input_buf;
+
+halfword otp_output_end;
+quarterword *otp_output_buf;
+
+halfword otp_stack_used;
+halfword otp_stack_last;
+halfword otp_stack_new;
+quarterword *otp_stack_buf;
+
+halfword otp_pc;
+
+halfword otp_calc_ptr;
+halfword *otp_calcs;
+halfword otp_state_ptr;
+halfword *otp_states;
+
+halfword otp_input_char;
+halfword otp_calculated_char;
+halfword otp_no_input_chars;
+
+halfword otp_instruction;
+halfword otp_instr;
+halfword otp_arg;
+halfword otp_first_arg;
+halfword otp_second_arg;
+
+halfword otp_input_ocp;
+
+boolean otp_finished;
+int otp_ext_str;
+int otp_ext_str_arg;
+int otp_ext_i;
+
+#define otp_set_instruction() do { \
+ if (otp_pc>=ocp_state_no(otp_input_ocp,otp_cur_state)) { \
+ tsuccumb("bad OCP program -- PC not valid"); \
+ } \
+ otp_instruction=ocp_state_entry(otp_input_ocp,otp_cur_state,otp_pc); \
+ otp_instr=otp_instruction / 0x1000000; \
+ otp_arg=otp_instruction % 0x1000000; \
+ } while (0)
+
+
+#define otp_check_char(A) do { \
+ if ((1>(A)) || ((A)>otp_no_input_chars)) { \
+ tsuccumb("right hand side of OCP expression is bad"); \
+ } \
+ } while (0)
+
+
+#define otp_get_char(A) do { \
+ otp_check_char((A)); \
+ if ((A)>otp_stack_last) { \
+ otp_calculated_char=otp_input_buf[otp_input_start+(A)-otp_stack_last]; \
+ } else { \
+ otp_calculated_char=otp_stack_buf[(A)]; \
+ } \
+ } while (0)
+
+
+@ @c
+void overflow_ocp_buf_size(void)
+{
+ overflow("ocp_buf_size", (unsigned) ocp_buf_size);
+}
+
+void overflow_ocp_stack_size(void)
+{
+ overflow("ocp_stack_size", (unsigned) ocp_stack_size);
+}
+
+void run_otp(void)
+{
+ halfword otp_counter;
+ otp_set_instruction();
+ switch (otp_instr) {
+ /* Run the |otp_right| instructions */
+ case otp_right_output:
+ incr(otp_output_end);
+ if (otp_output_end > ocp_buf_size)
+ overflow_ocp_buf_size();
+ otp_output_buf[otp_output_end] = (quarterword) otp_calcs[otp_calc_ptr];
+ decr(otp_calc_ptr);
+ incr(otp_pc);
+ break;
+ case otp_right_num:
+ incr(otp_output_end);
+ if (otp_output_end > ocp_buf_size)
+ overflow_ocp_buf_size();
+ otp_output_buf[otp_output_end] = (quarterword) otp_arg;
+ incr(otp_pc);
+ break;
+ case otp_right_char:
+ otp_get_char(otp_arg);
+ incr(otp_output_end);
+ if (otp_output_end > ocp_buf_size)
+ overflow_ocp_buf_size();
+ otp_output_buf[otp_output_end] = (quarterword) otp_calculated_char;
+ incr(otp_pc);
+ break;
+ case otp_right_lchar:
+ otp_get_char(otp_no_input_chars - otp_arg);
+ incr(otp_output_end);
+ if (otp_output_end > ocp_buf_size)
+ overflow_ocp_buf_size();
+ otp_output_buf[otp_output_end] = (quarterword) otp_calculated_char;
+ incr(otp_pc);
+ break;
+ case otp_right_some:
+ otp_first_arg = otp_arg + 1;
+ incr(otp_pc);
+ otp_set_instruction();
+ otp_second_arg = otp_no_input_chars - otp_arg;
+ for (otp_counter = otp_first_arg; otp_counter <= otp_second_arg;
+ otp_counter++) {
+ otp_get_char(otp_counter);
+ incr(otp_output_end);
+ if (otp_output_end > ocp_buf_size)
+ overflow_ocp_buf_size();
+ otp_output_buf[otp_output_end] = (quarterword) otp_calculated_char;
+ }
+ incr(otp_pc);
+ break;
+
+ /* Run the |otp_pback| instructions */
+ case otp_pback_output:
+ incr(otp_stack_new);
+ if (otp_stack_new >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_stack_buf[otp_stack_new] = (quarterword) otp_calcs[otp_calc_ptr];
+ decr(otp_calc_ptr);
+ incr(otp_pc);
+ break;
+ case otp_pback_num:
+ incr(otp_stack_new);
+ if (otp_stack_new >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_stack_buf[otp_stack_new] = (quarterword) otp_arg;
+ incr(otp_pc);
+ break;
+ case otp_pback_char:
+ otp_get_char(otp_arg);
+ incr(otp_stack_new);
+ if (otp_stack_new >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_stack_buf[otp_stack_new] = (quarterword) otp_calculated_char;
+ incr(otp_pc);
+ break;
+ case otp_pback_lchar:
+ otp_get_char(otp_no_input_chars - otp_arg);
+ incr(otp_stack_new);
+ if (otp_stack_new >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_stack_buf[otp_stack_new] = (quarterword) otp_calculated_char;
+ incr(otp_pc);
+ break;
+ case otp_pback_some:
+ otp_first_arg = otp_arg + 1;
+ incr(otp_pc);
+ otp_set_instruction();
+ otp_second_arg = otp_no_input_chars - otp_arg;
+ for (otp_counter = otp_first_arg; otp_counter <= otp_second_arg;
+ otp_counter++) {
+ otp_get_char(otp_counter);
+ incr(otp_stack_new);
+ if (otp_stack_new >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_stack_buf[otp_stack_new] = (quarterword) otp_calculated_char;
+ }
+ incr(otp_pc);
+ break;
+
+ /* Run the arithmetic instructions */
+ case otp_add:
+ otp_calcs[otp_calc_ptr - 1] =
+ otp_calcs[otp_calc_ptr - 1] + otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ break;
+ case otp_sub:
+ otp_calcs[otp_calc_ptr - 1] =
+ otp_calcs[otp_calc_ptr - 1] - otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ break;
+ case otp_mult:
+ otp_calcs[otp_calc_ptr - 1] =
+ otp_calcs[otp_calc_ptr - 1] * otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ break;
+ case otp_div:
+ otp_calcs[otp_calc_ptr - 1] =
+ otp_calcs[otp_calc_ptr - 1] / otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ break;
+ case otp_mod:
+ otp_calcs[otp_calc_ptr - 1] =
+ otp_calcs[otp_calc_ptr - 1] % otp_calcs[otp_calc_ptr];
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ break;
+ case otp_lookup:
+ if (otp_calcs[otp_calc_ptr] >=
+ ocp_table_no(otp_input_ocp, otp_calcs[otp_calc_ptr - 1])) {
+ tsuccumb("bad OCP program -- table index not valid");
+ }
+ otp_calcs[otp_calc_ptr - 1] =
+ ocp_table_entry(otp_input_ocp, otp_calcs[otp_calc_ptr - 1],
+ otp_calcs[otp_calc_ptr]);
+ incr(otp_pc);
+ decr(otp_calc_ptr);
+ break;
+ case otp_push_num:
+ incr(otp_calc_ptr);
+ if (otp_calc_ptr >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_calcs[otp_calc_ptr] = otp_arg;
+ incr(otp_pc);
+ break;
+ case otp_push_char:
+ otp_get_char(otp_arg);
+ incr(otp_calc_ptr);
+ if (otp_calc_ptr >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_calcs[otp_calc_ptr] = otp_calculated_char;
+ incr(otp_pc);
+ break;
+ case otp_push_lchar:
+ otp_get_char(otp_no_input_chars - otp_arg);
+ incr(otp_calc_ptr);
+ if (otp_calc_ptr >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_calcs[otp_calc_ptr] = otp_calculated_char;
+ incr(otp_pc);
+ break;
+
+ /* Run the |otp_state| instructions */
+ case otp_state_change:
+ otp_input_start = otp_input_last;
+ for (otp_counter = 1; otp_counter <= (otp_stack_new - otp_stack_used);
+ otp_counter++) {
+ otp_stack_buf[otp_counter] =
+ otp_stack_buf[otp_counter + otp_stack_used];
+ }
+ otp_stack_new = otp_stack_new - otp_stack_used;
+ otp_stack_last = otp_stack_new;
+ otp_stack_used = 0;
+ otp_states[otp_state_ptr] = otp_arg;
+ otp_pc = 0;
+ break;
+ case otp_state_push:
+ otp_input_start = otp_input_last;
+ for (otp_counter = 1; otp_counter <= (otp_stack_new - otp_stack_used);
+ otp_counter++) {
+ otp_stack_buf[otp_counter] =
+ otp_stack_buf[otp_counter + otp_stack_used];
+ };
+ otp_stack_new = otp_stack_new - otp_stack_used;
+ otp_stack_last = otp_stack_new;
+ otp_stack_used = 0;
+ incr(otp_state_ptr);
+ if (otp_state_ptr >= ocp_stack_size)
+ overflow_ocp_stack_size();
+ otp_states[otp_state_ptr] = otp_arg;
+ otp_pc = 0;
+ break;
+ case otp_state_pop:
+ otp_input_start = otp_input_last;
+ for (otp_counter = 1; otp_counter <= (otp_stack_new - otp_stack_used);
+ otp_counter++) {
+ otp_stack_buf[otp_counter] =
+ otp_stack_buf[otp_counter + otp_stack_used];
+ }
+ otp_stack_new = otp_stack_new - otp_stack_used;
+ otp_stack_last = otp_stack_new;
+ otp_stack_used = 0;
+ if (otp_state_ptr > 0)
+ decr(otp_state_ptr);
+ otp_pc = 0;
+ break;
+
+ /* Run the |otp_left| instructions */
+ case otp_left_start:
+ otp_input_start = otp_input_last;
+ otp_input_last = otp_input_start;
+ otp_stack_used = 0;
+ if ((otp_stack_last == 0) && (otp_input_last >= otp_input_end)) {
+ otp_finished = true;
+ } else if ((otp_stack_used < otp_stack_last)) {
+ incr(otp_stack_used); /* no overflow problem */
+ otp_input_char = otp_stack_buf[otp_stack_used];
+ otp_no_input_chars = 1;
+ incr(otp_pc);
+ } else {
+ incr(otp_input_last); /* no overflow problem */
+ otp_input_char = otp_input_buf[otp_input_last];
+ otp_no_input_chars = 1;
+ incr(otp_pc);
+ }
+ break;
+ case otp_left_return:
+ otp_input_last = otp_input_start;
+ otp_stack_used = 0;
+ if ((otp_stack_used < otp_stack_last)) {
+ incr(otp_stack_used); /* no overflow problem */
+ otp_input_char = otp_stack_buf[otp_stack_used];
+ otp_no_input_chars = 1;
+ incr(otp_pc);
+ } else {
+ incr(otp_input_last); /* no overflow problem */
+ otp_input_char = otp_input_buf[otp_input_last];
+ otp_no_input_chars = 1;
+ incr(otp_pc);
+ }
+ break;
+ case otp_left_backup:
+ if (otp_input_start < otp_input_last) {
+ decr(otp_input_last);
+ otp_input_char = otp_input_buf[otp_input_last];
+ } else {
+ decr(otp_stack_used);
+ otp_input_char = otp_stack_buf[otp_stack_used];
+ }
+ decr(otp_no_input_chars);
+ incr(otp_pc);
+ break;
+
+ /* Run the |otp_goto| instructions */
+ case otp_goto:
+ otp_pc = otp_arg;
+ break;
+ case otp_goto_ne:
+ otp_first_arg = otp_arg;
+ incr(otp_pc);
+ otp_set_instruction();
+ if (otp_input_char != otp_first_arg) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_pc);
+ }
+ break;
+ case otp_goto_eq:
+ otp_first_arg = otp_arg;
+ incr(otp_pc);
+ otp_set_instruction();
+ if (otp_input_char == otp_first_arg) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_pc);
+ }
+ break;
+ case otp_goto_lt:
+ otp_first_arg = otp_arg;
+ incr(otp_pc);
+ otp_set_instruction();
+ if (otp_input_char < otp_first_arg) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_pc);
+ }
+ break;
+ case otp_goto_le:
+ otp_first_arg = otp_arg;
+ incr(otp_pc);
+ otp_set_instruction();
+ if (otp_input_char <= otp_first_arg) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_pc);
+ }
+ break;
+ case otp_goto_gt:
+ otp_first_arg = otp_arg;
+ incr(otp_pc);
+ otp_set_instruction();
+ if (otp_input_char > otp_first_arg) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_pc);
+ }
+ break;
+ case otp_goto_ge:
+ otp_first_arg = otp_arg;
+ incr(otp_pc);
+ otp_set_instruction();
+ if (otp_input_char >= otp_first_arg) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_pc);
+ }
+ break;
+ case otp_goto_no_advance:
+ if (otp_stack_used < otp_stack_last) {
+ incr(otp_stack_used); /* no overflow problem */
+ otp_input_char = otp_stack_buf[otp_stack_used];
+ incr(otp_no_input_chars); /* no overflow problem */
+ incr(otp_pc);
+ } else if (otp_input_last >= otp_input_end) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_input_last); /* no overflow problem */
+ otp_input_char = otp_input_buf[otp_input_last];
+ incr(otp_no_input_chars); /* no overflow problem */
+ incr(otp_pc);
+ }
+ break;
+ case otp_goto_beg:
+ if (otp_input_last == 0) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_pc);
+ }
+ break;
+ case otp_goto_end:
+ if (otp_input_last >= otp_input_end) {
+ otp_pc = otp_arg;
+ } else {
+ incr(otp_pc);
+ }
+ break;
+
+ /* Run the |otp_stop| instruction */
+ case otp_stop:
+ otp_input_start = otp_input_last;
+ for (otp_counter = 1; otp_counter <= (otp_stack_new - otp_stack_used);
+ otp_counter++) {
+ otp_stack_buf[otp_counter] =
+ otp_stack_buf[otp_counter + otp_stack_used];
+ }
+ otp_stack_new = otp_stack_new - otp_stack_used;
+ otp_stack_last = otp_stack_new;
+ otp_stack_used = 0;
+ otp_pc = 0;
+ break;
+
+ default:
+ tsuccumb("bad OCP program -- unknown instruction");
+ break;
+ }
+}
+
+@ @c
+#define FPUTC(a,b) fputc((int)(a),b)
+
+void run_external_ocp(char *external_ocp_name)
+{
+ char *in_file_name;
+ char *out_file_name;
+ FILE *in_file;
+ FILE *out_file;
+ char command_line[400];
+ int i;
+ unsigned c;
+ int c_in;
+#ifdef WIN32
+ char *tempenv;
+
+# define null_string(s) ((s == NULL) || (*s == '\0'))
+
+ tempenv = getenv("TMPDIR");
+ if (null_string(tempenv))
+ tempenv = getenv("TEMP");
+ if (null_string(tempenv))
+ tempenv = getenv("TMP");
+ if (null_string(tempenv))
+ tempenv = "c:/tmp"; /* "/tmp" is not good if we are on a CD-ROM */
+ in_file_name = concat(tempenv, "/__aleph__in__XXXXXX");
+ mktemp(in_file_name);
+ in_file = fopen(in_file_name, FOPEN_WBIN_MODE);
+#else
+ int in_file_fd;
+ int out_file_fd;
+ in_file_name = strdup("/tmp/__aleph__in__XXXXXX");
+ in_file_fd = mkstemp(in_file_name);
+ in_file = fdopen(in_file_fd, FOPEN_WBIN_MODE);
+#endif /* WIN32 */
+
+
+ for (i = 1; i <= otp_input_end; i++) {
+ c = otp_input_buf[i];
+ if (c > 0xffff) {
+ fprintf(stderr, "Aleph does not currently support 31-bit chars\n");
+ exit(1);
+ }
+ if (c > 0x4000000) {
+ FPUTC(0xfc | ((c >> 30) & 0x1), in_file);
+ FPUTC(0x80 | ((c >> 24) & 0x3f), in_file);
+ FPUTC(0x80 | ((c >> 18) & 0x3f), in_file);
+ FPUTC(0x80 | ((c >> 12) & 0x3f), in_file);
+ FPUTC(0x80 | ((c >> 6) & 0x3f), in_file);
+ FPUTC(0x80 | (c & 0x3f), in_file);
+ } else if (c > 0x200000) {
+ FPUTC(0xf8 | ((c >> 24) & 0x3), in_file);
+ FPUTC(0x80 | ((c >> 18) & 0x3f), in_file);
+ FPUTC(0x80 | ((c >> 12) & 0x3f), in_file);
+ FPUTC(0x80 | ((c >> 6) & 0x3f), in_file);
+ FPUTC(0x80 | (c & 0x3f), in_file);
+ } else if (c > 0x10000) {
+ FPUTC(0xf0 | ((c >> 18) & 0x7), in_file);
+ FPUTC(0x80 | ((c >> 12) & 0x3f), in_file);
+ FPUTC(0x80 | ((c >> 6) & 0x3f), in_file);
+ FPUTC(0x80 | (c & 0x3f), in_file);
+ } else if (c > 0x800) {
+ FPUTC(0xe0 | ((c >> 12) & 0xf), in_file);
+ FPUTC(0x80 | ((c >> 6) & 0x3f), in_file);
+ FPUTC(0x80 | (c & 0x3f), in_file);
+ } else if (c > 0x80) {
+ FPUTC(0xc0 | ((c >> 6) & 0x1f), in_file);
+ FPUTC(0x80 | (c & 0x3f), in_file);
+ } else {
+ FPUTC(c & 0x7f, in_file);
+ }
+ }
+ fclose(in_file);
+
+#define advance_cin if ((c_in = fgetc(out_file)) == -1) { \
+ fprintf(stderr, "File contains bad char\n"); \
+ goto end_of_while; \
+ }
+
+#ifdef WIN32
+ out_file_name = concat(tempenv, "/__aleph__out__XXXXXX");
+ mktemp(out_file_name);
+ out_file = fopen(out_file_name, FOPEN_RBIN_MODE);
+#else
+ out_file_name = strdup("/tmp/__aleph__out__XXXXXX");
+ out_file_fd = mkstemp(out_file_name);
+ out_file = fdopen(out_file_fd, FOPEN_RBIN_MODE);
+#endif
+
+ sprintf(command_line, "%s <%s >%s\n",
+ external_ocp_name + 1, in_file_name, out_file_name);
+ system(command_line);
+ otp_output_end = 0;
+ otp_output_buf[otp_output_end] = 0;
+ while ((c_in = (int) fgetc(out_file)) != -1) {
+ if (c_in >= 0xfc) {
+ c = (unsigned) (c_in & 0x1) << 30;
+ advance_cin;
+ c |= (c_in & 0x3f) << 24;
+ advance_cin;
+ c |= (c_in & 0x3f) << 18;
+ advance_cin;
+ c |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c |= (c_in & 0x3f);
+ } else if (c_in >= 0xf8) {
+ c = (unsigned) (c_in & 0x3) << 24;
+ advance_cin;
+ c |= (c_in & 0x3f) << 18;
+ advance_cin;
+ c |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c |= (c_in & 0x3f);
+ } else if (c_in >= 0xf0) {
+ c = (unsigned) (c_in & 0x7) << 18;
+ advance_cin;
+ c |= (c_in & 0x3f) << 12;
+ advance_cin;
+ c |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c |= (c_in & 0x3f);
+ } else if (c_in >= 0xe0) {
+ c = (unsigned) (c_in & 0xf) << 12;
+ advance_cin;
+ c |= (c_in & 0x3f) << 6;
+ advance_cin;
+ c |= (c_in & 0x3f);
+ } else if (c_in >= 0x80) {
+ c = (unsigned) (c_in & 0x1f) << 6;
+ advance_cin;
+ c |= (c_in & 0x3f);
+ } else {
+ c = (unsigned) (c_in & 0x7f);
+ }
+ otp_output_buf[++otp_output_end] = (quarterword) c;
+ }
+ fclose(out_file);
+
+ end_of_while:
+ remove(in_file_name);
+ remove(out_file_name);
+}
+
+@ @c
+void run_ocp(void)
+{
+ int t = 0;
+ halfword otp_i;
+ halfword otp_counter;
+ /* The OTP input buffer is an array of 16-bit values.
+ The range |0xD800| \dots |0xDFFF| is used for surrogate pairs,
+ so it cannot be used for simple 16-bit values like it is in
+ Omega, and incompatibility with Aleph is unavoidable.
+ */
+
+ otp_init_input_end = 0;
+ while ((cur_cmd == letter_cmd) || (cur_cmd == other_char_cmd) ||
+ (cur_cmd == char_given_cmd) || (cur_cmd == spacer_cmd)) {
+ incr(otp_init_input_end);
+ if (otp_init_input_end > ocp_buf_size)
+ overflow_ocp_buf_size();
+ /* |cur_chr| can cover the full range |0..0x10FFFF| */
+ if (cur_chr < 0x10000) {
+ otp_init_input_buf[otp_init_input_end] = (quarterword) cur_chr;
+ } else {
+ otp_init_input_buf[otp_init_input_end] = (quarterword)
+ (((cur_chr - 0x10000) / 0x400) + 0xD800);
+ incr(otp_init_input_end);
+ if (otp_init_input_end > ocp_buf_size)
+ overflow_ocp_buf_size();
+ otp_init_input_buf[otp_init_input_end] = (quarterword)
+ (((cur_chr - 0x10000) % 0x400) + 0xDC00);
+ }
+ get_token();
+ if ((cur_cmd != letter_cmd) && (cur_cmd != other_char_cmd) &&
+ (cur_cmd != char_given_cmd)) {
+ x_token();
+ if (cur_cmd == char_num_cmd) {
+ scan_char_num();
+ cur_cmd = other_char_cmd;
+ cur_chr = cur_val;
+ }
+ }
+ }
+ back_input();
+ otp_input_end = otp_init_input_end;
+ for (otp_i = 0; otp_i <= otp_init_input_end; otp_i++) {
+ otp_input_buf[otp_i] = otp_init_input_buf[otp_i];
+ }
+
+ otp_input_ocp = active_ocp(active_real);
+ if (otp_input_ocp == 0) {
+ tex_error("Null ocp being used: all input lost", NULL);
+ otp_output_end = 0;
+ } else if (ocp_external(otp_input_ocp) == 0) {
+ otp_input_start = 0;
+ otp_input_last = 0;
+ otp_stack_used = 0;
+ otp_stack_last = 0;
+ otp_stack_new = 0;
+ otp_output_end = 0;
+ otp_pc = 0;
+ otp_finished = false;
+ otp_calc_ptr = 0;
+ otp_calcs[otp_calc_ptr] = 0;
+ otp_state_ptr = 0;
+ otp_states[otp_state_ptr] = 0;
+ while (!otp_finished)
+ run_otp();
+ } else {
+ /* k=0; ? */
+ char *cmd = makecstring(ocp_external(otp_input_ocp));
+ char *arg = makecstring(ocp_external_arg(otp_input_ocp));
+ char *cmdline = xmalloc((unsigned) (strlen(cmd) + strlen(arg) + 3));
+ strcpy(cmdline, cmd);
+ strcat(cmdline, " ");
+ strcat(cmdline, arg);
+ xfree(cmd);
+ xfree(arg);
+ run_external_ocp(cmdline);
+ }
+
+
+ /* The OTP output buffer is an array of 16-bit values. To convert back
+ to the |buffer| it has to be re-encoded into UTF-8.
+ */
+
+ if ((first + otp_output_end) >= ocp_buf_size)
+ overflow_ocp_buf_size();
+ push_input();
+ current_ocp_lstack = active_lstack_no(active_real);
+ current_ocp_no = (short) active_counter(active_real);
+ istate = mid_line;
+ istart = first;
+ last = istart;
+ iloc = istart;
+ line_catcode_table = DEFAULT_CAT_TABLE;
+ line_partial = false;
+ for (otp_counter = 1; otp_counter <= otp_output_end; otp_counter++) {
+ /* convert back to utf-8 */
+ t = otp_output_buf[otp_counter];
+ if (otp_counter < otp_output_end) {
+ if ((t >= 0xD800) && (t < 0xDC00)) {
+ if ((otp_output_buf[otp_counter + 1] >= 0xDC00)
+ && (otp_output_buf[otp_counter + 1] < 0xE000)) {
+ incr(otp_counter);
+ t = (t - 0xD800) * 0x400 + (otp_output_buf[otp_counter] -
+ 0xDC00) + 0x10000;
+ }
+ } else if ((t >= 0xDC00) && (t < 0xE000)) {
+ if ((otp_output_buf[otp_counter + 1] >= 0xD800)
+ && (otp_output_buf[otp_counter + 1] < 0xDC00)) {
+ incr(otp_counter);
+ t = (otp_output_buf[otp_counter] - 0xD800) * 0x400 + (t -
+ 0xDC00)
+ + 0x10000;
+ }
+ }
+ }
+ if (t <= 0x7F) {
+ buffer[last] = (packed_ASCII_code) t;
+ } else if (t <= 0x7FF) {
+ buffer[last] = (packed_ASCII_code) (0xC0 + t / 0x40);
+ incr(last);
+ check_buffer();
+ buffer[last] = (packed_ASCII_code) (0x80 + t % 0x40);
+ } else if (t <= 0xFFFF) {
+ buffer[last] = (packed_ASCII_code) (0xE0 + t / 0x1000);
+ incr(last);
+ check_buffer();
+ buffer[last] = (packed_ASCII_code) (0x80 + (t % 0x1000) / 0x40);
+ incr(last);
+ check_buffer();
+ buffer[last] = (packed_ASCII_code) (0x80 + (t % 0x1000) % 0x40);
+ } else {
+ buffer[last] = (packed_ASCII_code) (0xF0 + t / 0x400000);
+ incr(last);
+ check_buffer();
+ buffer[last] = (packed_ASCII_code) (0x80 + (t % 0x40000) / 0x1000);
+ incr(last);
+ check_buffer();
+ buffer[last] =
+ (packed_ASCII_code) (0x80 + ((t % 0x40000) % 0x1000) / 0x40);
+ incr(last);
+ check_buffer();
+ buffer[last] =
+ (packed_ASCII_code) (0x80 + ((t % 0x40000) % 0x1000) % 0x40);
+ }
+ incr(last);
+ check_buffer();
+ }
+ ilimit = last - 1;
+ if (t > 0xFFFF)
+ decr(ilimit);
+ if (t > 0x7FF)
+ decr(ilimit);
+ if (t > 0x7F)
+ decr(ilimit);
+ first = last;
+
+}
+
+@ @c
+void initialize_ocp_buffers(int ocp_buf_size, int ocp_stack_size)
+{
+ otp_init_input_buf = xmallocarray(quarterword, (unsigned) ocp_buf_size);
+ otp_input_buf = xmallocarray(quarterword, (unsigned) ocp_buf_size);
+ otp_output_buf = xmallocarray(quarterword, (unsigned) ocp_buf_size);
+ otp_stack_buf = xmallocarray(quarterword, (unsigned) ocp_stack_size);
+ otp_calcs = xmallocarray(halfword, (unsigned) ocp_stack_size);
+ otp_states = xmallocarray(halfword, (unsigned) ocp_stack_size);
+}
+
+@ @c
+boolean is_last_ocp(scaled llstack_no, int counter)
+{
+ active_min_ptr = equiv(ocp_active_min_ptr_base);
+ active_max_ptr = equiv(ocp_active_max_ptr_base);
+ active_real = active_min_ptr;
+ while ((active_real < active_max_ptr) &&
+ (active_lstack_no(active_real) < llstack_no)) {
+ active_real = active_real + 2;
+ }
+ while ((active_real < active_max_ptr) &&
+ (active_lstack_no(active_real) == llstack_no) &&
+ (active_counter(active_real) <= counter)) {
+ active_real = active_real + 2;
+ }
+ return (active_real == active_max_ptr);
+}
+
+@ @c
+void print_active_ocps(void)
+{
+ int i;
+ tprint_nl("Active ocps: [");
+ i = active_min_ptr;
+ while (i < active_max_ptr) {
+ tprint("(");
+ print_scaled(active_lstack_no(i));
+ tprint(",");
+ print_int(active_counter(i));
+ tprint(",");
+ print_esc(cs_text(ocp_id_base + active_ocp(i)));
+ tprint(")");
+ if (i != (active_max_ptr - 2))
+ tprint(",");
+ i = i + 2;
+ }
+ tprint("]");
+}
+
+@ @c
+void add_ocp_stack(int min_index, scaled min_value)
+{
+ ocp_lstack_index p;
+ scaled llstack_no;
+ int counter;
+ scaled m;
+ m = min_value; /* TH: whatever this is .. */
+ p = ocp_list_lstack(holding[min_index]);
+ llstack_no = ocp_list_lstack_no(holding[min_index]);
+ counter = 0;
+ while (!(is_null_ocp_lstack(p))) {
+ active_ocp(active_max_ptr) = ocp_lstack_ocp(p);
+ active_counter(active_max_ptr) = (quarterword) counter;
+ active_lstack_no(active_max_ptr) = llstack_no;
+ p = ocp_lstack_lnext(p);
+ active_max_ptr = active_max_ptr + 2;
+ incr(counter); /* no overflow problem */
+ }
+}
+
+@ @c
+void active_compile(void)
+{
+ int i;
+ int min_index;
+ scaled min_stack_ocp;
+ scaled old_min;
+ int max_active;
+ scaled stack_value;
+ active_min_ptr = active_max_ptr;
+ min_stack_ocp = ocp_maxint;
+ max_active = equiv(ocp_active_number_base) - 1;
+ min_index = max_active; /* TH I hope ... */
+ for (i = max_active; i >= 0; i--) {
+ holding[i] = ocp_list_list[ocp_active_base + i];
+ stack_value = ocp_list_lstack_no(holding[i]);
+ if (stack_value < min_stack_ocp) {
+ min_index = i;
+ min_stack_ocp = stack_value;
+ }
+ }
+ while (min_stack_ocp < ocp_maxint) {
+ add_ocp_stack(min_index, min_stack_ocp);
+ old_min = min_stack_ocp;
+ min_stack_ocp = ocp_maxint;
+ for (i = max_active; i >= 0; i--) {
+ stack_value = ocp_list_lstack_no(holding[i]);
+ while (old_min == stack_value) {
+ holding[i] = ocp_list_lnext(holding[i]);
+ stack_value = ocp_list_lstack_no(holding[i]);
+ }
+ if (stack_value < min_stack_ocp) {
+ min_index = i;
+ min_stack_ocp = stack_value;
+ }
+ }
+ }
+}
+
+@ @c
+void do_push_ocp_list(small_number a)
+{
+ halfword ocp_list_no;
+ halfword old_number;
+ int i;
+ scan_ocp_list_ident();
+ ocp_list_no = cur_val;
+ old_number = equiv(ocp_active_number_base);
+ define(ocp_active_base + old_number, data_cmd, ocp_list_no);
+ define(ocp_active_number_base, data_cmd, (old_number + 1));
+ if (ocp_trace_level == 1) {
+ tprint_nl("New active ocp list: {");
+ for (i = old_number; i >= 0; i--) {
+ print_esc(ocp_list_id_text(equiv(ocp_active_base + i)));
+ tprint("=");
+ print_ocp_list(ocp_list_list[equiv(ocp_active_base + i)]);
+ if (i != 0)
+ tprint(",");
+ }
+ tprint("}");
+ }
+ active_compile();
+ define(ocp_active_min_ptr_base, data_cmd, active_min_ptr);
+ define(ocp_active_max_ptr_base, data_cmd, active_max_ptr);
+}
+
+@ @c
+void do_pop_ocp_list(small_number a)
+{
+ halfword old_number;
+ int i;
+ old_number = equiv(ocp_active_number_base);
+ if (old_number == 0) {
+ print_err("No active ocp lists to be popped");
+ } else {
+ define(ocp_active_number_base, data_cmd, (old_number - 1));
+ if (ocp_trace_level == 1) {
+ tprint_nl("New active ocp list: {");
+ for (i = (old_number - 2); i >= 0; i++) {
+ print_esc(ocp_list_id_text(equiv(ocp_active_base + i)));
+ tprint("=");
+ print_ocp_list(ocp_list_list[equiv(ocp_active_base + i)]);
+ if (i != 0)
+ tprint(",");
+ }
+ tprint("}");
+ }
+ active_compile();
+ define(ocp_active_min_ptr_base, data_cmd, active_min_ptr);
+ define(ocp_active_max_ptr_base, data_cmd, active_max_ptr);
+ }
+}
+
+@ @c
+void do_clear_ocp_lists(small_number a)
+{
+ define(ocp_active_number_base, data_cmd, 0);
+ active_compile();
+ define(ocp_active_min_ptr_base, data_cmd, active_min_ptr);
+ define(ocp_active_max_ptr_base, data_cmd, active_max_ptr);
+}
+
+
+@ @c
+void dump_active_ocp_info(void)
+{
+ int k;
+ dump_int(active_min_ptr);
+ dump_int(active_max_ptr);
+ for (k = 0; k <= active_max_ptr - 1; k++)
+ dump_wd(active_info[k]);
+ if (active_max_ptr > 0) {
+ print_ln();
+ print_int(active_max_ptr);
+ tprint(" words of active ocps");
+ }
+}
+
+void undump_active_ocp_info(void)
+{
+ int k;
+ undump_int(active_min_ptr);
+ undump_int(active_max_ptr);
+ for (k = 0; k <= active_max_ptr - 1; k++)
+ undump_wd(active_info[k]);
+}