summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlgs/Resource/Init/gs_btokn.ps
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlgs/Resource/Init/gs_btokn.ps')
-rw-r--r--Master/tlpkg/tlgs/Resource/Init/gs_btokn.ps159
1 files changed, 76 insertions, 83 deletions
diff --git a/Master/tlpkg/tlgs/Resource/Init/gs_btokn.ps b/Master/tlpkg/tlgs/Resource/Init/gs_btokn.ps
index b9add38368a..410b8419154 100644
--- a/Master/tlpkg/tlgs/Resource/Init/gs_btokn.ps
+++ b/Master/tlpkg/tlgs/Resource/Init/gs_btokn.ps
@@ -1,4 +1,4 @@
-% Copyright (C) 2001-2019 Artifex Software, Inc.
+% Copyright (C) 2001-2020 Artifex Software, Inc.
% All Rights Reserved.
%
% This software is provided AS-IS with no warranty, either express or
@@ -148,46 +148,36 @@ mark
% worry about interrupts or callbacks when writing to the output file.
% Define procedures for accumulating the space required to represent
-% an object in binary form. The procedures for composite objects (arrays
-% and dictionaries) leave different results on the stack:
-% <#refs> <#chars> <simple_obj> -proc- <#refs> <#chars>
-% <#refs> <#chars> <array|dict> -proc- <array|dict> <#refs> <#chars>
-% This is required so that .writeobjects can also accumulate the actual
-% list of composite objects to write in the binary object sequence.
+% an object in binary form.
+% <#refs> <#chars> <obj> -proc- <#refs'> <#chars'>
/cntdict mark
/integertype /pop load
/realtype 1 index
/marktype 1 index
/nulltype 1 index
/booleantype 1 index
- /nametype { length add } bind
+ /nametype { length add } .bind
/stringtype 1 index
- /arraytype //null
- /dicttype //null
+ /arraytype 0 % replaced below
+ /dicttype 0 % replaced below
.dicttomark def
-/.cntobj { % <<arguments and results as for procedures in cntdict>>
+/.cntobj {
dup type //cntdict exch get exec
} .bind def
cntdict /arraytype {
- dup dup length 5 -1 roll add 4 2 roll { //.cntobj exec } forall
-} bind put
+ dup length % #refs #chars array len
+ 4 -1 roll add % #chars array #refs+len
+ dup 65536 gt {
+ /writeobject .systemvar /limitcheck signalerror
+ } if
+ 3 1 roll % #refs+len #chars array
+ //.cntobj forall
+} .bind put % replace arraytype in cntdict
+
cntdict /dicttype {
- WRITEDICTS {
- dup dup length 2 mul 5 -1 roll add 4 2 roll {
- % We have to use .execn here, rather than simply rolling the
- % value under the top elements, because key might involve arrays
- % or dictionaries.
- cvlit {//.cntobj exec} exch 2 .execn //.cntobj exec
- } forall
- } {
- /writeobject .systemvar /typecheck signalerror
- } ifelse
+ /writeobject .systemvar /typecheck signalerror
} bind put
-/w2dict mark
- /nametype { 2 copy .writecvs pop } bind
- /stringtype 1 index
-.dicttomark def
/.bosheader { % <top_length> <total_length> <string8> .bosheader
% <string4|8>
@@ -211,70 +201,74 @@ cntdict /dicttype {
} .bind def
/.writeobjects { % <file> <tag> <array> .writeobjects -
- mark exch
-
- % Count the space required for refs and strings.
+ % Apply the tag early and forget about it.
+ (12345678) dup 1 5 -1 roll % file array (...) (...) 1 tag
+ put exch % file (.t.) array
- dup length 0 3 -1 roll
- % Stack: file tag -mark- #refs #chars array
- dup 4 1 roll { //.cntobj exec } forall
+ % Calculate the space required for refs and strings.
+ % Reject excessively large graphs or graphs with loops.
+ 0 0 % file (.t.) array #refs #chars
+ 2 index //.cntobj exec % file (.t.) array #refs #chars
- % Write the header.
+ % Write the header.
+ 1 index 8 mul add % file (.t.) array #refs #refs*8+#chars
+ 2 index length exch (12345678) % file (.t.) array #refs len(array) #refs*8+#chars (...)
+ //.bosheader exec % file (.t.) array #refs (...)
+ 4 index exch writestring % file (.t.) array #refs
- % Stack: file tag -mark- array1 ... (array|dict)N #refs #chars
- counttomark 3 add -2 roll 4 1 roll
- % Stack: -mark- array1 ... (array|dict)N tag #refs #chars file
- dup counttomark 1 sub index length
- 4 index 3 bitshift 4 index add
- (xxxxxxxx) //.bosheader exec writestring
-
- % Write the objects per se.
-
- 3 1 roll pop
- counttomark 1 sub index length 3 bitshift exch
- 3 bitshift
- % Stack: -mark- array1 ... (array|dict)N tag file ref# char#
- counttomark 4 sub {
- counttomark -1 roll dup 6 1 roll
- % Stack: ... objN tag file ref# char# objN
- dup type /dicttype eq { % can't be first object
- { 5 1 roll (x\000xxxxxx) .bosobject
- 3 index exch writestring
- 4 -1 roll (x\000xxxxxx) .bosobject
- 3 index exch writestring
+ % Traverse an array tree in width-first order and place all the
+ % arrays that are found on the operand stack. Acyclic graphs are
+ % expanded to trees. The top parameter K indicates the number
+ % of arrays on a given depth level. At the root level, K is equal to 1.
+ mark 2 index 1 % file (.t.) array #refs -mark- array K
+ { dup 0 le { pop exit } if
+ dup {
+ dup index {
+ dup type /arraytype eq {
+ exch 1 add
+ } {
+ pop
+ } ifelse
} forall
- } {
- { (x\000xxxxxx) .bosobject
- dup 1 6 index put
- 3 index exch writestring
- 4 -1 roll pop 0 4 1 roll % clear tag
- } forall
- } ifelse
- } repeat
+ 1 sub
+ } repeat
+ } loop % file (.t.) array #refs -mark- array1 ... arrayN
+ counttomark 5 add -4 roll % -mark- array1 ... arrayN file (.t.) array #refs
- % Write the strings and names.
+ % Write the content of the root array
+ 8 mul % -mark- array1 ... arrayN file (.t.) array #refs*8
+ exch dup length 8 mul % -mark- array1 ... arrayN file (.t.) #refs*8 array len(array)*8
+ 3 1 roll % -mark- array1 ... arrayN file (.t.) len(array)*8 #refs*8 array
+ { 3 index % -mark- array1 ... arrayN file (.t.) len(array)*8 #refs*8 obj (.t.)
+ .bosobject % -mark- array1 ... arrayN file (.t.) len(array)*8 #refs*8 (.t.)
+ 4 index exch writestring % -mark- array1 ... arrayN file (.t.) len(array)*8 #refs*8
+ } forall
+ 3 -1 roll pop % -mark- array1 ... arrayN file len(array)*8 #refs*8
- pop pop exch pop
- % Stack: -mark- array1 ... array|dictN file
- counttomark 1 sub {
- counttomark -1 roll {
- % The counting pass ensured that the keys and values
- % of any dictionary must be writable objects.
- % Hence, we are processing a dictionary iff
- % the next-to-top stack element is not a file.
- 1 index type /filetype ne {
- exch 2 index exch dup type //w2dict exch .knownget
- { exec } { pop } ifelse pop
- } if
- dup type //w2dict exch .knownget { exec } { pop } ifelse
+ % Write the remaining arrays
+ counttomark 2 sub -1 3 {
+ index { % ... file #refs #str obj
+ (1\000345678) .bosobject % ... file #refs #str (...)
+ 3 index exch writestring % ... file #refs #str
} forall
- } repeat
+ } for
+ pop pop % -mark- array1 ... arrayN file
- % Clean up.
-
- % Stack: -mark- file
- pop pop
+ % Write strings and names.
+ counttomark 1 sub -1 1 {
+ index {
+ dup type /nametype eq {
+ .namestring
+ } if
+ dup type /stringtype eq {
+ 1 index exch writestring
+ } {
+ pop
+ } ifelse
+ } forall
+ } for
+ cleartomark % Clean up
} .bind def
/.writeobject {
@@ -324,7 +318,6 @@ cntdict /dicttype {
} bind def
currentdict /cntdict .undef
-currentdict /w2dict .undef
% End of level2dict