add a primitive pdffiledump for eptex and euptex

git-svn-id: svn://tug.org/texlive/trunk@33846 c570f23f-e606-0410-a88d-b1316a301751

11 files changed, 191 insertions, 3 deletions

diff --git a/Build/source/texk/web2c/eptexdir/ChangeLog b/Build/source/texk/web2c/eptexdir/ChangeLog
index c89a24280f6..8326d308181 100644
--- a/Build/source/texk/web2c/eptexdir/ChangeLog
+++ b/Build/source/texk/web2c/eptexdir/ChangeLog
@@ -1,3 +1,8 @@
+2014-05-05  Akira Kakuto  <kakuto@fuk.kindai.ac.jp>
+
+	* pdfutils.ch, eptexextra.c, and eptex.defines: Add a primitive
+	\pdffiledump for eptex.
+
 2014-05-02  Peter Breitenlohner  <peb@mppmu.mpg.de>
 
 	* eptrip/eptrip.diffs: Updated for TL14.
diff --git a/Build/source/texk/web2c/eptexdir/eptex.defines b/Build/source/texk/web2c/eptexdir/eptex.defines
index 2a58e7b57c0..0d288a3e6f8 100644
--- a/Build/source/texk/web2c/eptexdir/eptex.defines
+++ b/Build/source/texk/web2c/eptexdir/eptex.defines
@@ -40,3 +40,4 @@
 @define procedure getcreationdate;
 @define procedure getfilemoddate();
 @define procedure getfilesize();
+@define procedure getfiledump();
diff --git a/Build/source/texk/web2c/eptexdir/eptexextra.c b/Build/source/texk/web2c/eptexdir/eptexextra.c
index c60bb42922a..9beef1443fb 100644
--- a/Build/source/texk/web2c/eptexdir/eptexextra.c
+++ b/Build/source/texk/web2c/eptexdir/eptexextra.c
@@ -10,3 +10,58 @@
 
 /* Hand-coded routines for TeX or Metafont in C.  */
 #include <lib/texmfmp.c>
+
+void getfiledump(int s, int offset, int length)
+{
+    FILE *f;
+    int read, i;
+    poolpointer data_ptr;
+    poolpointer data_end;
+    char *file_name;
+
+    if (length == 0) {
+        /* empty result string */
+        return;
+    }
+
+    if (poolptr + 2 * length + 1 >= poolsize) {
+        /* no place for result */
+        poolptr = poolsize;
+        /* error by str_toks that calls str_room(1) */
+        return;
+    }
+
+    file_name = kpse_find_tex(makecfilename(s));
+    if (file_name == NULL) {
+        return;                 /* empty string */
+    }
+
+    /* read file data */
+    f = fopen(file_name, FOPEN_RBIN_MODE);
+    if (f == NULL) {
+        free(file_name);
+        return;
+    }
+    recorder_record_input(file_name);
+    if (fseek(f, offset, SEEK_SET) != 0) {
+        free(file_name);
+        return;
+    }
+    /* there is enough space in the string pool, the read
+       data are put in the upper half of the result, thus
+       the conversion to hex can be done without overwriting
+       unconverted bytes. */
+    data_ptr = poolptr + length;
+    read = fread(&strpool[data_ptr], sizeof(char), length, f);
+    fclose(f);
+
+    /* convert to hex */
+    data_end = data_ptr + read;
+    for (; data_ptr < data_end; data_ptr++) {
+        i = snprintf((char *) &strpool[poolptr], 3,
+                     "%.2X", (unsigned int) strpool[data_ptr]);
+        check_nprintf(i, 3);
+        poolptr += i;
+    }
+    free(file_name);
+}
diff --git a/Build/source/texk/web2c/eptexdir/pdfutils.ch b/Build/source/texk/web2c/eptexdir/pdfutils.ch
index 40327b43642..6252e3bf80d 100644
--- a/Build/source/texk/web2c/eptexdir/pdfutils.ch
+++ b/Build/source/texk/web2c/eptexdir/pdfutils.ch
@@ -63,7 +63,8 @@ pdf_page_height_code:   print_esc("pdfpageheight");
 @d pdf_creation_date_code   = etex_convert_base+2 {command code for \.{\\pdfcreationdate}}
 @d pdf_file_mod_date_code   = etex_convert_base+3 {command code for \.{\\pdffilemoddate}}
 @d pdf_file_size_code       = etex_convert_base+4 {command code for \.{\\pdffilesize}}
-@d etex_convert_codes=etex_convert_base+5 {end of \eTeX's command codes}
+@d pdf_file_dump_code       = etex_convert_base+5 {command code for \.{\\pdffiledump}}
+@d etex_convert_codes=etex_convert_base+6 {end of \eTeX's command codes}
 @z
 
 @x
@@ -74,6 +75,7 @@ pdf_page_height_code:   print_esc("pdfpageheight");
   pdf_creation_date_code: print_esc("pdfcreationdate");
   pdf_file_mod_date_code: print_esc("pdffilemoddate");
   pdf_file_size_code:     print_esc("pdffilesize");
+  pdf_file_dump_code:     print_esc("pdffiledump");
 @z
 
 @x
@@ -98,6 +100,8 @@ we have to create a temporary string that is destroyed immediately after.
 @!save_warning_index: pointer;
 @!u: str_number; {saved current string string}
 @!s: str_number; {first temp string}
+@!i: integer;
+@!j: integer;
 @z
 
 @x
@@ -169,6 +173,56 @@ pdf_file_size_code:
     restore_cur_string;
     return;
   end;
+
+pdf_file_dump_code:
+  begin
+    save_scanner_status := scanner_status;
+    save_warning_index := warning_index;
+    save_def_ref := def_ref;
+    save_cur_string;
+    {scan offset}
+    cur_val := 0;
+    if (scan_keyword("offset")) then begin
+      scan_int;
+      if (cur_val < 0) then begin
+        print_err("Bad file offset");
+@.Bad file offset@>
+        help2("A file offset must be between 0 and 2^{31}-1,")@/
+          ("I changed this one to zero.");
+        int_error(cur_val);
+        cur_val := 0;
+      end;
+    end;
+    i := cur_val;
+    {scan length}
+    cur_val := 0;
+    if (scan_keyword("length")) then begin
+      scan_int;
+      if (cur_val < 0) then begin
+        print_err("Bad dump length");
+@.Bad dump length@>
+        help2("A dump length must be between 0 and 2^{31}-1,")@/
+          ("I changed this one to zero.");
+        int_error(cur_val);
+        cur_val := 0;
+      end;
+    end;
+    j := cur_val;
+    {scan file name}
+    scan_pdf_ext_toks;
+    s := tokens_to_string(def_ref);
+    delete_token_ref(def_ref);
+    def_ref := save_def_ref;
+    warning_index := save_warning_index;
+    scanner_status := save_scanner_status;
+    b := pool_ptr;
+    getfiledump(s, i, j);
+    link(garbage) := str_toks(b);
+    flush_str(s);
+    ins_list(link(temp_head));
+    restore_cur_string;
+    return;
+  end;
 @z
 
 @x
@@ -294,6 +348,8 @@ primitive("pdffilemoddate",convert,pdf_file_mod_date_code);@/
 @!@:pdf_file_mod_date_}{\.{\\pdffilemoddate} primitive@>
 primitive("pdffilesize",convert,pdf_file_size_code);@/
 @!@:pdf_file_size_}{\.{\\pdffilesize} primitive@>
+primitive("pdffiledump",convert,pdf_file_dump_code);@/
+@!@:pdf_file_dump_}{\.{\\pdffiledump} primitive@>
 primitive("pdfsavepos",extension,pdf_save_pos_node);@/
 @!@:pdf_save_pos_}{\.{\\pdfsavepos} primitive@>
 primitive("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/
@@ -544,7 +600,5 @@ begin
         flush_string;
 end;
 
-
 @* \[54] System-dependent changes.
 @z
-
diff --git a/Build/source/texk/web2c/euptexdir/ChangeLog b/Build/source/texk/web2c/euptexdir/ChangeLog
index 420ad950715..0c1d747a896 100644
--- a/Build/source/texk/web2c/euptexdir/ChangeLog
+++ b/Build/source/texk/web2c/euptexdir/ChangeLog
@@ -1,3 +1,8 @@
+2014-05-05  Akira Kakuto  <kakuto@fuk.kindai.ac.jp>
+
+	* euptex.defines, and euptexextra.c: Add a primitive \pdffiledump
+	for euptex.
+
 2014-05-02  Peter Breitenlohner  <peb@mppmu.mpg.de>
 
 	* euptrip/euptrip.diffs: Updated for TL14.
diff --git a/Build/source/texk/web2c/euptexdir/euptex.defines b/Build/source/texk/web2c/euptexdir/euptex.defines
index 42d385120cc..3647f9c4f30 100644
--- a/Build/source/texk/web2c/euptexdir/euptex.defines
+++ b/Build/source/texk/web2c/euptexdir/euptex.defines
@@ -51,3 +51,4 @@
 @define procedure getcreationdate;
 @define procedure getfilemoddate();
 @define procedure getfilesize();
+@define procedure getfiledump();
diff --git a/Build/source/texk/web2c/euptexdir/euptexextra.c b/Build/source/texk/web2c/euptexdir/euptexextra.c
index 1497c967625..d0c1b8d0af9 100644
--- a/Build/source/texk/web2c/euptexdir/euptexextra.c
+++ b/Build/source/texk/web2c/euptexdir/euptexextra.c
@@ -10,3 +10,58 @@
 
 /* Hand-coded routines for TeX or Metafont in C.  */
 #include <lib/texmfmp.c>
+
+void getfiledump(int s, int offset, int length)
+{
+    FILE *f;
+    int read, i;
+    poolpointer data_ptr;
+    poolpointer data_end;
+    char *file_name;
+
+    if (length == 0) {
+        /* empty result string */
+        return;
+    }
+
+    if (poolptr + 2 * length + 1 >= poolsize) {
+        /* no place for result */
+        poolptr = poolsize;
+        /* error by str_toks that calls str_room(1) */
+        return;
+    }
+
+    file_name = kpse_find_tex(makecfilename(s));
+    if (file_name == NULL) {
+        return;                 /* empty string */
+    }
+
+    /* read file data */
+    f = fopen(file_name, FOPEN_RBIN_MODE);
+    if (f == NULL) {
+        free(file_name);
+        return;
+    }
+    recorder_record_input(file_name);
+    if (fseek(f, offset, SEEK_SET) != 0) {
+        free(file_name);
+        return;
+    }
+    /* there is enough space in the string pool, the read
+       data are put in the upper half of the result, thus
+       the conversion to hex can be done without overwriting
+       unconverted bytes. */
+    data_ptr = poolptr + length;
+    read = fread(&strpool[data_ptr], sizeof(char), length, f);
+    fclose(f);
+
+    /* convert to hex */
+    data_end = data_ptr + read;
+    for (; data_ptr < data_end; data_ptr++) {
+        i = snprintf((char *) &strpool[poolptr], 3,
+                     "%.2X", (unsigned int) strpool[data_ptr]);
+        check_nprintf(i, 3);
+        poolptr += i;
+    }
+    free(file_name);
+}
diff --git a/Build/source/texk/web2c/ptexdir/ChangeLog b/Build/source/texk/web2c/ptexdir/ChangeLog
index 1b13f882cf9..bd9aad93264 100644
--- a/Build/source/texk/web2c/ptexdir/ChangeLog
+++ b/Build/source/texk/web2c/ptexdir/ChangeLog
@@ -1,3 +1,8 @@
+2014-05-05  Akira Kakuto  <kakuto@fuk.kindai.ac.jp>
+
+	* kanji.h: declare getfiledump() to add a primitive \pdffiledump
+	for eptex.
+
 2014-05-02  Peter Breitenlohner  <peb@mppmu.mpg.de>
 
 	* ptrip/ptrip.diffs: Updated for TL14.
diff --git a/Build/source/texk/web2c/ptexdir/kanji.h b/Build/source/texk/web2c/ptexdir/kanji.h
index 75482fe4cca..d0492e55148 100644
--- a/Build/source/texk/web2c/ptexdir/kanji.h
+++ b/Build/source/texk/web2c/ptexdir/kanji.h
@@ -9,6 +9,7 @@
 #include <ptexenc/unicode.h>
 #define getintone(w) ((w).cint1)
 #define setintone(w,a) ((w).cint1=(a))
+void getfiledump(int s, int offset, int length);
 #endif
 
 #ifndef KANJI
diff --git a/Build/source/texk/web2c/uptexdir/ChangeLog b/Build/source/texk/web2c/uptexdir/ChangeLog
index bae45919502..2b75f2d46ea 100644
--- a/Build/source/texk/web2c/uptexdir/ChangeLog
+++ b/Build/source/texk/web2c/uptexdir/ChangeLog
@@ -1,3 +1,8 @@
+2014-05-05  Akira Kakuto  <kakuto@fuk.kindai.ac.jp>
+
+	* kanji.h: declare getfiledump() to add a primitive \pdffiledump
+	for euptex.
+
 2014-05-02  Peter Breitenlohner  <peb@mppmu.mpg.de>
 
 	* uptrip/uptrip.diffs: Updated for TL14.
diff --git a/Build/source/texk/web2c/uptexdir/kanji.h b/Build/source/texk/web2c/uptexdir/kanji.h
index a00f41d9eff..d6ae13af94f 100644
--- a/Build/source/texk/web2c/uptexdir/kanji.h
+++ b/Build/source/texk/web2c/uptexdir/kanji.h
@@ -9,6 +9,7 @@
 #ifdef eupTeX
 #define getintone(w) ((w).cint1)
 #define setintone(w,a) ((w).cint1=(a))
+void getfiledump(int s, int offset, int length);
 #endif
 
 #ifndef KANJI