m-escrito.lua /size: 217 Kb    last modification: 2021-10-28 13:51
1
if
not
modules
then
modules
=
{
}
end
modules
[
'
m-escrito
'
]
=
{
2
version
=
1
.
001
,
3
comment
=
"
companion to m-escrito.mkiv
"
,
4
author
=
"
Taco Hoekwater (BitText) and Hans Hagen (PRAGMA-ADE)
"
,
5
license
=
"
see below and context related readme files
"
6
}
7 8
-- This file is derived from Taco's escrito interpreter. Because the project was
9
-- more or less stopped, after some chatting we decided to preserve the result
10
-- and make it useable in ConTeXt. Hans went over all code, fixed a couple of
11
-- things, messed other things, made the code more efficient, wrapped all in
12
-- some helpers. So, a diff between the original and this file is depressingly
13
-- large. This means that you shouldn't bother Taco with the side effects (better
14
-- or worse) that result from this.
15 16
-- Fonts need some work and I will do that when needed. I might cook up something
17
-- similar to what we do with MetaFun. First I need to run into a use case. After
18
-- all, this whole exercise is just that: getting an idea of what processing PS
19
-- code involves.
20 21
-- Here is the usual copyright blabla:
22
--
23
-- Copyright 2010 Taco Hoekwater <taco@luatex.org>. All rights reserved.
24
--
25
-- Redistribution and use in source and binary forms, with or without modification,
26
-- are permitted provided that the following conditions are met:
27
--
28
-- 1. Redistributions of source code must retain the above copyright notice, this
29
-- list of conditions and the following disclaimer.
30
--
31
-- 2. Redistributions in binary form must reproduce the above copyright notice, this
32
-- list of conditions and the following disclaimer in the documentation and/or
33
-- other materials provided with the distribution.
34
--
35
-- THIS SOFTWARE IS PROVIDED BY <COPYRIGHT HOLDER> ``AS IS'' AND ANY EXPRESS OR
36
-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
37
-- MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
38
-- SHALL CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
39
-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
40
-- OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
41
-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
42
-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
43
-- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
44
-- DAMAGE.
45 46
-- We use a couple of do..ends later on because this rather large file has too many
47
-- locals otherwise. Possible optimizations are using insert/remove and getting rid
48
-- of the VM calls (in direct mode they are no-ops anyway). We can also share some
49
-- more code here and there.
50 51
-- Notes:
52
--
53
-- -- all modules are checked / adapted to lmtx but how about this one ... i noticed
54
-- that a file in the test suite failed
55
--
56
-- -- the idea was to use this for the m4all eps files but we swichted the format
57
-- there; nevertheless i patched a littl but it's still not ok (cold winter work)
58
--
59
-- -- for instance some ppor mans fancy shading doesn't show up (not that efficient
60
-- either so ...)
61
--
62
-- -- let's see what the new fast ps->pdf lib from artifact brings ... makes more
63
-- sense in the perspective of ps 2 and 3 .. but there is some sentiment involved
64
--
65
-- -- room for implification (like no integer / real distinction needed)
66
--
67
-- -- so for now this is not part of the mkiv/lmtx code split (then also go Lua 5.4)
68 69
local
type
,
unpack
,
tonumber
,
tostring
,
next
=
type
,
unpack
,
tonumber
,
tostring
,
next
70 71
local
format
=
string
.
format
72
local
gmatch
=
string
.
gmatch
73
local
match
=
string
.
match
74
local
sub
=
string
.
sub
75
local
char
=
string
.
char
76
local
byte
=
string
.
byte
77 78
local
insert
=
table
.
insert
79
local
remove
=
table
.
remove
80
local
concat
=
table
.
concat
81
local
reverse
=
table
.
reverse
82 83
local
abs
=
math
.
abs
84
local
ceil
=
math
.
ceil
85
local
floor
=
math
.
floor
86
local
sin
=
math
.
sin
87
local
cos
=
math
.
cos
88
local
rad
=
math
.
rad
89
local
sqrt
=
math
.
sqrt
90
local
atan2
=
math
.
atan2
91
local
tan
=
math
.
tan
92
local
deg
=
math
.
deg
93
local
pow
=
math
.
pow
94
local
log
=
math
.
log
95
local
log10
=
math
.
log10
96
local
random
=
math
.
random
97
local
setranseed
=
math
.
randomseed
98 99
local
bitand
=
bit32
.
band
-- when lmtx: Lua 5.4
100
local
bitor
=
bit32
.
bor
101
local
bitxor
=
bit32
.
bxor
102
local
bitrshift
=
bit32
.
rshift
103
local
bitlshift
=
bit32
.
lshift
104 105
local
lpegmatch
=
lpeg
.
match
106
local
Ct
,
Cc
,
Cs
,
Cp
,
C
,
R
,
S
,
P
,
V
=
lpeg
.
Ct
,
lpeg
.
Cc
,
lpeg
.
Cs
,
lpeg
.
Cp
,
lpeg
.
C
,
lpeg
.
R
,
lpeg
.
S
,
lpeg
.
P
,
lpeg
.
V
107 108
local
formatters
=
string
.
formatters
109
local
setmetatableindex
=
table
.
setmetatableindex
110 111
-- Namespace
112 113
-- HH: Here we assume just one session. If needed we can support more (just a matter
114
-- of push/pop) but it makes the code more complex and less efficient too.
115 116
escrito
=
{
}
117 118
----- escrito = escrito
119
local
initializers
=
{
}
120
local
devices
=
{
}
121
local
specials
122 123
local
DEBUG
=
false
-- these will become trackers if needed
124
local
INITDEBUG
=
false
-- these will become trackers if needed
125
local
MAX_INT
=
0x7FFFFFFF
-- we could have slightly larger ints because lua internally uses doubles
126 127
initializers
[
#
initializers
+
1
]
=
function
(
reset
)
128
if
reset
then
129
specials
=
nil
130
else
131
specials
=
{
}
132
end
133
end
134 135
local
devicename
136
local
device
137 138
-- "boundingbox",
139
-- "randomseed",
140 141
-- Composite objects
142
--
143
-- Arrays, dicts and strings are stored in VM. To do this, VM is an integer-indexed table. This appears
144
-- a bit silly in lua because we are actually just emulating a C implementation detail (pointers) but it
145
-- is documented behavior. There is also supposed to be a VM stack, but I will worry about that when it
146
-- becomes time to implement save/restore. (TH)
147 148
local
VM
-- todo: just a hash
149 150
initializers
[
#
initializers
+
1
]
=
function
(
)
151
VM
=
{
}
152
end
153 154
local
directvm
=
false
-- true (but then we ned to patch more VM[..]
155 156
local
add_VM
,
get_VM
157 158
if
directvm
then
-- if ok then we remove the functions
159 160
add_VM
=
function
(
a
)
161
return
a
162
end
163
get_VM
=
function
(
i
)
164
return
i
165
end
166 167
else
168 169
add_VM
=
function
(
a
)
170
local
n
=
#
VM
+
1
171
VM
[
n
]
=
a
172
return
n
173
end
174 175
get_VM
=
function
(
i
)
176
return
VM
[
i
]
177
end
178 179
end
180 181
-- Execution stack
182 183
local
execstack
184
local
execstackptr
185
local
do_exec
186
local
next_object
187
local
stopped
188 189
initializers
[
#
initializers
+
1
]
=
function
(
)
190
execstack
=
{
}
191
execstackptr
=
0
192
stopped
=
false
193
end
194 195
local
function
pop_execstack
(
)
196
if
execstackptr
>
0
then
197
local
value
=
execstack
[
execstackptr
]
198
execstackptr
=
execstackptr
-
1
199
return
value
200
else
201
return
nil
-- stackunderflow
202
end
203
end
204 205
local
function
push_execstack
(
v
)
206
execstackptr
=
execstackptr
+
1
207
execstack
[
execstackptr
]
=
v
208
end
209 210
-- Operand stack
211
--
212
-- Most operand and exec stack entries are four-item arrays:
213
--
214
-- [1] = "[integer|real|boolean|name|mark|null|save|font]" (a postscript interpreter type)
215
-- [2] = "[unlimited|read-only|execute-only|noaccess]"
216
-- [3] = "[executable|literal]" (exec attribute)
217
-- [4] = value (a VM index inthe case of names)
218
--
219
-- But there are some exceptions.
220
--
221
-- Dictionaries save the access attribute inside the value
222
--
223
-- [1] = "dict"
224
-- [2] = irrelevant
225
-- [3] = "[executable|literal]"
226
-- [4] = value (a VM index)
227
--
228
-- Operators have a fifth item:
229
--
230
-- [1] = "operator"
231
-- [2] = "[unlimited|read-only|execute-only|noaccess]"
232
-- [3] = "[executable|literal]"
233
-- [4] = value
234
-- [5] = identifier (the operator name)
235
--
236
-- Strings and files have a fifth and a sixth item, the fifth of which is
237
-- only relevant if the exec attribute is 'executable':
238
--
239
-- [1] = "[string|file]"
240
-- [2] = "[unlimited|read-only|execute-only|noaccess]"
241
-- [3] = "[executable|literal]"
242
-- [4] = value (a VM index) (for input files, this holds the whole file)
243
-- [5] = exec-index
244
-- [6] = length
245
-- [7] = iomode (for files only)
246
-- [8] = filehandle (for files only)
247
--
248
-- Arrays also have a seven items, the fifth is only relevant if
249
-- the exec attribute is 'executable', and the seventh is used to differentiate
250
-- between direct and indirect interpreter views of the object.
251
--
252
-- [1] = "array"
253
-- [2] = "[unlimited|read-only|execute-only|noaccess]"
254
-- [3] = "[executable|literal]"
255
-- [4] = value (a VM index)
256
-- [5] = exec-index
257
-- [6] = length (a VM index)
258
-- [7] = "[d|i]" (direct vs. indirect)
259
--
260
-- The exec stack also has an object with [1] == ".stopped", which is used
261
-- for "stopped" execution contexts
262 263
local
opstack
264
local
opstackptr
265 266
local
b_true
=
{
'
boolean
'
,
'
unlimited
'
,
'
literal
'
,
true
}
267
local
b_false
=
{
'
boolean
'
,
'
unlimited
'
,
'
literal
'
,
false
}
268 269
initializers
[
#
initializers
+
1
]
=
function
(
)
270
opstack
=
{
}
271
opstackptr
=
0
272
end
273 274
local
function
pop_opstack
(
)
275
if
opstackptr
>
0
then
276
local
value
=
opstack
[
opstackptr
]
277
opstackptr
=
opstackptr
-
1
278
return
value
279
else
280
return
nil
-- stackunderflow
281
end
282
end
283 284
local
function
push_opstack
(
v
)
285
opstackptr
=
opstackptr
+
1
286
opstack
[
opstackptr
]
=
v
287
end
288 289
local
function
check_opstack
(
n
)
290
return
opstackptr
>
=
n
291
end
292 293
local
function
get_opstack
(
)
294
if
opstackptr
>
0
then
295
return
opstack
[
opstackptr
]
296
else
297
return
nil
-- stackunderflow
298
end
299
end
300 301
-- In case of error, the interpreter has to restore the opstack
302 303
local
function
copy_opstack
(
)
304
local
t
=
{
}
305
for
n
=
1
,
opstackptr
do
306
local
sn
=
opstack
[
n
]
307
t
[
n
]
=
{
unpack
(
sn
)
}
308
end
309
return
t
310
end
311 312
local
function
set_opstack
(
new
)
313
opstackptr
=
#
new
314
opstack
=
new
315
end
316 317
-- Dict stack
318 319
local
dictstack
320
local
dictstackptr
321 322
initializers
[
#
initializers
+
1
]
=
function
(
)
323
dictstack
=
{
}
324
dictstackptr
=
0
325
end
326 327
-- this finds a name in the current dictionary stack
328 329
local
function
lookup
(
name
)
330
for
n
=
dictstackptr
,
1
,
-1
do
331
local
found
=
get_VM
(
dictstack
[
n
]
)
332
if
found
then
333
local
dict
=
found
.
dict
334
if
dict
then
335
local
d
=
dict
[
name
]
336
if
d
then
337
return
d
,
n
338
end
339
end
340
end
341
end
342
return
nil
343
end
344 345
-- Graphics state stack
346 347
-- device backends are easier if gsstate items use bare data instead of
348
-- ps objects, much as possible
349 350
-- todo: just use one color array
351 352
local
gsstate
353 354
initializers
[
#
initializers
+
1
]
=
function
(
reset
)
355
if
reset
then
356
gsstate
=
nil
357
else
358
gsstate
=
{
359
matrix
=
{
1
,
0
,
0
,
1
,
0
,
0
}
,
360
color
=
{
361
gray
=
0
,
362
hsb
=
{
}
,
363
rgb
=
{
}
,
364
cmyk
=
{
}
,
365
type
=
"
gray
"
366
}
,
367
position
=
{
}
,
-- actual x and y undefined
368
path
=
{
}
,
369
clip
=
{
}
,
370
font
=
nil
,
371
linewidth
=
1
,
372
linecap
=
0
,
373
linejoin
=
0
,
374
screen
=
nil
,
-- by default, we don't use a screen, which matches "1 0 {pop}"
375
transfer
=
nil
,
-- by default, we don't have a transfer function, which matches "{}"
376
flatness
=
0
,
377
miterlimit
=
10
,
378
dashpattern
=
{
}
,
379
dashoffset
=
0
,
380
}
381
end
382
end
383 384
local
function
copy_gsstate
(
)
385
local
old
=
gsstate
386
local
position
=
old
.
position
387
local
matrix
=
old
.
matrix
388
local
color
=
old
.
color
389
local
rgb
=
color
.
rgb
390
local
cmyk
=
color
.
cmyk
391
local
hsb
=
color
.
hsb
392
return
{
393
matrix
=
{
matrix
[
1
]
,
matrix
[
2
]
,
matrix
[
3
]
,
matrix
[
4
]
,
matrix
[
5
]
,
matrix
[
6
]
}
,
394
color
=
{
395
type
=
color
.
type
,
396
gray
=
color
.
gray
,
397
hsb
=
{
hsb
[
1
]
,
hsb
[
2
]
,
hsb
[
3
]
}
,
398
rgb
=
{
rgb
[
1
]
,
rgb
[
2
]
,
rgb
[
3
]
}
,
399
cmyk
=
{
cmyk
[
1
]
,
cmyk
[
2
]
,
cmyk
[
3
]
,
cmyk
[
4
]
}
,
400
}
,
401
position
=
{
position
[
1
]
,
position
[
2
]
}
,
402
path
=
{
unpack
(
old
.
path
)
}
,
403
clip
=
{
unpack
(
old
.
clip
)
}
,
404
font
=
old
.
font
,
405
linewidth
=
old
.
linewidth
,
406
linecap
=
old
.
linecap
,
407
linejoin
=
old
.
linejoin
,
408
screen
=
old
.
screen
,
409
transfer
=
nil
,
410
flatness
=
old
.
flatness
,
411
miterlimit
=
old
.
miterlimit
,
412
dashpattern
=
{
}
,
413
dashoffset
=
0
,
414
}
415
end
416 417
-- gsstack entries are of the form
418
-- [1] "[save|gsave]"
419
-- [2] {gsstate}
420 421
local
gsstack
422
local
gsstackptr
423 424
initializers
[
#
initializers
+
1
]
=
function
(
reset
)
425
if
reset
then
426
gsstack
=
nil
427
gsstackptr
=
nil
428
else
429
gsstack
=
{
}
430
gsstackptr
=
0
431
end
432
end
433 434
local
function
push_gsstack
(
v
)
435
gsstackptr
=
gsstackptr
+
1
436
gsstack
[
gsstackptr
]
=
v
437
end
438 439
local
function
pop_gsstack
(
)
440
if
gsstackptr
>
0
then
441
local
v
=
gsstack
[
gsstackptr
]
442
gsstackptr
=
gsstackptr
-
1
443
return
v
444
end
445
end
446 447
-- Currentpage
448 449
local
currentpage
450 451
initializers
[
#
initializers
+
1
]
=
function
(
reset
)
452
if
reset
then
453
currentpage
=
nil
454
else
455
currentpage
=
{
}
456
end
457
end
458 459
-- Errordict
460 461
-- The standard errordict entry. The rest of these dictionaries will be filled
462
-- in the new() function.
463 464
local
errordict
465
local
dicterror
466 467
-- find an error handler
468 469
local
function
lookup_error
(
name
)
470
local
dict
=
get_VM
(
errordict
)
.
dict
471
return
dict
and
dict
[
name
]
472
end
473 474
-- error handling and reporting
475 476
local
report
=
logs
.
reporter
(
"
escrito
"
)
477 478
local
function
ps_error
(
a
)
479
-- can have print hook
480
return
false
,
a
481
end
482 483
-- Most entries in systemdict are operators, and the operators each have their own
484
-- implementation function. These functions are grouped by category cf. the summary
485
-- in the Adobe PostScript reference manual, the creation of the systemdict entries
486
-- is alphabetical.
487
--
488
-- In the summary at the start of the operator sections, the first character means:
489
--
490
-- "-" => todo
491
-- "+" => done
492
-- "*" => partial
493
-- "^" => see elsewhere
494 495
local
operators
=
{
}
496 497
-- Operand stack manipulation operators
498
--
499
-- +pop +exch +dup +copy +index +roll +clear +count +mark +cleartomark +counttomark
500 501
function
operators
.
pop
(
)
502
local
a
=
pop_opstack
(
)
503
if
not
a
then
504
return
ps_error
(
'
stackunderflow
'
)
505
end
506
return
true
507
end
508 509
function
operators
.
exch
(
)
510
if
opstackptr
<
2
then
511
return
ps_error
(
'
stackunderflow
'
)
512
end
513
local
prv
=
opstackptr
-
1
514
opstack
[
opstackptr
]
,
opstack
[
prv
]
=
opstack
[
prv
]
,
opstack
[
opstackptr
]
515
return
true
516
end
517 518
function
operators
.
dup
(
)
519
if
opstackptr
<
1
then
520
return
ps_error
(
'
stackunderflow
'
)
521
end
522
local
nxt
=
opstackptr
+
1
523
opstack
[
nxt
]
=
opstack
[
opstackptr
]
524
opstackptr
=
nxt
525
return
true
526
end
527 528
function
operators
.
copy
(
)
529
local
a
=
pop_opstack
(
)
530
if
not
a
then
531
return
ps_error
(
'
stackunderflow
'
)
532
end
533
local
ta
=
a
[
1
]
534
if
ta
=
=
'
integer
'
then
535
local
va
=
a
[
4
]
536
if
va
<
0
then
537
return
ps_error
(
'
typecheck
'
)
538
end
539
local
thestack
=
opstackptr
540
if
va
>
thestack
then
541
return
ps_error
(
'
stackunderflow
'
)
542
end
543
-- use for loop
544
local
n
=
thestack
-
va
+
1
545
while
n
<
=
thestack
do
546
local
b
=
opstack
[
n
]
547
local
tb
=
b
[
1
]
548
if
tb
=
=
'
array
'
or
tb
=
=
'
string
'
or
tb
=
=
'
dict
'
or
tb
=
=
'
font
'
then
549
b
=
{
tb
,
b
[
2
]
,
b
[
3
]
,
add_VM
(
get_VM
(
b
[
4
]
)
)
,
b
[
5
]
,
b
[
6
]
,
b
[
7
]
}
550
end
551
push_opstack
(
b
)
552
n
=
n
+
1
553
end
554
elseif
ta
=
=
'
dict
'
then
555
local
b
=
a
556
local
a
=
pop_opstack
(
)
557
if
not
a
then
558
return
ps_error
(
'
stackunderflow
'
)
559
end
560
if
a
[
1
]
~
=
'
dict
'
then
561
return
ps_error
(
'
typecheck
'
)
562
end
563
local
thedict
=
get_VM
(
b
[
4
]
)
564
local
tobecopied
=
get_VM
(
a
[
4
]
)
565
if
thedict
.
maxsize
<
tobecopied
.
size
then
566
return
ps_error
(
'
rangecheck
'
)
567
end
568
if
thedict
.
size
~
=
0
then
569
return
ps_error
(
'
typecheck
'
)
570
end
571
local
access
=
thedict
.
access
572
if
access
=
=
'
read-only
'
or
access
=
=
'
noaccess
'
then
573
return
ps_error
(
'
invalidaccess
'
)
574
end
575
local
dict
=
{
}
576
for
k
,
v
in
next
,
tobecopied
.
dict
do
577
dict
[
k
]
=
v
-- fixed, was thedict[a], must be thedict.dict
578
end
579
thedict
.
access
=
tobecopied
.
access
580
thedict
.
size
=
tobecopied
.
size
581
thedict
.
dict
=
dict
582
b
=
{
b
[
1
]
,
b
[
2
]
,
b
[
3
]
,
add_VM
(
thedict
)
}
583
push_opstack
(
b
)
584
elseif
ta
=
=
'
array
'
then
585
local
b
=
a
586
local
a
=
pop_opstack
(
)
587
if
not
a
then
588
return
ps_error
(
'
stackunderflow
'
)
589
end
590
if
a
[
1
]
~
=
'
array
'
then
591
return
ps_error
(
'
typecheck
'
)
592
end
593
if
b
[
6
]
<
a
[
6
]
then
594
return
ps_error
(
'
rangecheck
'
)
595
end
596
local
access
=
b
[
2
]
597
if
access
=
=
'
read-only
'
or
access
=
=
'
noaccess
'
then
598
return
ps_error
(
'
invalidaccess
'
)
599
end
600
local
array
=
{
}
601
local
thearray
=
get_VM
(
b
[
4
]
)
602
local
tobecopied
=
get_VM
(
a
[
4
]
)
603
for
k
,
v
in
next
,
tobecopied
do
604
array
[
k
]
=
v
605
end
606
b
=
{
b
[
1
]
,
b
[
2
]
,
b
[
3
]
,
add_VM
(
array
)
,
a
[
5
]
,
a
[
6
]
,
a
[
7
]
}
-- fixed, was thearray
607
push_opstack
(
b
)
608
elseif
ta
=
=
'
string
'
then
609
local
b
=
a
610
local
a
=
pop_opstack
(
)
611
if
not
a
then
612
return
ps_error
(
'
stackunderflow
'
)
613
end
614
if
a
[
1
]
~
=
'
string
'
then
615
return
ps_error
(
'
typecheck
'
)
616
end
617
if
b
[
6
]
<
a
[
6
]
then
618
return
ps_error
(
'
rangecheck
'
)
619
end
620
local
access
=
b
[
2
]
621
if
access
=
=
'
read-only
'
or
access
=
=
'
noaccess
'
then
622
return
ps_error
(
'
invalidaccess
'
)
623
end
624
local
thestring
=
get_VM
(
b
[
4
]
)
625
local
repl
=
get_VM
(
a
[
4
]
)
626
VM
[
b
[
4
]
]
=
repl
.
.
sub
(
thestring
,
#
repl
+
1
,
-1
)
627
b
=
{
b
[
1
]
,
b
[
2
]
,
b
[
3
]
,
add_VM
(
repl
)
,
a
[
5
]
,
b
[
6
]
}
628
push_opstack
(
b
)
629
else
630
return
ps_error
(
'
typecheck
'
)
631
end
632
return
true
633
end
634 635
function
operators
.
index
(
)
636
local
a
=
pop_opstack
(
)
637
if
not
a
then
638
return
ps_error
(
'
stackunderflow
'
)
639
end
640
local
ta
=
a
[
1
]
641
if
not
ta
=
=
'
integer
'
then
642
return
ps_error
(
'
typecheck
'
)
643
end
644
local
n
=
a
[
4
]
645
if
n
<
0
then
646
return
ps_error
(
'
rangecheck
'
)
647
end
648
if
n
>
=
opstackptr
then
649
return
ps_error
(
'
stackunderflow
'
)
650
end
651
push_opstack
(
opstack
[
opstackptr
-
n
]
)
652
return
true
653
end
654 655
function
operators
.
roll
(
)
656
local
b
=
pop_opstack
(
)
657
local
a
=
pop_opstack
(
)
658
if
not
a
then
659
return
ps_error
(
'
stackunderflow
'
)
660
end
661
if
b
[
1
]
~
=
'
integer
'
then
662
return
ps_error
(
'
typecheck
'
)
663
end
664
if
a
[
1
]
~
=
'
integer
'
then
665
return
ps_error
(
'
typecheck
'
)
666
end
667
local
stackcount
=
a
[
4
]
668
if
stackcount
<
0
then
669
return
ps_error
(
'
rangecheck
'
)
670
end
671
if
stackcount
>
opstackptr
then
672
return
ps_error
(
'
stackunderflow
'
)
673
end
674
local
rollcount
=
b
[
4
]
675
if
rollcount
=
=
0
then
676
return
true
677
end
678
if
rollcount
>
0
then
679
-- can be simplified
680
while
rollcount
>
0
do
681
local
oldtop
=
opstack
[
opstackptr
]
682
local
n
=
0
683
while
n
<
stackcount
do
684
opstack
[
opstackptr
-
n
]
=
opstack
[
opstackptr
-
n
-1
]
685
n
=
n
+
1
686
end
687
opstack
[
opstackptr
-
(
stackcount
-1
)
]
=
oldtop
688
rollcount
=
rollcount
-
1
689
end
690
else
691
-- can be simplified
692
while
rollcount
<
0
do
693
local
oldbot
=
opstack
[
opstackptr
-
stackcount
+
1
]
694
local
n
=
stackcount
-
1
695
while
n
>
0
do
696
opstack
[
opstackptr
-
n
]
=
opstack
[
opstackptr
-
n
+
1
]
697
n
=
n
-
1
698
end
699
opstack
[
opstackptr
]
=
oldbot
700
rollcount
=
rollcount
+
1
701
end
702
end
703
return
true
704
end
705 706
function
operators
.
clear
(
)
707
opstack
=
{
}
-- or just keep it
708
opstackptr
=
0
709
return
true
710
end
711 712
function
operators
.
count
(
)
713
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
opstackptr
}
714
return
true
715
end
716 717
function
operators
.
mark
(
)
718
push_opstack
{
'
mark
'
,
'
unlimited
'
,
'
literal
'
,
null
}
719
end
720 721
operators
.
beginarray
=
operators
.
mark
722 723
function
operators
.
cleartomark
(
)
724
while
opstackptr
>
0
do
725
local
val
=
pop_opstack
(
)
726
if
not
val
then
727
return
ps_error
(
'
unmatchedmark
'
)
728
end
729
if
val
[
1
]
=
=
'
mark
'
then
730
return
true
731
end
732
end
733
return
ps_error
(
'
unmatchedmark
'
)
734
end
735 736
function
operators
.
counttomark
(
)
737
local
v
=
0
738
for
n
=
opstackptr
,
1
,
-1
do
739
if
opstack
[
n
]
[
1
]
=
=
'
mark
'
then
740
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
v
}
741
return
true
742
end
743
v
=
v
+
1
744
end
745
return
ps_error
(
'
unmatchedmark
'
)
746
end
747 748
-- Arithmetic and math operators
749
--
750
-- +add +div +idiv +mod +mul +sub +abs +neg +ceiling +floor +round +truncate +sqrt +atan +cos
751
-- +sin +exp +ln +log +rand +srand +rrand
752 753
function
operators
.
add
(
)
754
local
b
=
pop_opstack
(
)
755
local
a
=
pop_opstack
(
)
756
if
not
a
then
757
return
ps_error
(
'
stackunderflow
'
)
758
end
759
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
760
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
761
return
ps_error
(
'
typecheck
'
)
762
end
763
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
764
return
ps_error
(
'
typecheck
'
)
765
end
766
local
c
=
a
[
4
]
+
b
[
4
]
767
push_opstack
{
768
(
ta
=
=
'
real
'
or
tb
=
=
'
real
'
or
c
>
MAX_INT
)
and
"
real
"
or
"
integer
"
,
769
'
unlimited
'
,
'
literal
'
,
c
770
}
771
return
true
772
end
773 774
function
operators
.
sub
(
)
775
local
b
=
pop_opstack
(
)
776
local
a
=
pop_opstack
(
)
777
if
not
a
then
778
return
ps_error
(
'
stackunderflow
'
)
779
end
780
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
781
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
782
return
ps_error
(
'
typecheck
'
)
783
end
784
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
785
return
ps_error
(
'
typecheck
'
)
786
end
787
local
c
=
a
[
4
]
-
b
[
4
]
788
push_opstack
{
789
(
ta
=
=
'
real
'
or
tb
=
=
'
real
'
or
c
>
MAX_INT
)
and
"
real
"
or
"
integer
"
,
790
'
unlimited
'
,
'
literal
'
,
c
791
}
792
return
true
793
end
794 795
function
operators
.
div
(
)
796
local
b
=
pop_opstack
(
)
797
local
a
=
pop_opstack
(
)
798
if
not
a
then
799
return
ps_error
(
'
stackunderflow
'
)
800
end
801
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
802
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
803
return
ps_error
(
'
typecheck
'
)
804
end
805
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
806
return
ps_error
(
'
typecheck
'
)
807
end
808
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
809
if
vb
=
=
0
then
810
return
ps_error
(
'
undefinedresult
'
)
811
end
812
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
va
/
vb
}
813
return
true
814
end
815 816
function
operators
.
idiv
(
)
817
local
b
=
pop_opstack
(
)
818
local
a
=
pop_opstack
(
)
819
if
not
a
then
820
return
ps_error
(
'
stackunderflow
'
)
821
end
822
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
823
if
tb
~
=
'
integer
'
then
824
return
ps_error
(
'
typecheck
'
)
825
end
826
if
ta
~
=
'
integer
'
then
827
return
ps_error
(
'
typecheck
'
)
828
end
829
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
830
if
vb
=
=
0
then
831
return
ps_error
(
'
undefinedresult
'
)
832
end
833
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
floor
(
va
/
vb
)
}
834
return
true
835
end
836 837
function
operators
.
mod
(
)
838
local
b
=
pop_opstack
(
)
839
local
a
=
pop_opstack
(
)
840
if
not
a
then
841
return
ps_error
(
'
stackunderflow
'
)
842
end
843
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
844
if
tb
~
=
'
integer
'
then
845
return
ps_error
(
'
typecheck
'
)
846
end
847
if
ta
~
=
'
integer
'
then
848
return
ps_error
(
'
typecheck
'
)
849
end
850
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
851
if
vb
=
=
0
then
852
return
ps_error
(
'
undefinedresult
'
)
853
end
854
local
neg
=
false
855
local
v
856
if
va
<
0
then
857
v
=
-
va
858
neg
=
true
859
else
860
v
=
va
861
end
862
local
c
=
v
%
abs
(
vb
)
863
if
neg
then
864
c
=
-
c
865
end
866
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
c
}
867
return
true
868
end
869 870
function
operators
.
mul
(
)
871
local
b
=
pop_opstack
(
)
872
local
a
=
pop_opstack
(
)
873
if
not
a
then
874
return
ps_error
(
'
stackunderflow
'
)
875
end
876
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
877
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
878
return
ps_error
(
'
typecheck
'
)
879
end
880
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
881
return
ps_error
(
'
typecheck
'
)
882
end
883
local
c
=
a
[
4
]
*
b
[
4
]
884
push_opstack
{
885
(
ta
=
=
'
real
'
or
tb
=
=
'
real
'
or
abs
(
c
)
>
MAX_INT
)
and
'
real
'
or
'
integer
'
,
886
'
unlimited
'
,
'
literal
'
,
c
887
}
888
return
true
889
end
890 891
function
operators
.
abs
(
)
892
local
a
=
pop_opstack
(
)
893
if
not
a
then
894
return
ps_error
(
'
stackunderflow
'
)
895
end
896
local
ta
=
a
[
1
]
897
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
898
return
ps_error
(
'
typecheck
'
)
899
end
900
local
v
=
a
[
4
]
901
local
c
=
abs
(
v
)
902
push_opstack
{
903
(
ta
=
=
'
real
'
or
v
=
=
-
(
MAX_INT
+
1
)
)
and
'
real
'
or
'
integer
'
,
-- hm, v or c
904
'
unlimited
'
,
'
literal
'
,
c
905
}
906
return
true
907
end
908 909
function
operators
.
neg
(
)
910
local
a
=
pop_opstack
(
)
911
if
not
a
then
912
return
ps_error
(
'
stackunderflow
'
)
913
end
914
local
ta
=
a
[
1
]
915
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
916
return
ps_error
(
'
typecheck
'
)
917
end
918
local
v
=
a
[
4
]
919
push_opstack
{
920
(
ta
=
=
'
real
'
or
v
=
=
-
(
MAX_INT
+
1
)
)
and
'
real
'
or
'
integer
'
,
921
'
unlimited
'
,
'
literal
'
,
-
v
922
}
923
return
true
924
end
925 926
function
operators
.
ceiling
(
)
927
local
a
=
pop_opstack
(
)
928
if
not
a
then
929
return
ps_error
(
'
stackunderflow
'
)
930
end
931
local
ta
=
a
[
1
]
932
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
933
return
ps_error
(
'
typecheck
'
)
934
end
935
local
c
=
ceil
(
a
[
4
]
)
936
push_opstack
{
ta
,
'
unlimited
'
,
'
literal
'
,
c
}
937
return
true
938
end
939 940
function
operators
.
floor
(
)
941
local
a
=
pop_opstack
(
)
942
if
not
a
then
943
return
ps_error
(
'
stackunderflow
'
)
944
end
945
local
ta
=
a
[
1
]
946
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
947
return
ps_error
(
'
typecheck
'
)
948
end
949
local
c
=
floor
(
a
[
4
]
)
950
push_opstack
{
ta
,
'
unlimited
'
,
'
literal
'
,
c
}
951
return
true
952
end
953 954
function
operators
.
round
(
)
955
local
a
=
pop_opstack
(
)
956
if
not
a
then
957
return
ps_error
(
'
stackunderflow
'
)
958
end
959
local
ta
=
a
[
1
]
960
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
961
return
ps_error
(
'
typecheck
'
)
962
end
963
local
c
=
floor
(
a
[
4
]
+
0
.
5
)
964
push_opstack
{
ta
,
'
unlimited
'
,
'
literal
'
,
c
}
965
return
true
966
end
967 968
function
operators
.
truncate
(
)
969
local
a
=
pop_opstack
(
)
970
if
not
a
then
971
return
ps_error
(
'
stackunderflow
'
)
972
end
973
local
ta
=
a
[
1
]
974
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
975
return
ps_error
(
'
typecheck
'
)
976
end
977
local
v
=
a
[
4
]
978
local
c
=
v
<
0
and
-
floor
(
-
v
)
or
floor
(
v
)
979
push_opstack
{
ta
,
'
unlimited
'
,
'
literal
'
,
c
}
980
return
true
981
end
982 983
function
operators
.
sqrt
(
)
984
local
a
=
pop_opstack
(
)
985
if
not
a
then
986
return
ps_error
(
'
stackunderflow
'
)
987
end
988
local
ta
=
a
[
1
]
989
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
990
return
ps_error
(
'
typecheck
'
)
991
end
992
local
v
=
a
[
4
]
993
if
v
<
0
then
994
return
ps_error
(
'
rangecheck
'
)
995
end
996
local
c
=
sqrt
(
v
)
997
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
}
998
return
true
999
end
1000 1001
function
operators
.
atan
(
)
1002
local
b
=
pop_opstack
(
)
1003
local
a
=
pop_opstack
(
)
1004
if
not
a
then
1005
return
ps_error
(
'
stackunderflow
'
)
1006
end
1007
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
1008
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
1009
return
ps_error
(
'
typecheck
'
)
1010
end
1011
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
1012
return
ps_error
(
'
typecheck
'
)
1013
end
1014
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
1015
if
va
=
=
0
and
vb
=
=
0
then
1016
return
ps_error
(
'
undefinedresult
'
)
1017
end
1018
local
c
=
deg
(
atan2
(
rad
(
va
)
,
rad
(
vb
)
)
)
1019
if
c
<
0
then
1020
c
=
c
+
360
1021
end
1022
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
}
1023
return
true
1024
end
1025 1026
function
operators
.
sin
(
)
1027
local
a
=
pop_opstack
(
)
1028
if
not
a
then
1029
return
ps_error
(
'
stackunderflow
'
)
1030
end
1031
local
ta
=
a
[
1
]
1032
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
1033
return
ps_error
(
'
typecheck
'
)
1034
end
1035
local
c
=
sin
(
rad
(
a
[
4
]
)
)
1036
-- this is because double calculation introduces a small error
1037
if
abs
(
c
)
<
1.0e-16
then
1038
c
=
0
1039
end
1040
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
}
1041
return
true
1042
end
1043 1044
function
operators
.
cos
(
)
1045
local
a
=
pop_opstack
(
)
1046
if
not
a
then
1047
return
ps_error
(
'
stackunderflow
'
)
1048
end
1049
local
ta
=
a
[
1
]
1050
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
1051
return
ps_error
(
'
typecheck
'
)
1052
end
1053
local
c
=
cos
(
rad
(
a
[
4
]
)
)
1054
-- this is because double calculation introduces a small error
1055
if
abs
(
c
)
<
1.0e-16
then
1056
c
=
0
1057
end
1058
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
}
1059
return
true
1060
end
1061 1062
function
operators
.
exp
(
)
1063
local
b
=
pop_opstack
(
)
1064
local
a
=
pop_opstack
(
)
1065
if
not
a
then
1066
return
ps_error
(
'
stackunderflow
'
)
1067
end
1068
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
1069
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
1070
return
ps_error
(
'
typecheck
'
)
1071
end
1072
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
1073
return
ps_error
(
'
typecheck
'
)
1074
end
1075
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
1076
if
va
<
0
and
floor
(
vb
)
~
=
vb
then
1077
return
ps_error
(
'
undefinedresult
'
)
1078
end
1079
local
c
=
pow
(
va
,
vb
)
1080
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
}
1081
return
true
1082
end
1083 1084
function
operators
.
ln
(
)
1085
local
a
=
pop_opstack
(
)
1086
if
not
a
then
1087
return
ps_error
(
'
stackunderflow
'
)
1088
end
1089
local
ta
=
a
[
1
]
1090
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
1091
return
ps_error
(
'
typecheck
'
)
1092
end
1093
local
v
=
a
[
4
]
1094
if
v
<
=
0
then
1095
return
ps_error
(
'
undefinedresult
'
)
1096
end
1097
local
c
=
log
(
v
)
1098
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
}
1099
return
true
1100
end
1101 1102
function
operators
.
log
(
)
1103
local
a
=
pop_opstack
(
)
1104
if
not
a
then
1105
return
ps_error
(
'
stackunderflow
'
)
1106
end
1107
local
ta
=
a
[
1
]
1108
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
1109
return
ps_error
(
'
typecheck
'
)
1110
end
1111
local
v
=
a
[
4
]
1112
if
v
<
=
0
then
1113
return
ps_error
(
'
undefinedresult
'
)
1114
end
1115
local
c
=
log10
(
v
)
1116
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
}
1117
return
true
1118
end
1119 1120
escrito
.
randomseed
=
os
.
time
(
)
1121 1122
-- this interval is one off, but that'll do
1123 1124
function
operators
.
rand
(
)
1125
local
c
=
random
(
MAX_INT
)
-
1
1126
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
c
}
1127
return
true
1128
end
1129 1130
function
operators
.
srand
(
)
1131
local
a
=
pop_opstack
(
)
1132
if
not
a
then
1133
return
ps_error
(
'
stackunderflow
'
)
1134
end
1135
local
ta
=
a
[
1
]
1136
if
ta
~
=
'
integer
'
then
1137
return
ps_error
(
'
typecheck
'
)
1138
end
1139
escrito
.
randomseed
=
a
[
4
]
1140
setranseed
(
escrito
.
randomseed
)
1141
return
true
1142
end
1143 1144
function
operators
.
rrand
(
)
1145
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
escrito
.
randomseed
}
1146
return
true
1147
end
1148 1149
-- Array operators
1150
--
1151
-- +array ^[ +] +length +get +put +getinterval +putinterval +aload +astore ^copy +forall
1152 1153
function
operators
.
array
(
)
1154
local
a
=
pop_opstack
(
)
1155
if
not
a
then
1156
return
ps_error
(
'
stackunderflow
'
)
1157
end
1158
local
t
=
a
[
1
]
1159
local
v
=
a
[
4
]
1160
if
t
~
=
'
integer
'
then
1161
return
ps_error
(
'
typecheck
'
)
1162
end
1163
if
v
<
0
then
1164
return
ps_error
(
'
rangecheck
'
)
1165
end
1166
local
array
=
{
}
1167
for
i
=
1
,
v
do
1168
array
[
n
]
=
{
'
null
'
,
'
unlimited
'
,
'
literal
'
,
true
}
-- todo: share this one
1169
end
1170
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
array
)
,
0
,
v
,
'
d
'
}
1171
end
1172 1173
function
operators
.
endarray
(
)
1174
local
n
=
opstackptr
1175
while
n
>
0
do
1176
if
opstack
[
n
]
[
1
]
=
=
'
mark
'
then
1177
break
1178
end
1179
n
=
n
-
1
1180
end
1181
if
n
=
=
0
then
1182
return
ps_error
(
'
unmatchedmark
'
)
1183
end
1184
local
top
=
opstackptr
1185
local
i
=
opstackptr
-
n
1186
local
array
=
{
}
1187
while
i
>
0
do
1188
array
[
i
]
=
pop_opstack
(
)
1189
i
=
i
-
1
1190
end
1191
pop_opstack
(
)
-- pop the mark
1192
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
array
)
,
#
array
,
#
array
,
'
d
'
}
1193
end
1194 1195
function
operators
.
length
(
)
1196
local
a
=
pop_opstack
(
)
1197
if
not
a
then
1198
return
ps_error
(
'
stackunderflow
'
)
1199
end
1200
local
access
=
a
[
2
]
1201
if
access
=
=
"
noaccess
"
or
access
=
=
"
executeonly
"
then
1202
return
ps_error
(
'
invalidaccess
'
)
1203
end
1204
local
ta
=
a
[
1
]
1205
local
va
=
a
[
4
]
1206
if
ta
=
=
"
dict
"
or
ta
=
=
"
font
"
then
1207
va
=
get_VM
(
va
)
.
size
1208
elseif
ta
=
=
"
array
"
or
ta
=
=
"
string
"
then
1209
va
=
get_VM
(
va
)
1210
va
=
#
va
1211
else
1212
return
ps_error
(
'
typecheck
'
)
1213
end
1214
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
va
}
1215
return
true
1216
end
1217 1218
function
operators
.
get
(
)
1219
local
b
=
pop_opstack
(
)
1220
local
a
=
pop_opstack
(
)
1221
if
not
a
then
1222
return
ps_error
(
'
stackunderflow
'
)
1223
end
1224
local
access
=
a
[
2
]
1225
if
access
=
=
"
noaccess
"
or
access
=
=
"
execute-only
"
then
1226
return
ps_error
(
'
invalidaccess
'
)
1227
end
1228
local
ta
=
a
[
1
]
1229
local
va
=
a
[
4
]
1230
if
ta
=
=
"
dict
"
then
1231
local
dict
=
get_VM
(
va
)
1232
local
key
=
b
1233
local
tb
=
b
[
1
]
1234
local
vb
=
b
[
4
]
1235
if
tb
=
=
"
string
"
or
tb
=
=
"
name
"
then
1236
key
=
get_VM
(
vb
)
1237
end
1238
local
ddk
=
dict
.
dict
[
key
]
1239
if
ddk
then
1240
push_opstack
(
ddk
)
1241
else
1242
return
ps_error
(
'
undefined
'
)
1243
end
1244
elseif
ta
=
=
"
array
"
then
1245
local
tb
=
b
[
1
]
1246
local
vb
=
b
[
4
]
1247
if
tb
~
=
'
integer
'
then
1248
return
ps_error
(
'
typecheck
'
)
1249
end
1250
if
vb
<
0
or
vb
>
=
a
[
6
]
then
1251
return
ps_error
(
'
rangecheck
'
)
1252
end
1253
local
array
=
get_VM
(
va
)
1254
local
index
=
vb
+
1
1255
push_opstack
(
array
[
index
]
)
1256
elseif
ta
=
=
"
string
"
then
1257
local
tb
=
b
[
1
]
1258
local
vb
=
b
[
4
]
1259
if
tb
~
=
'
integer
'
then
1260
return
ps_error
(
'
typecheck
'
)
1261
end
1262
if
vb
<
0
or
vb
>
=
a
[
6
]
then
1263
return
ps_error
(
'
rangecheck
'
)
1264
end
1265
local
thestring
=
get_VM
(
va
)
1266
local
index
=
vb
+
1
1267
local
c
=
sub
(
thestring
,
index
,
index
)
1268
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
byte
(
c
)
}
1269
else
1270
return
ps_error
(
'
typecheck
'
)
1271
end
1272
return
true
1273
end
1274 1275
function
operators
.
put
(
)
1276
local
c
=
pop_opstack
(
)
1277
local
b
=
pop_opstack
(
)
1278
local
a
=
pop_opstack
(
)
1279
if
not
a
then
1280
return
ps_error
(
'
stackunderflow
'
)
1281
end
1282
local
ta
=
a
[
1
]
1283
if
ta
=
=
"
dict
"
then
1284
local
dict
=
get_VM
(
a
[
4
]
)
1285
if
dict
.
access
~
=
'
unlimited
'
then
1286
return
ps_error
(
'
invalidaccess
'
)
1287
end
1288
local
key
=
b
1289
local
bt
=
b
[
1
]
1290
if
bt
=
=
"
string
"
or
bt
=
=
"
name
"
then
1291
key
=
get_VM
(
b
[
4
]
)
1292
end
1293
local
dd
=
dict
.
dict
1294
local
ds
=
dict
.
size
1295
local
ddk
=
dd
[
key
]
1296
if
not
ddk
and
(
ds
=
=
dict
.
maxsize
)
then
1297
return
ps_error
(
'
dictfull
'
)
1298
end
1299
if
c
[
1
]
=
=
'
array
'
then
1300
c
[
7
]
=
'
i
'
1301
end
1302
if
not
ddk
then
1303
dict
.
size
=
ds
+
1
1304
end
1305
dd
[
key
]
=
c
1306
elseif
ta
=
=
"
array
"
then
1307
if
a
[
2
]
~
=
'
unlimited
'
then
1308
return
ps_error
(
'
invalidaccess
'
)
1309
end
1310
if
b
[
1
]
~
=
'
integer
'
then
1311
return
ps_error
(
'
typecheck
'
)
1312
end
1313
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
1314
if
vb
<
0
or
vb
>
=
a
[
6
]
then
1315
return
ps_error
(
'
rangecheck
'
)
1316
end
1317
local
vm
=
VM
[
va
]
1318
local
vi
=
bv
+
1
1319
if
vm
[
vi
]
[
1
]
=
=
'
null
'
then
1320
a
[
5
]
=
a
[
5
]
+
1
1321
end
1322
vm
[
vi
]
=
c
1323
elseif
ta
=
=
"
string
"
then
1324
if
a
[
2
]
~
=
'
unlimited
'
then
1325
return
ps_error
(
'
invalidaccess
'
)
1326
end
1327
if
b
[
1
]
~
=
'
integer
'
then
1328
return
ps_error
(
'
typecheck
'
)
1329
end
1330
if
c
[
1
]
~
=
'
integer
'
then
1331
return
ps_error
(
'
typecheck
'
)
1332
end
1333
local
va
,
vb
,
vc
=
a
[
4
]
,
b
[
4
]
,
c
[
4
]
1334
if
vb
<
0
or
vb
>
=
a
[
6
]
then
1335
return
ps_error
(
'
rangecheck
'
)
1336
end
1337
if
vc
<
0
or
vc
>
255
then
1338
return
ps_error
(
'
rangecheck
'
)
1339
end
1340
local
thestring
=
get_VM
(
va
)
1341
VM
[
va
]
=
sub
(
thestring
,
1
,
vb
)
.
.
char
(
vc
)
.
.
sub
(
thestring
,
vb
+
2
)
1342
else
1343
return
ps_error
(
'
typecheck
'
)
1344
end
1345
return
true
1346
end
1347 1348
function
operators
.
getinterval
(
)
1349
local
c
=
pop_opstack
(
)
1350
local
b
=
pop_opstack
(
)
1351
local
a
=
pop_opstack
(
)
1352
if
not
a
then
1353
return
ps_error
(
'
stackunderflow
'
)
1354
end
1355
local
ta
,
tb
,
tc
=
a
[
1
]
,
b
[
1
]
,
c
[
1
]
1356
local
aa
,
ab
,
ac
=
a
[
2
]
,
b
[
2
]
,
c
[
2
]
1357
local
va
,
vb
,
vc
=
a
[
4
]
,
b
[
4
]
,
c
[
4
]
1358
if
ta
~
=
"
array
"
and
ta
~
=
'
string
'
then
1359
return
ps_error
(
'
typecheck
'
)
1360
end
1361
if
tb
~
=
'
integer
'
or
tc
~
=
'
integer
'
then
1362
return
ps_error
(
'
typecheck
'
)
1363
end
1364
if
aa
=
=
"
execute-only
"
or
aa
=
=
'
noaccess
'
then
1365
return
ps_error
(
'
invalidaccess
'
)
1366
end
1367
if
vb
<
0
or
vc
<
0
or
vb
+
vc
>
=
a
[
6
]
then
1368
return
ps_error
(
'
rangecheck
'
)
1369
end
1370
-- vb : start
1371
-- vc : number
1372
if
ta
=
=
'
array
'
then
1373
local
array
=
get_VM
(
va
)
1374
local
subarray
=
{
}
1375
local
index
=
1
1376
while
index
<
=
vc
do
1377
subarray
[
index
]
=
array
[
index
+
vb
]
1378
index
=
index
+
1
1379
end
1380
push_opstack
{
'
array
'
,
aa
,
a
[
3
]
,
add_VM
(
subarray
)
,
vc
,
vc
,
'
d
'
}
1381
else
1382
local
thestring
=
get_VM
(
va
)
1383
local
newstring
=
sub
(
thestring
,
vb
+
1
,
vb
+
vc
)
1384
push_opstack
{
'
string
'
,
aa
,
a
[
3
]
,
add_VM
(
newstring
)
,
vc
,
vc
}
1385
end
1386
return
true
1387
end
1388 1389
function
operators
.
putinterval
(
)
1390
local
c
=
pop_opstack
(
)
1391
local
b
=
pop_opstack
(
)
1392
local
a
=
pop_opstack
(
)
1393
if
not
a
then
1394
return
ps_error
(
'
stackunderflow
'
)
1395
end
1396
local
ta
,
tb
,
tc
=
a
[
1
]
,
b
[
1
]
,
c
[
1
]
1397
local
aa
,
ab
,
ac
=
a
[
2
]
,
b
[
2
]
,
c
[
2
]
1398
local
va
,
vb
,
vc
=
a
[
4
]
,
b
[
4
]
,
c
[
4
]
1399
if
ta
~
=
"
array
"
and
ta
~
=
'
string
'
then
1400
return
ps_error
(
'
typecheck
'
)
1401
end
1402
if
tc
~
=
"
array
"
and
tc
~
=
'
string
'
then
1403
return
ps_error
(
'
typecheck
'
)
1404
end
1405
if
ta
~
=
tc
then
1406
return
ps_error
(
'
typecheck
'
)
1407
end
1408
if
aa
~
=
"
unlimited
"
then
1409
return
ps_error
(
'
invalidaccess
'
)
1410
end
1411
if
tb
~
=
'
integer
'
then
1412
return
ps_error
(
'
typecheck
'
)
1413
end
1414
if
vb
<
0
or
vb
+
c
[
6
]
>
=
a
[
6
]
then
1415
return
ps_error
(
'
rangecheck
'
)
1416
end
1417
if
ta
=
=
'
array
'
then
1418
local
newarr
=
get_VM
(
vc
)
1419
local
oldarr
=
get_VM
(
va
)
1420
local
index
=
1
1421
local
lastindex
=
c
[
6
]
1422
local
step
=
a
[
5
]
1423
while
index
<
=
lastindex
do
1424
if
oldarr
[
vb
+
index
]
[
1
]
=
=
'
null
'
then
1425
a
[
5
]
=
a
[
5
]
+
1
-- needs checking, a[5] not used
1426
-- step = step + 1
1427
end
1428
oldarr
[
vb
+
index
]
=
newarr
[
index
]
1429
index
=
index
+
1
1430
end
1431
else
1432
local
thestring
=
get_VM
(
va
)
1433
VM
[
va
]
=
sub
(
thestring
,
1
,
vb
)
.
.
get_VM
(
vc
)
.
.
sub
(
thestring
,
vb
+
c
[
6
]
+
1
)
1434
end
1435
return
true
1436
end
1437 1438
function
operators
.
aload
(
)
1439
local
a
=
pop_opstack
(
)
1440
if
not
a
then
1441
return
ps_error
(
'
stackunderflow
'
)
1442
end
1443
local
ta
,
aa
,
va
=
a
[
1
]
,
a
[
2
]
,
a
[
4
]
1444
if
ta
~
=
"
array
"
then
1445
return
ps_error
(
'
typecheck
'
)
1446
end
1447
if
aa
=
=
"
execute-only
"
or
aa
=
=
'
noaccess
'
then
1448
return
ps_error
(
'
invalidaccess
'
)
1449
end
1450
local
array
=
get_VM
(
va
)
1451
for
i
=
1
,
#
array
do
1452
push_opstack
(
array
[
i
]
)
1453
end
1454
push_opstack
(
a
)
1455
return
true
1456
end
1457 1458
function
operators
.
astore
(
)
1459
local
a
=
pop_opstack
(
)
1460
if
not
a
then
1461
return
ps_error
(
'
stackunderflow
'
)
1462
end
1463
local
ta
,
aa
,
va
=
a
[
1
]
,
a
[
2
]
,
a
[
4
]
1464
if
ta
~
=
"
array
"
then
1465
return
ps_error
(
'
typecheck
'
)
1466
end
1467
if
aa
=
=
"
execute-only
"
or
aa
=
=
'
noaccess
'
then
1468
return
ps_error
(
'
invalidaccess
'
)
1469
end
1470
local
array
=
get_VM
(
va
)
1471
local
count
=
a
[
6
]
1472
for
i
=
1
,
count
do
1473
local
v
=
pop_opstack
(
)
1474
if
not
v
then
1475
return
ps_error
(
'
stackunderflow
'
)
1476
end
1477
array
[
i
]
=
v
1478
end
1479
a
[
5
]
=
a
[
5
]
+
count
1480
push_opstack
(
a
)
1481
return
true
1482
end
1483 1484
function
operators
.
forall
(
)
1485
local
b
=
pop_opstack
(
)
1486
local
a
=
pop_opstack
(
)
1487
if
not
a
then
1488
return
ps_error
(
'
stackunderflow
'
)
1489
end
1490
local
ta
,
aa
,
va
=
a
[
1
]
,
a
[
2
]
,
a
[
4
]
1491
local
tb
,
ab
,
vb
=
b
[
1
]
,
b
[
2
]
,
b
[
4
]
1492
if
not
tb
=
=
"
array
"
and
b
[
3
]
=
=
'
executable
'
then
1493
return
ps_error
(
'
typecheck
'
)
1494
end
1495
if
tb
=
=
'
noaccess
'
then
1496
return
ps_error
(
'
invalidaccess
'
)
1497
end
1498
if
not
(
ta
=
=
"
array
"
or
ta
=
=
'
dict
'
or
ta
=
=
'
string
'
or
ta
=
=
"
font
"
)
then
1499
return
ps_error
(
'
typecheck
'
)
1500
end
1501
if
aa
=
=
"
execute-only
"
or
aa
=
=
'
noaccess
'
then
1502
return
ps_error
(
'
invalidaccess
'
)
1503
end
1504
push_execstack
{
'
.exit
'
,
'
unlimited
'
,
'
literal
'
,
false
}
1505
local
curstack
=
execstackptr
1506
if
ta
=
=
'
array
'
then
1507
if
a
[
6
]
=
=
0
then
1508
return
true
1509
end
1510
b
[
7
]
=
'
i
'
1511
local
thearray
=
get_VM
(
va
)
1512
for
i
=
1
,
#
thearray
do
1513
if
stopped
then
1514
stopped
=
false
1515
return
false
1516
end
1517
push_opstack
(
thearray
[
i
]
)
1518
b
[
5
]
=
1
1519
push_execstack
(
b
)
1520
while
curstack
<
=
execstackptr
do
1521
do_exec
(
)
1522
end
1523
end
1524
local
entry
=
execstack
[
execstackptr
]
1525
if
entry
[
1
]
=
=
'
.exit
'
and
antry
[
4
]
=
=
true
then
1526
pop_execstack
(
)
1527
return
true
1528
end
1529
elseif
ta
=
=
'
dict
'
or
ta
=
=
'
font
'
then
1530
local
thedict
=
get_VM
(
va
)
1531
if
thedict
.
size
=
=
0
then
1532
return
true
1533
end
1534
b
[
7
]
=
'
i
'
1535
local
thedict
=
get_VM
(
va
)
1536
for
k
,
v
in
next
,
thedict
.
dict
do
1537
if
stopped
then
1538
stopped
=
false
1539
return
false
1540
end
1541
if
type
(
k
)
=
=
"
string
"
then
1542
push_opstack
{
'
name
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
k
)
}
1543
else
1544
push_opstack
(
k
)
1545
end
1546
push_opstack
(
v
)
1547
b
[
5
]
=
1
1548
push_execstack
(
b
)
1549
while
curstack
<
execstackptr
do
1550
do_exec
(
)
1551
end
1552
local
entry
=
execstack
[
execstackptr
]
1553
if
entry
[
1
]
=
=
'
.exit
'
and
antry
[
4
]
=
=
true
then
1554
pop_execstack
(
)
1555
return
true
1556
end
1557
end
1558
else
-- string
1559
if
a
[
6
]
=
=
0
then
1560
return
true
1561
end
1562
b
[
7
]
=
'
i
'
1563
local
thestring
=
get_VM
(
va
)
1564
for
v
in
gmatch
(
thestring
,
"
.
"
)
do
-- we can use string.bytes
1565
if
stopped
then
1566
stopped
=
false
1567
return
false
1568
end
1569
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
byte
(
v
)
}
1570
b
[
5
]
=
1
1571
push_execstack
(
b
)
1572
while
curstack
<
execstackptr
do
1573
do_exec
(
)
1574
end
1575
local
entry
=
execstack
[
execstackptr
]
1576
if
entry
[
1
]
=
=
'
.exit
'
and
antry
[
4
]
=
=
true
then
1577
pop_execstack
(
)
1578
return
true
;
1579
end
1580
end
1581
end
1582
return
true
1583
end
1584 1585
-- Dictionary operators
1586
--
1587
-- +dict ^length +maxlength +begin +end +def +load +store ^get ^put +known +where ^copy
1588
-- ^forall ^errordict ^systemdict ^userdict +currentdict +countdictstack +dictstack
1589 1590
function
operators
.
dict
(
)
1591
local
a
=
pop_opstack
(
)
1592
if
not
a
then
1593
return
ps_error
(
'
stackunderflow
'
)
1594
end
1595
if
not
a
[
1
]
=
=
'
integer
'
then
1596
return
ps_error
(
'
typecheck
'
)
1597
end
1598
local
s
=
a
[
4
]
1599
if
s
<
0
then
1600
return
ps_error
(
'
rangecheck
'
)
1601
end
1602
if
s
=
=
0
then
-- level 2 feature
1603
s
=
MAX_INT
1604
end
1605
push_opstack
{
1606
'
dict
'
,
1607
'
unlimited
'
,
1608
'
literal
'
,
1609
add_VM
{
1610
access
=
'
unlimited
'
,
1611
size
=
0
,
1612
maxsize
=
s
,
1613
dict
=
{
}
,
1614
}
1615
}
1616
end
1617 1618
function
operators
.
maxlength
(
)
1619
local
a
=
pop_opstack
(
)
1620
if
not
a
then
1621
return
ps_error
(
'
stackunderflow
'
)
1622
end
1623
local
ta
,
aa
,
va
=
a
[
1
]
,
a
[
2
]
,
a
[
4
]
1624
if
ta
~
=
'
dict
'
then
1625
return
ps_error
(
'
typecheck
'
)
1626
end
1627
if
aa
=
=
'
execute-only
'
or
aa
=
=
'
noaccess
'
then
1628
return
ps_error
(
'
invalidaccess
'
)
1629
end
1630
local
thedict
=
get_VM
(
va
)
1631
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
thedict
.
maxsize
}
1632
end
1633 1634
function
operators
.
begin
(
)
1635
local
a
=
pop_opstack
(
)
1636
if
not
a
then
1637
return
ps_error
(
'
stackunderflow
'
)
1638
end
1639
if
a
[
1
]
~
=
'
dict
'
then
1640
return
ps_error
(
'
typecheck
'
)
1641
end
1642
dictstackptr
=
dictstackptr
+
1
1643
dictstack
[
dictstackptr
]
=
a
[
4
]
1644
end
1645 1646
operators
[
"
end
"
]
=
function
(
)
1647
if
dictstackptr
<
3
then
1648
return
ps_error
(
'
dictstackunderflow
'
)
1649
end
1650
dictstack
[
dictstackptr
]
=
nil
1651
dictstackptr
=
dictstackptr
-
1
1652
end
1653 1654
function
operators
.
def
(
)
1655
local
b
=
pop_opstack
(
)
1656
local
a
=
pop_opstack
(
)
1657
if
not
a
then
1658
return
ps_error
(
'
stackunderflow
'
)
1659
end
1660
if
not
(
a
[
1
]
=
=
'
name
'
and
a
[
3
]
=
=
'
literal
'
)
then
1661
return
ps_error
(
'
typecheck
'
)
1662
end
1663
if
b
[
1
]
=
=
'
array
'
then
1664
b
[
7
]
=
'
i
'
1665
end
1666
local
thedict
=
get_VM
(
dictstack
[
dictstackptr
]
)
1667
if
not
thedict
.
dict
[
get_VM
(
a
[
4
]
)
]
then
1668
if
thedict
.
size
=
=
thedict
.
maxsize
then
1669
-- return ps_error('dictfull') -- level 1 only
1670
end
1671
thedict
.
size
=
thedict
.
size
+
1
1672
end
1673
thedict
.
dict
[
get_VM
(
a
[
4
]
)
]
=
b
1674
return
true
1675
end
1676 1677
-- unclear: the book says this operator can return typecheck
1678 1679
function
operators
.
load
(
)
1680
local
a
=
pop_opstack
(
)
1681
if
not
a
then
1682
return
ps_error
(
'
stackunderflow
'
)
1683
end
1684
local
aa
=
a
[
2
]
1685
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
1686
return
ps_error
(
'
invalidaccess
'
)
1687
end
1688
local
v
=
lookup
(
get_VM
(
a
[
4
]
)
)
1689
if
not
v
then
1690
return
ps_error
(
'
undefined
'
)
1691
end
1692
push_opstack
(
v
)
1693
end
1694 1695
function
operators
.
store
(
)
1696
local
b
=
pop_opstack
(
)
1697
local
a
=
pop_opstack
(
)
1698
if
not
a
then
1699
return
ps_error
(
'
stackunderflow
'
)
1700
end
1701
if
not
(
a
[
1
]
=
=
'
name
'
and
a
[
3
]
=
=
'
literal
'
)
then
1702
return
ps_error
(
'
typecheck
'
)
1703
end
1704
if
b
[
7
]
=
=
'
array
'
then
1705
b
[
7
]
=
'
i
'
1706
end
1707
local
val
,
dictloc
=
lookup
(
a
[
4
]
)
1708
if
val
then
1709
local
thedict
=
get_VM
(
dictstack
[
dictloc
]
)
1710
if
thedict
.
access
=
=
'
execute-only
'
or
thedict
.
access
=
=
'
noaccess
'
then
1711
return
ps_error
(
'
invalidaccess
'
)
1712
end
1713
thedict
.
dict
[
a
[
4
]
]
=
b
1714
else
1715
local
thedict
=
get_VM
(
dictstack
[
dictstackptr
]
)
1716
local
access
=
thedict
.
access
1717
local
size
=
thedict
.
size
1718
if
access
=
=
'
execute-only
'
or
access
=
=
'
noaccess
'
then
1719
return
ps_error
(
'
invalidaccess
'
)
1720
end
1721
if
size
=
=
thedict
.
maxsize
then
1722
return
ps_error
(
'
dictfull
'
)
1723
end
1724
thedict
.
size
=
size
+
1
1725
thedict
.
dict
[
a
[
4
]
]
=
b
1726
end
1727
return
true
1728
end
1729 1730
function
operators
.
known
(
)
1731
local
b
=
pop_opstack
(
)
1732
local
a
=
pop_opstack
(
)
1733
if
not
a
then
1734
return
ps_error
(
'
stackunderflow
'
)
1735
end
1736
local
ta
,
aa
,
va
=
a
[
1
]
,
a
[
2
]
,
a
[
4
]
1737
local
tb
,
vb
=
b
[
1
]
,
b
[
4
]
1738
if
ta
~
=
'
dict
'
then
1739
return
ps_error
(
'
typecheck
'
)
1740
end
1741
if
not
(
tb
=
=
'
name
'
or
tb
=
=
'
operator
'
)
then
1742
return
ps_error
(
'
typecheck
'
)
1743
end
1744
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
1745
return
ps_error
(
'
invalidaccess
'
)
1746
end
1747
local
thedict
=
get_VM
(
va
)
1748
push_opstack
{
'
boolean
'
,
'
unlimited
'
,
'
literal
'
,
thedict
.
dict
[
vb
]
and
true
or
false
}
1749
return
true
1750
end
1751 1752
function
operators
.
where
(
)
1753
local
a
=
pop_opstack
(
)
1754
if
not
a
then
1755
return
ps_error
(
'
stackunderflow
'
)
1756
end
1757
if
not
(
a
[
1
]
=
=
'
name
'
and
a
[
3
]
=
=
'
literal
'
)
then
1758
return
ps_error
(
'
typecheck
'
)
1759
end
1760
local
val
,
dictloc
=
lookup
(
get_VM
(
a
[
4
]
)
)
1761
local
thedict
=
dictloc
and
get_VM
(
dictstack
[
dictloc
]
)
-- fixed
1762
if
val
then
1763
if
thedict
.
access
=
=
'
execute-only
'
or
thedict
.
access
=
=
'
noaccess
'
then
1764
return
ps_error
(
'
invalidaccess
'
)
1765
end
1766
push_opstack
{
'
dict
'
,
'
unlimited
'
,
'
literal
'
,
dictstack
[
dictloc
]
}
1767
push_opstack
{
'
boolean
'
,
'
unlimited
'
,
'
literal
'
,
true
}
1768
else
1769
push_opstack
{
'
boolean
'
,
'
unlimited
'
,
'
literal
'
,
false
}
1770
end
1771
return
true
1772
end
1773 1774
function
operators
.
currentdict
(
)
1775
push_opstack
{
'
dict
'
,
'
unlimited
'
,
'
literal
'
,
dictstack
[
dictstackptr
]
}
1776
return
true
1777
end
1778 1779
function
operators
.
countdictstack
(
)
1780
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
dictstackptr
}
1781
return
true
1782
end
1783 1784
function
operators
.
dictstack
(
)
1785
local
a
=
pop_opstack
(
)
1786
if
not
a
then
1787
return
ps_error
(
'
stackunderflow
'
)
1788
end
1789
if
not
a
[
1
]
=
=
'
array
'
then
1790
return
ps_error
(
'
typecheck
'
)
1791
end
1792
if
not
a
[
2
]
=
=
'
unlimited
'
then
1793
return
ps_error
(
'
invalidaccess
'
)
1794
end
1795
if
a
[
6
]
<
dictstackptr
then
1796
return
ps_error
(
'
rangecheck
'
)
1797
end
1798
local
thearray
=
get_VM
(
a
[
4
]
)
1799
local
subarray
=
{
}
1800
for
i
=
1
,
dictstackptr
do
1801
thearray
[
n
]
=
{
'
dict
'
,
'
unlimited
'
,
'
literal
'
,
dictstack
[
i
]
}
1802
subarray
[
n
]
=
thearray
[
i
]
1803
end
1804
a
[
5
]
=
a
[
5
]
+
dictstackptr
1805
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
subarray
)
,
dictstackptr
,
dictstackptr
,
'
'
}
1806
return
true
1807
end
1808 1809
-- String operators
1810
--
1811
-- +string ^length ^get ^put ^getinterval ^putinterval ^copy ^forall +anchorsearch +search
1812
-- +token
1813 1814
function
operators
.
string
(
)
1815
local
a
=
pop_opstack
(
)
1816
if
not
a
then
1817
return
ps_error
(
'
stackunderflow
'
)
1818
end
1819
local
ta
,
va
=
a
[
1
]
,
a
[
4
]
1820
if
ta
~
=
'
integer
'
then
1821
return
ps_error
(
'
typecheck
'
)
1822
end
1823
if
va
<
0
then
1824
return
ps_error
(
'
rangecheck
'
)
1825
end
1826
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
'
'
)
,
1
,
va
}
1827
end
1828 1829
function
operators
.
anchorsearch
(
)
1830
local
b
=
pop_opstack
(
)
1831
local
a
=
pop_opstack
(
)
1832
if
not
a
then
1833
return
ps_error
(
'
stackunderflow
'
)
1834
end
1835
local
ta
,
aa
,
va
=
a
[
1
]
,
a
[
2
]
,
a
[
4
]
1836
local
tb
,
ab
,
vb
=
b
[
1
]
,
b
[
2
]
,
b
[
4
]
1837
if
not
ta
~
=
'
string
'
then
1838
return
ps_error
(
'
typecheck
'
)
1839
end
1840
if
tb
~
=
'
string
'
then
1841
return
ps_error
(
'
typecheck
'
)
1842
end
1843
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
1844
return
ps_error
(
'
invalidaccess
'
)
1845
end
1846
if
ab
=
=
'
noaccess
'
or
ab
=
=
'
execute-only
'
then
1847
return
ps_error
(
'
invalidaccess
'
)
1848
end
1849
local
thestring
=
get_VM
(
va
)
1850
local
thesearch
=
get_VM
(
vb
)
1851
local
prefix
=
sub
(
thestring
,
1
,
#
thesearch
)
1852
if
prefix
=
=
thesearch
then
1853
if
aa
=
=
'
read-only
'
then
1854
return
ps_error
(
'
invalidaccess
'
)
1855
end
1856
local
post
=
sub
(
thestring
,
#
thesearch
+
1
)
1857
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
post
)
,
1
,
#
post
}
1858
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
prefix
)
,
1
,
#
prefix
}
1859
push_opstack
(
b_true
)
1860
else
1861
push_opstack
(
a
)
1862
push_opstack
(
b_false
)
1863
end
1864
return
true
1865
end
1866 1867
function
operators
.
search
(
)
1868
local
b
=
pop_opstack
(
)
1869
local
a
=
pop_opstack
(
)
1870
if
not
a
then
1871
return
ps_error
(
'
stackunderflow
'
)
1872
end
1873
local
ta
,
aa
,
va
=
a
[
1
]
,
a
[
2
]
,
a
[
4
]
1874
local
tb
,
ab
,
vb
=
b
[
1
]
,
b
[
2
]
,
b
[
4
]
1875
if
not
ta
~
=
'
string
'
then
1876
return
ps_error
(
'
typecheck
'
)
1877
end
1878
if
tb
~
=
'
string
'
then
1879
return
ps_error
(
'
typecheck
'
)
1880
end
1881
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
1882
return
ps_error
(
'
invalidaccess
'
)
1883
end
1884
if
ab
=
=
'
noaccess
'
or
ab
=
=
'
execute-only
'
then
1885
return
ps_error
(
'
invalidaccess
'
)
1886
end
1887
local
thestring
=
get_VM
(
a
[
4
]
)
1888
local
thesearch
=
get_VM
(
b
[
4
]
)
1889
-- hm, can't this be done easier?
1890
local
n
=
1
1891
local
match
1892
while
n
+
#
thesearch
-1
<
=
#
thestring
do
1893
match
=
sub
(
thestring
,
n
,
n
+
#
thesearch
-1
)
1894
if
match
=
=
thesearch
then
1895
break
1896
end
1897
n
=
n
+
1
1898
end
1899
if
match
=
=
thesearch
then
1900
if
aa
=
=
'
read-only
'
then
1901
return
ps_error
(
'
invalidaccess
'
)
1902
end
1903
local
prefix
=
sub
(
thestring
,
1
,
n
-1
)
1904
local
post
=
sub
(
thestring
,
#
thesearch
+
n
)
1905
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
post
)
,
1
,
#
post
}
1906
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
thesearch
)
,
1
,
#
thesearch
}
1907
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
prefix
)
,
1
,
#
prefix
}
1908
push_opstack
(
b_true
)
1909
else
1910
push_opstack
(
a
)
1911
push_opstack
(
b_false
)
1912
end
1913
return
true
1914
end
1915 1916
function
operators
.
token
(
)
1917
local
a
=
pop_opstack
(
)
1918
if
not
a
then
1919
return
ps_error
(
'
stackunderflow
'
)
1920
end
1921
local
ta
,
aa
,
va
=
a
[
1
]
,
a
[
2
]
,
a
[
4
]
1922
if
not
(
ta
=
=
'
string
'
or
ta
=
=
'
file
'
)
then
1923
return
ps_error
(
'
typecheck
'
)
1924
end
1925
if
aa
~
=
'
unlimited
'
then
1926
return
ps_error
(
'
invalidaccess
'
)
1927
end
1928
-- some fiddling with the tokenization process is needed
1929
if
ta
=
=
'
string
'
then
1930
local
top
=
execstackptr
1931
push_execstack
{
'
.token
'
,
'
unlimited
'
,
'
literal
'
,
false
}
1932
push_execstack
{
a
[
1
]
,
a
[
2
]
,
'
executable
'
,
va
,
1
,
a
[
6
]
}
1933
local
v
,
err
=
next_object
(
)
1934
if
not
v
then
1935
pop_execstack
(
)
1936
pop_execstack
(
)
1937
push_opstack
(
b_false
)
1938
else
1939
local
q
=
pop_execstack
(
)
1940
if
execstack
[
execstackptr
]
[
1
]
=
=
'
.token
'
then
1941
pop_execstack
(
)
1942
end
1943
local
tq
,
vq
=
q
[
1
]
,
q
[
4
]
1944
if
tq
=
=
'
string
'
and
vq
~
=
va
then
1945
push_execstack
(
q
)
1946
end
1947
local
thestring
,
substring
1948
if
vq
~
=
va
then
1949
thestring
=
"
"
1950
substring
=
"
"
1951
else
1952
thestring
=
get_VM
(
vq
)
1953
substring
=
sub
(
thestring
,
q
[
5
]
or
0
)
1954
end
1955
push_opstack
{
ta
,
aa
,
a
[
3
]
,
add_VM
(
substring
)
,
1
,
#
substring
}
1956
push_opstack
(
v
)
1957
push_opstack
(
b_true
)
1958
end
1959
else
-- file
1960
if
a
[
7
]
~
=
'
r
'
then
1961
return
ps_error
(
'
invalidaccess
'
)
1962
end
1963
push_execstack
{
'
.token
'
,
'
unlimited
'
,
'
literal
'
,
false
}
1964
push_execstack
{
'
file
'
,
'
unlimited
'
,
'
executable
'
,
va
,
a
[
5
]
,
a
[
6
]
,
a
[
7
]
,
a
[
8
]
}
1965
local
v
,
err
=
next_object
(
)
1966
if
not
v
then
1967
pop_execstack
(
)
1968
pop_execstack
(
)
1969
push_opstack
(
b_false
)
1970
else
1971
local
q
=
pop_execstack
(
)
-- the file
1972
a
[
5
]
=
q
[
5
]
1973
if
execstack
[
execstackptr
]
[
1
]
=
=
'
.token
'
then
1974
pop_execstack
(
)
1975
end
1976
push_opstack
(
v
)
1977
push_opstack
(
b_true
)
1978
end
1979
end
1980
return
true
1981
end
1982 1983
-- Relational, boolean and bitwise operators
1984
--
1985
-- +eq +ne +ge +gt +le +lt +and +not +or +xor ^true ^false +bitshift
1986 1987
local
function
both
(
)
1988
local
b
=
pop_opstack
(
)
1989
local
a
=
pop_opstack
(
)
1990
if
not
a
then
1991
return
ps_error
(
'
stackunderflow
'
)
1992
end
1993
local
ta
,
aa
=
a
[
1
]
,
a
[
2
]
1994
local
tb
,
ab
=
b
[
1
]
,
b
[
2
]
1995
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
1996
return
ps_error
(
'
invalidaccess
'
)
1997
end
1998
if
ab
=
=
'
noaccess
'
or
ab
=
=
'
execute-only
'
then
1999
return
ps_error
(
'
invalidaccess
'
)
2000
end
2001
if
(
ta
=
=
'
dict
'
and
tb
=
=
'
dict
'
)
or
(
ta
=
=
'
array
'
and
tb
=
=
'
array
'
)
then
2002
return
true
,
a
[
4
]
,
b
[
4
]
2003
elseif
(
(
ta
=
=
'
string
'
or
ta
=
=
'
name
'
)
and
(
tb
=
=
'
string
'
or
tb
=
=
'
name
'
)
)
then
2004
local
astr
=
get_VM
(
a
[
4
]
)
2005
local
bstr
=
get_VM
(
b
[
4
]
)
2006
return
true
,
astr
,
bstr
2007
elseif
(
(
ta
=
=
'
integer
'
or
ta
=
=
'
real
'
)
and
(
tb
=
=
'
integer
'
or
tb
=
=
'
real
'
)
)
or
(
ta
=
=
tb
)
then
2008
return
true
,
a
[
4
]
,
b
[
4
]
2009
else
2010
return
ps_error
(
'
typecheck
'
)
2011
end
2012
return
true
2013
end
2014 2015
function
operators
.
eq
(
)
2016
local
ok
,
a
,
b
=
both
(
)
2017
if
ok
then
2018
push_opstack
(
a
=
=
b
and
b_true
or
b_false
)
2019
return
true
2020
else
2021
return
a
2022
end
2023
end
2024 2025
function
operators
.
ne
(
)
2026
local
ok
,
a
,
b
=
both
(
)
2027
if
ok
then
2028
push_opstack
(
a
~
=
b
and
b_true
or
b_false
)
2029
return
true
2030
else
2031
return
a
2032
end
2033
end
2034 2035
local
function
both
(
)
2036
local
b
=
pop_opstack
(
)
2037
local
a
=
pop_opstack
(
)
2038
if
not
a
then
2039
return
ps_error
(
'
stackunderflow
'
)
2040
end
2041
local
aa
,
ab
=
a
[
2
]
,
b
[
2
]
2042
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
2043
return
ps_error
(
'
invalidaccess
'
)
2044
end
2045
if
ab
=
=
'
noaccess
'
or
ab
=
=
'
execute-only
'
then
2046
return
ps_error
(
'
invalidaccess
'
)
2047
end
2048
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
2049
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
2050
if
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
and
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
2051
return
true
,
va
,
vb
2052
elseif
ta
=
=
'
string
'
and
tb
=
=
'
string
'
then
2053
local
va
=
get_VM
(
va
)
2054
local
vb
=
get_VM
(
vb
)
2055
return
true
,
va
,
vb
2056
else
2057
return
ps_error
(
'
typecheck
'
)
2058
end
2059
end
2060 2061
function
operators
.
ge
(
)
2062
local
ok
,
a
,
b
=
both
(
)
2063
if
ok
then
2064
push_opstack
(
a
>
=
b
and
b_true
or
b_false
)
2065
return
true
2066
else
2067
return
a
2068
end
2069
end
2070 2071
function
operators
.
gt
(
)
2072
local
ok
,
a
,
b
=
both
(
)
2073
if
ok
then
2074
push_opstack
(
a
>
b
and
b_true
or
b_false
)
2075
return
true
2076
else
2077
return
a
2078
end
2079
end
2080 2081
function
operators
.
le
(
)
2082
local
ok
,
a
,
b
=
both
(
)
2083
if
ok
then
2084
push_opstack
(
a
<
=
b
and
b_true
or
b_false
)
2085
return
true
2086
else
2087
return
a
2088
end
2089
end
2090 2091
function
operators
.
lt
(
)
2092
local
ok
,
a
,
b
=
both
(
)
2093
if
ok
then
2094
push_opstack
(
a
<
b
and
b_true
or
b_false
)
2095
return
true
2096
else
2097
return
a
2098
end
2099
end
2100 2101
local
function
both
(
)
2102
local
b
=
pop_opstack
(
)
2103
local
a
=
pop_opstack
(
)
2104
if
not
a
then
2105
return
ps_error
(
'
stackunderflow
'
)
2106
end
2107
local
aa
,
ab
=
a
[
2
]
,
b
[
2
]
2108
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
2109
return
ps_error
(
'
invalidaccess
'
)
2110
end
2111
if
ab
=
=
'
noaccess
'
or
ab
=
=
'
execute-only
'
then
2112
return
ps_error
(
'
invalidaccess
'
)
2113
end
2114
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
2115
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
2116
if
ta
=
=
'
boolean
'
and
tb
=
=
'
boolean
'
then
2117
return
ta
,
va
,
vb
2118
elseif
ta
=
=
'
integer
'
and
tb
=
=
'
integer
'
then
2119
return
ta
,
va
,
vb
2120
else
2121
return
ps_error
(
'
typecheck
'
)
2122
end
2123
end
2124 2125
operators
[
"
and
"
]
=
function
(
)
2126
local
ok
,
a
,
b
=
both
(
)
2127
if
ok
=
=
'
boolean
'
then
2128
push_opstack
(
(
a
[
1
]
and
b
[
1
]
)
and
b_true
or
b_false
)
2129
return
true
2130
elseif
ok
=
=
'
integer
'
then
2131
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
bitand
(
a
[
1
]
,
b
[
1
]
)
}
2132
return
true
2133
else
2134
return
a
2135
end
2136
end
2137 2138
operators
[
"
or
"
]
=
function
(
)
2139
local
ok
,
a
,
b
=
both
(
)
2140
if
ok
=
=
'
boolean
'
then
2141
push_opstack
(
(
a
[
1
]
or
b
[
1
]
)
and
b_true
or
b_false
)
2142
return
true
2143
elseif
ok
=
=
'
integer
'
then
2144
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
bitor
(
a
[
1
]
,
b
[
1
]
)
}
2145
return
true
2146
else
2147
return
a
2148
end
2149
end
2150 2151
function
operators
.
xor
(
)
2152
local
ok
,
a
,
b
=
both
(
)
2153
if
ok
=
=
'
boolean
'
then
2154
push_opstack
(
(
a
[
1
]
~
=
b
[
1
]
)
and
b_true
or
b_false
)
-- hm, unequal ?
2155
return
true
2156
elseif
ok
=
=
'
integer
'
then
2157
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
bitxor
(
a
[
1
]
,
b
[
1
]
)
}
2158
return
true
2159
else
2160
return
a
2161
end
2162
end
2163 2164
operators
[
"
not
"
]
=
function
(
)
2165
local
a
=
pop_opstack
(
)
2166
if
not
a
then
2167
return
ps_error
(
'
stackunderflow
'
)
2168
end
2169
local
aa
=
a
[
2
]
2170
local
ta
=
a
[
1
]
2171
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
2172
return
ps_error
(
'
invalidaccess
'
)
2173
end
2174
if
ta
=
=
'
boolean
'
then
2175
push_opstack
(
(
not
a
[
4
]
)
and
b_true
or
b_false
)
2176
elseif
ta
=
=
'
integer
'
then
2177
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
-
a
[
4
]
-
1
}
2178
else
2179
return
ps_error
(
'
typecheck
'
)
2180
end
2181
return
true
2182
end
2183 2184
function
operators
.
bitshift
(
)
2185
local
b
=
pop_opstack
(
)
2186
local
a
=
pop_opstack
(
)
2187
if
not
a
then
2188
return
ps_error
(
'
stackunderflow
'
)
2189
end
2190
local
aa
,
ab
=
a
[
2
]
,
b
[
2
]
2191
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
2192
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
2193
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
2194
return
ps_error
(
'
invalidaccess
'
)
2195
end
2196
if
ab
=
=
'
noaccess
'
or
ab
=
=
'
execute-only
'
then
2197
return
ps_error
(
'
invalidaccess
'
)
2198
end
2199
if
not
(
ta
=
=
'
integer
'
and
tb
=
=
'
integer
'
)
then
2200
return
ps_error
(
'
typecheck
'
)
2201
end
2202
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
bitrshift
(
va
,
vb
<
0
and
-
vb
or
vb
)
}
2203
return
true
2204
end
2205 2206
-- Control operators
2207
--
2208
-- +exec +if +ifelse +for +repeat +loop +exit +stop +stopped +countexecstack +execstack
2209
-- +quit +start
2210 2211
function
operators
.
exec
(
)
2212
local
a
=
pop_opstack
(
)
2213
if
not
a
then
2214
return
ps_error
(
'
stackunderflow
'
)
2215
end
2216
if
a
[
1
]
=
=
'
array
'
then
2217
a
[
7
]
=
'
i
'
2218
a
[
5
]
=
1
2219
end
2220
push_execstack
(
a
)
2221
return
true
2222
end
2223 2224
operators
[
"
if
"
]
=
function
(
)
2225
local
b
=
pop_opstack
(
)
2226
local
a
=
pop_opstack
(
)
2227
if
not
a
then
2228
return
ps_error
(
'
stackunderflow
'
)
2229
end
2230
if
a
[
1
]
~
=
'
boolean
'
then
2231
return
ps_error
(
'
typecheck
'
)
2232
end
2233
if
b
[
1
]
~
=
'
array
'
then
2234
return
ps_error
(
'
typecheck
'
)
2235
end
2236
if
a
[
4
]
=
=
true
then
2237
b
[
7
]
=
'
i
'
2238
b
[
5
]
=
1
2239
push_execstack
(
b
)
2240
end
2241
return
true
2242
end
2243 2244
function
operators
.
ifelse
(
)
2245
local
c
=
pop_opstack
(
)
2246
local
b
=
pop_opstack
(
)
2247
local
a
=
pop_opstack
(
)
2248
if
not
a
then
2249
return
ps_error
(
'
stackunderflow
'
)
2250
end
2251
if
a
[
1
]
~
=
'
boolean
'
then
2252
return
ps_error
(
'
typecheck
'
)
2253
end
2254
if
b
[
1
]
~
=
'
array
'
then
2255
return
ps_error
(
'
typecheck
'
)
2256
end
2257
if
c
[
1
]
~
=
'
array
'
then
2258
return
ps_error
(
'
typecheck
'
)
2259
end
2260
if
a
[
4
]
=
=
true
then
2261
b
[
5
]
=
1
2262
b
[
7
]
=
'
i
'
2263
push_execstack
(
b
)
2264
else
2265
c
[
5
]
=
1
2266
c
[
7
]
=
'
i
'
2267
push_execstack
(
c
)
2268
end
2269
return
true
2270
end
2271 2272
operators
[
"
for
"
]
=
function
(
)
2273
local
d
=
pop_opstack
(
)
2274
local
c
=
pop_opstack
(
)
2275
local
b
=
pop_opstack
(
)
2276
local
a
=
pop_opstack
(
)
2277
local
ta
,
tb
,
tc
,
td
=
a
[
1
]
,
b
[
1
]
,
c
[
1
]
,
d
[
1
]
2278
if
not
a
then
2279
return
ps_error
(
'
stackunderflow
'
)
2280
end
2281
if
not
(
ta
=
=
'
integer
'
or
ta
=
=
'
real
'
)
then
2282
return
ps_error
(
'
typecheck
'
)
2283
end
2284
if
not
(
tb
=
=
'
integer
'
or
tb
=
=
'
real
'
)
then
2285
return
ps_error
(
'
typecheck
'
)
2286
end
2287
if
not
(
tc
=
=
'
integer
'
or
tc
=
=
'
real
'
)
then
2288
return
ps_error
(
'
typecheck
'
)
2289
end
2290
if
not
(
td
=
=
'
array
'
and
d
[
3
]
=
=
'
executable
'
)
then
2291
return
ps_error
(
'
typecheck
'
)
2292
end
2293
local
initial
=
a
[
4
]
2294
local
increment
=
b
[
4
]
2295
local
limit
=
c
[
4
]
2296
if
initial
=
=
limit
then
2297
return
true
2298
end
2299
push_execstack
{
'
.exit
'
,
'
unlimited
'
,
'
literal
'
,
false
}
2300
local
curstack
=
execstackptr
2301
local
tokentype
=
(
a
[
1
]
=
=
'
real
'
or
b
[
1
]
=
=
'
real
'
or
c
[
1
]
=
=
'
real
'
)
and
'
real
'
or
'
integer
'
2302
d
[
7
]
=
'
i
'
2303
local
first
,
last
2304
if
increment
>
=
0
then
2305
first
,
last
=
initial
,
limit
2306
else
2307
first
,
last
=
limit
,
limit
2308
end
2309
for
control
=
first
,
last
,
increment
do
2310
if
stopped
then
2311
stopped
=
false
2312
return
false
2313
end
2314
push_opstack
{
tokentype
,
'
unlimited
'
,
'
literal
'
,
control
}
2315
d
[
5
]
=
1
2316
push_execstack
(
d
)
2317
while
curstack
<
execstackptr
do
2318
do_exec
(
)
2319
end
2320
local
entry
=
execstack
[
execstackptr
]
2321
if
entry
[
1
]
=
=
'
.exit
'
and
entry
[
4
]
=
=
true
then
2322
pop_execstack
(
)
2323
return
true
;
2324
end
2325
end
2326
return
true
2327
end
2328 2329
operators
[
"
repeat
"
]
=
function
(
)
2330
local
b
=
pop_opstack
(
)
2331
local
a
=
pop_opstack
(
)
2332
if
not
a
then
2333
return
ps_error
(
'
stackunderflow
'
)
2334
end
2335
if
a
[
1
]
~
=
'
integer
'
then
2336
return
ps_error
(
'
typecheck
'
)
2337
end
2338
if
a
[
4
]
<
0
then
2339
return
ps_error
(
'
rangecheck
'
)
2340
end
2341
if
not
(
b
[
1
]
=
=
'
array
'
and
b
[
3
]
=
=
'
executable
'
)
then
2342
return
ps_error
(
'
typecheck
'
)
2343
end
2344
local
limit
=
a
[
4
]
2345
if
limit
=
=
0
then
2346
return
true
2347
end
2348
push_execstack
{
'
.exit
'
,
'
unlimited
'
,
'
literal
'
,
false
}
2349
local
curstack
=
execstackptr
2350
b
[
7
]
=
'
i
'
2351
local
control
=
0
2352
while
control
<
limit
do
2353
if
stopped
then
2354
stopped
=
false
2355
return
false
2356
end
2357
b
[
5
]
=
1
2358
push_execstack
(
b
)
2359
while
curstack
<
execstackptr
do
2360
do_exec
(
)
2361
end
2362
local
entry
=
execstack
[
execstackptr
]
2363
if
entry
[
1
]
=
=
'
.exit
'
and
entry
[
4
]
=
=
true
then
2364
pop_execstack
(
)
2365
return
true
;
2366
end
2367
control
=
control
+
1
2368
end
2369
return
true
2370
end
2371 2372
function
operators
.
loop
(
)
2373
local
a
=
pop_opstack
(
)
2374
if
not
a
then
2375
return
ps_error
(
'
stackunderflow
'
)
2376
end
2377
if
not
(
a
[
1
]
=
=
'
array
'
and
a
[
3
]
=
=
'
executable
'
)
then
2378
return
ps_error
(
'
typecheck
'
)
2379
end
2380
push_execstack
{
'
.exit
'
,
'
unlimited
'
,
'
literal
'
,
false
}
2381
local
curstack
=
execstackptr
2382
a
[
7
]
=
'
i
'
2383
while
true
do
2384
if
stopped
then
2385
stopped
=
false
2386
return
false
2387
end
2388
a
[
5
]
=
1
2389
push_execstack
(
a
)
2390
while
curstack
<
execstackptr
do
2391
do_exec
(
)
2392
end
2393
if
execstackptr
>
0
then
2394
local
entry
=
execstack
[
execstackptr
]
2395
if
entry
[
1
]
=
=
'
.exit
'
and
entry
[
4
]
=
=
true
then
2396
pop_execstack
(
)
2397
return
true
2398
end
2399
end
2400
end
2401
return
true
2402
end
2403 2404
function
operators
.
exit
(
)
2405
local
v
=
pop_execstack
(
)
2406
while
v
do
2407
local
tv
=
val
[
1
]
2408
if
tv
=
=
'
.exit
'
then
2409
push_execstack
{
'
.exit
'
,
'
unlimited
'
,
'
literal
'
,
true
}
2410
return
true
2411
elseif
tv
=
=
'
.stopped
'
or
tv
=
=
'
.run
'
then
2412
push_execstack
(
v
)
2413
return
ps_error
(
'
invalidexit
'
)
2414
end
2415
v
=
pop_execstack
(
)
2416
end
2417
report
(
"
exit without context, quitting
"
)
2418
push_execstack
{
'
operator
'
,
'
unlimited
'
,
'
executable
'
,
operators
.
quit
,
"
quit
"
}
2419
return
true
2420
end
2421 2422
function
operators
.
stop
(
)
2423
local
v
=
pop_execstack
(
)
2424
while
v
do
2425
if
val
[
1
]
=
=
'
.stopped
'
then
2426
stopped
=
true
2427
push_opstack
{
'
boolean
'
,
'
unlimited
'
,
'
executable
'
,
true
}
2428
return
true
2429
end
2430
v
=
pop_execstack
(
)
2431
end
2432
report
(
"
stop without context, quitting
"
)
2433
push_execstack
{
'
operator
'
,
'
unlimited
'
,
'
executable
'
,
operators
.
quit
,
"
quit
"
}
2434
return
true
2435
end
2436 2437
function
operators
.
stopped
(
)
2438
local
a
=
pop_opstack
(
)
2439
if
not
a
then
2440
return
ps_error
(
'
stackunderflow
'
)
2441
end
2442
-- push a special token on the exec stack (handled by next_object):
2443
push_execstack
{
'
.stopped
'
,
'
unlimited
'
,
'
literal
'
,
false
}
2444
a
[
3
]
=
'
executable
'
2445
if
a
[
1
]
=
=
'
array
'
then
2446
a
[
7
]
=
'
i
'
2447
a
[
5
]
=
1
2448
end
2449
push_execstack
(
a
)
2450
return
true
2451
end
2452 2453
function
operators
.
countexecstack
(
)
2454
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
execstackptr
}
2455
return
true
2456
end
2457 2458
function
operators
.
execstack
(
)
2459
local
a
=
pop_opstack
(
)
2460
if
not
a
then
2461
return
ps_error
(
'
stackunderflow
'
)
2462
end
2463
if
not
a
[
1
]
=
=
'
array
'
then
2464
return
ps_error
(
'
typecheck
'
)
2465
end
2466
if
not
a
[
2
]
=
=
'
unlimited
'
then
2467
return
ps_error
(
'
invalidaccess
'
)
2468
end
2469
if
a
[
6
]
<
execstackptr
then
2470
return
ps_error
(
'
rangecheck
'
)
2471
end
2472
local
thearray
=
get_VM
(
a
[
4
]
)
2473
local
subarray
=
{
}
2474
for
n
=
1
,
execstackptr
do
2475
-- thearray[n] = execstack[n]
2476
-- subarray[n] = thearray[n]
2477
local
v
=
execstack
[
n
]
2478
thearray
[
n
]
=
v
2479
subarray
[
n
]
=
v
2480
a
[
5
]
=
a
[
5
]
+
1
2481
end
2482
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
subarray
)
,
execstackptr
,
execstackptr
,
"
"
}
2483
return
true
2484
end
2485 2486
-- clearing the execstack does the trick,
2487
-- todo: leave open files to be handled by the lua interpreter, for now
2488 2489
function
operators
.
quit
(
)
2490
while
execstackptr
>
=
0
do
-- todo: for loop / slot 0?
2491
execstack
[
execstackptr
]
=
nil
2492
execstackptr
=
execstackptr
-
1
2493
end
2494
return
true
2495
end
2496 2497
-- does nothing, for now
2498 2499
function
operators
.
start
(
)
2500
return
true
2501
end
2502 2503
-- Type, attribute and conversion operators
2504
--
2505
-- +type +cvlit +cvx +xcheck +executeonly +noaccess +readonly +rcheck +wcheck +cvi
2506
-- +cvn +cvr +cvrs +cvs
2507 2508
function
operators
.
type
(
)
2509
local
a
=
pop_opstack
(
)
2510
if
not
a
then
2511
return
ps_error
(
'
stackunderflow
'
)
2512
end
2513
push_opstack
{
"
name
"
,
"
unlimited
"
,
"
executable
"
,
add_VM
(
a
[
1
]
.
.
"
type
"
)
}
2514
return
true
2515
end
2516 2517
function
operators
.
cvlit
(
)
-- no need to push/pop
2518
local
a
=
get_opstack
(
)
2519
if
not
a
then
2520
return
ps_error
(
'
stackunderflow
'
)
2521
end
2522
a
[
3
]
=
'
literal
'
2523
return
true
2524
end
2525 2526
function
operators
.
cvx
(
)
2527
local
a
=
get_opstack
(
)
2528
if
not
a
then
2529
return
ps_error
(
'
stackunderflow
'
)
2530
end
2531
a
[
3
]
=
'
executable
'
2532
return
true
2533
end
2534 2535
function
operators
.
xcheck
(
)
2536
local
a
=
pop_opstack
(
)
2537
if
not
a
then
2538
return
ps_error
(
'
stackunderflow
'
)
2539
end
2540
push_opstack
(
(
a
[
3
]
=
=
'
executable
'
)
and
b_true
or
b_false
)
2541
return
true
2542
end
2543 2544
function
operators
.
executeonly
(
)
2545
local
a
=
pop_opstack
(
)
-- get no push
2546
if
not
a
then
2547
return
ps_error
(
'
stackunderflow
'
)
2548
end
2549
local
ta
=
a
[
1
]
2550
if
ta
=
=
'
string
'
or
ta
=
=
'
file
'
or
ta
=
=
'
array
'
then
2551
if
a
[
2
]
=
=
'
noaccess
'
then
2552
return
ps_error
(
'
invalidaccess
'
)
2553
end
2554
a
[
2
]
=
'
execute-only
'
2555
else
2556
return
ps_error
(
'
typecheck
'
)
2557
end
2558
push_opstack
(
a
)
2559
return
true
2560
end
2561 2562
function
operators
.
noaccess
(
)
2563
local
a
=
pop_opstack
(
)
2564
if
not
a
then
2565
return
ps_error
(
'
stackunderflow
'
)
2566
end
2567
local
ta
=
a
[
1
]
2568
if
ta
=
=
'
string
'
or
ta
=
=
'
file
'
or
ta
=
=
'
array
'
then
2569
if
a
[
2
]
=
=
'
noaccess
'
then
2570
return
ps_error
(
'
invalidaccess
'
)
2571
end
2572
a
[
2
]
=
'
noaccess
'
2573
elseif
ta
=
=
"
dict
"
then
2574
local
thedict
=
get_VM
(
a
[
4
]
)
2575
if
thedict
.
access
=
=
'
noaccess
'
then
2576
return
ps_error
(
'
invalidaccess
'
)
2577
end
2578
thedict
.
access
=
'
noaccess
'
2579
else
2580
return
ps_error
(
'
typecheck
'
)
2581
end
2582
push_opstack
(
a
)
2583
return
true
2584
end
2585 2586
function
operators
.
readonly
(
)
2587
local
a
=
pop_opstack
(
)
2588
if
not
a
then
2589
return
ps_error
(
'
stackunderflow
'
)
2590
end
2591
local
ta
=
a
[
1
]
2592
if
ta
=
=
'
string
'
or
ta
=
=
'
file
'
or
ta
=
=
'
array
'
then
2593
local
aa
=
a
[
2
]
2594
if
aa
=
=
'
noaccess
'
or
aa
=
=
'
execute-only
'
then
2595
return
ps_error
(
'
invalidaccess
'
)
2596
end
2597
a
[
2
]
=
'
read-only
'
2598
elseif
ta
=
=
'
dict
'
then
2599
local
thedict
=
get_VM
(
a
[
4
]
)
2600
local
access
=
thedict
.
access
2601
if
access
=
=
'
noaccess
'
or
access
=
=
'
execute-only
'
then
2602
return
ps_error
(
'
invalidaccess
'
)
2603
end
2604
thedict
.
access
=
'
read-only
'
2605
else
2606
return
ps_error
(
'
typecheck
'
)
2607
end
2608
push_opstack
(
a
)
2609
return
true
2610
end
2611 2612
function
operators
.
rcheck
(
)
2613
local
a
=
pop_opstack
(
)
2614
if
not
a
then
2615
return
ps_error
(
'
stackunderflow
'
)
2616
end
2617
local
ta
=
a
[
1
]
2618
local
aa
2619
if
ta
=
=
'
string
'
or
ta
=
=
'
file
'
or
ta
=
=
'
array
'
then
2620
aa
=
a
[
2
]
2621
elseif
ta
=
=
'
dict
'
then
2622
aa
=
get_VM
(
a
[
4
]
)
.
access
2623
else
2624
return
ps_error
(
'
typecheck
'
)
2625
end
2626
push_opstack
(
(
aa
=
=
'
unlimited
'
or
aa
=
=
'
read-only
'
)
and
p_true
or
p_false
)
2627
return
true
2628
end
2629 2630
function
operators
.
wcheck
(
)
2631
local
a
=
pop_opstack
(
)
2632
if
not
a
then
2633
return
ps_error
(
'
stackunderflow
'
)
2634
end
2635
local
ta
=
a
[
1
]
2636
local
aa
2637
if
ta
=
=
'
string
'
or
ta
=
=
'
file
'
or
ta
=
=
'
array
'
then
2638
aa
=
a
[
2
]
2639
elseif
ta
=
=
'
dict
'
then
2640
local
thedict
=
get_VM
(
a
[
4
]
)
2641
aa
=
thedict
.
access
2642
else
2643
return
ps_error
(
'
typecheck
'
)
2644
end
2645
push_opstack
(
(
aa
=
=
'
unlimited
'
)
and
p_true
or
p_false
)
2646
return
true
2647
end
2648 2649
function
operators
.
cvi
(
)
2650
local
a
=
pop_opstack
(
)
2651
if
not
a
then
2652
return
ps_error
(
'
stackunderflow
'
)
2653
end
2654
local
ta
=
a
[
1
]
2655
if
ta
=
=
'
string
'
then
2656
push_opstack
(
a
)
2657
local
ret
,
err
=
operators
.
token
(
)
2658
if
not
ret
then
2659
return
ret
,
err
2660
end
2661
local
b
=
pop_opstack
(
)
2662
if
b
[
4
]
=
=
false
then
2663
return
ps_error
(
'
syntaxerror
'
)
2664
end
2665
a
=
pop_opstack
(
)
2666
pop_opstack
(
)
-- get rid of the postmatch string remains
2667
ta
=
a
[
1
]
2668
end
2669
local
aa
=
a
[
2
]
2670
if
not
(
aa
=
=
'
unlimited
'
or
aa
=
=
'
read-only
'
)
then
2671
return
ps_error
(
'
invalidaccess
'
)
2672
end
2673
if
ta
=
=
'
integer
'
then
2674
push_opstack
(
a
)
2675
elseif
ta
=
=
'
real
'
then
2676
local
va
=
a
[
4
]
2677
local
c
=
va
<
0
and
-
floor
(
-
va
)
or
floor
(
ava
)
2678
if
abs
(
c
)
>
MAX_INT
then
2679
return
ps_error
(
'
rangecheck
'
)
2680
end
2681
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
c
}
2682
else
2683
return
ps_error
(
'
typecheck
'
)
2684
end
2685
return
true
2686
end
2687 2688
function
operators
.
cvn
(
)
2689
local
a
=
pop_opstack
(
)
2690
if
not
a
then
2691
return
ps_error
(
'
stackunderflow
'
)
2692
end
2693
local
ta
,
aa
=
a
[
1
]
,
a
[
2
]
2694
local
ta
=
a
[
1
]
2695
if
ta
~
=
'
string
'
then
2696
return
ps_error
(
'
typecheck
'
)
2697
end
2698
if
aa
=
=
'
execute-only
'
or
aa
=
=
'
noaccess
'
then
2699
return
ps_error
(
'
invalidaccess
'
)
2700
end
2701
push_opstack
{
'
name
'
,
aa
,
a
[
3
]
,
add_VM
(
get_VM
(
a
[
4
]
)
)
}
2702
return
true
2703
end
2704 2705
function
operators
.
cvr
(
)
2706
local
a
=
pop_opstack
(
)
2707
if
not
a
then
2708
return
ps_error
(
'
stackunderflow
'
)
2709
end
2710
local
ta
=
a
[
1
]
2711
if
ta
=
=
'
string
'
then
2712
push_opstack
(
a
)
2713
local
ret
,
err
=
operators
.
token
(
)
2714
if
not
ret
then
2715
return
ret
,
err
2716
end
2717
local
b
=
pop_opstack
(
)
2718
if
b
[
4
]
=
=
false
then
2719
return
ps_error
(
'
syntaxerror
'
)
2720
end
2721
a
=
pop_opstack
(
)
2722
pop_opstack
(
)
-- get rid of the postmatch string remains
2723
ta
=
a
[
1
]
2724
end
2725
local
aa
=
a
[
2
]
2726
if
not
(
aa
=
=
'
unlimited
'
or
aa
=
=
'
read-only
'
)
then
2727
return
ps_error
(
'
invalidaccess
'
)
2728
end
2729
if
ta
=
=
'
integer
'
then
2730
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
a
[
4
]
}
2731
elseif
ta
=
=
'
real
'
then
2732
push_opstack
(
a
)
2733
else
2734
return
ps_error
(
'
typecheck
'
)
2735
end
2736
return
true
2737
end
2738 2739
do
2740 2741
local
byte0
=
byte
(
'
0
'
)
2742
local
byteA
=
byte
(
'
A
'
)
-
10
2743 2744
function
operators
.
cvrs
(
)
2745
local
c
=
pop_opstack
(
)
2746
local
b
=
pop_opstack
(
)
2747
local
a
=
pop_opstack
(
)
2748
if
not
a
then
2749
return
ps_error
(
'
stackunderflow
'
)
2750
end
2751
local
ta
,
tb
,
tc
=
a
[
1
]
,
b
[
1
]
,
c
[
1
]
2752
if
not
(
ta
=
=
'
integer
'
or
ta
=
=
'
real
'
)
then
2753
return
ps_error
(
'
typecheck
'
)
2754
end
2755
if
not
tb
=
=
'
integer
'
then
2756
return
ps_error
(
'
typecheck
'
)
2757
end
2758
if
not
tc
=
=
'
string
'
then
2759
return
ps_error
(
'
typecheck
'
)
2760
end
2761
if
not
c
[
2
]
=
=
'
unlimited
'
then
2762
return
ps_error
(
'
invalidaccess
'
)
2763
end
2764
local
va
,
vb
,
vc
=
a
[
4
]
,
b
[
4
]
,
c
[
4
]
2765
if
(
vb
<
2
or
vb
>
36
)
then
2766
return
ps_error
(
'
rangecheck
'
)
2767
end
2768
if
ta
=
=
'
real
'
then
2769
push_opstack
(
a
)
2770
local
ret
,
err
=
operators
.
cvi
(
)
2771
if
ret
then
2772
return
ret
,
err
2773
end
2774
a
=
pop_opstack
(
)
2775
end
2776
-- todo: use an lpeg
2777
local
decimal
=
va
2778
local
str
=
{
}
2779
local
n
=
0
2780
while
decimal
>
0
do
2781
local
digit
=
decimal
%
vb
2782
n
=
n
+
1
2783
str
[
n
]
=
digit
<
10
and
char
(
digit
+
byte0
)
or
char
(
digit
+
byteA
)
2784
decimal
=
floor
(
decimal
/
vb
)
2785
end
2786
if
n
>
c
[
6
]
then
2787
return
ps_error
(
'
rangecheck
'
)
2788
end
2789
str
=
concat
(
reverse
(
str
)
)
2790
local
thestring
=
get_VM
(
vc
)
2791
VM
[
va
]
=
str
.
.
sub
(
thestring
,
n
+
1
,
-1
)
2792
push_opstack
{
c
[
1
]
,
c
[
2
]
,
c
[
3
]
,
add_VM
(
repl
)
,
n
,
n
}
2793
return
true
2794
end
2795 2796
end
2797 2798
function
operators
.
cvs
(
)
2799
local
b
=
pop_opstack
(
)
2800
local
a
=
pop_opstack
(
)
2801
if
not
4
then
2802
return
ps_error
(
'
stackunderflow
'
)
2803
end
2804
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
2805
local
ab
=
b
[
2
]
2806
if
not
tb
=
=
'
string
'
then
2807
return
ps_error
(
'
typecheck
'
)
2808
end
2809
if
not
ab
=
=
'
unlimited
'
then
2810
return
ps_error
(
'
invalidaccess
'
)
2811
end
2812
local
va
,
vb
=
a
[
4
]
,
b
[
4
]
2813
if
ta
=
=
'
real
'
then
2814
if
floor
(
va
)
=
=
va
then
2815
va
=
tostring
(
va
)
.
.
'
.0
'
2816
else
2817
va
=
tostring
(
va
)
2818
end
2819
elseif
ta
=
=
'
integer
'
then
2820
va
=
tostring
(
va
)
2821
elseif
ta
=
=
'
string
'
or
ta
=
=
'
name
'
then
2822
va
=
get_VM
(
va
)
2823
elseif
ta
=
=
'
operator
'
then
2824
va
=
a
[
5
]
2825
elseif
ta
=
=
'
boolean
'
then
2826
va
=
tostring
(
va
)
2827
else
2828
va
=
"
--nostringval--
"
2829
end
2830
local
n
=
#
va
2831
if
n
>
b
[
6
]
then
2832
return
ps_error
(
'
rangecheck
'
)
2833
end
2834
local
thestring
=
get_VM
(
vb
)
2835
VM
[
vb
]
=
va
.
.
sub
(
thestring
,
n
+
1
,
-1
)
2836
push_opstack
{
tb
,
ab
,
b
[
3
]
,
add_VM
(
va
)
,
n
,
n
}
2837
return
true
2838
end
2839 2840
-- File operators
2841
--
2842
-- +file +closefile +read +write +writestring +readhexstring +writehexstring +readline ^token
2843
-- +bytesavailable +flush +flushfile +resetfile +status +run +currentfile +print ^= ^stack
2844
-- +== ^pstack ^prompt +echo
2845 2846
function
operators
.
file
(
)
2847
local
b
=
pop_opstack
(
)
2848
local
a
=
pop_opstack
(
)
2849
if
not
a
then
2850
return
ps_error
(
'
stackunderflow
'
)
2851
end
2852
if
b
[
1
]
~
=
'
string
'
then
2853
return
ps_error
(
'
typecheck
'
)
2854
end
2855
if
a
[
1
]
~
=
'
string
'
then
2856
return
ps_error
(
'
typecheck
'
)
2857
end
2858
local
fmode
=
get_VM
(
b
[
4
]
)
2859
local
fname
=
get_VM
(
a
[
4
]
)
2860
-- only accept (r), (w) and (a)
2861
if
fmode
~
=
"
r
"
and
fmode
~
=
"
w
"
and
fmode
~
=
"
a
"
then
2862
return
ps_error
(
'
typecheck
'
)
2863
end
2864
if
fname
=
=
"
%stdin
"
then
2865
-- can only read from stdin
2866
if
fmode
~
=
"
r
"
then
2867
return
ps_error
(
'
invalidfileaccess
'
)
2868
end
2869
push_opstack
{
'
file
'
,
'
unlimited
'
,
'
literal
'
,
0
,
0
,
0
,
fmode
,
io
.
stdin
}
2870
elseif
fname
=
=
"
%stdout
"
then
2871
-- can't read from stdout i.e. can only append, in fact, but lets ignore that
2872
if
fmode
=
=
"
r
"
then
2873
return
ps_error
(
'
invalidfileaccess
'
)
2874
end
2875
push_opstack
{
'
file
'
,
'
unlimited
'
,
'
literal
'
,
0
,
0
,
0
,
fmode
,
io
.
stdout
}
2876
elseif
fname
=
=
"
%stderr
"
then
2877
-- cant read from stderr i.e. can only append, in fact, but lets ignore that
2878
if
fmode
=
=
"
r
"
then
2879
return
ps_error
(
'
invalidfileaccess
'
)
2880
end
2881
push_opstack
{
'
file
'
,
'
unlimited
'
,
'
literal
'
,
0
,
0
,
0
,
fmode
,
io
.
stderr
}
2882
elseif
fname
=
=
"
%statementedit
"
or
fname
=
=
"
%lineedit
"
then
2883
return
ps_error
(
'
invalidfileaccess
'
)
2884
else
2885
-- so it is a normal file
2886
local
myfile
,
error
=
io
.
open
(
fname
,
fmode
)
2887
if
not
myfile
then
2888
return
ps_error
(
'
undefinedfilename
'
)
2889
end
2890
if
fmode
=
=
'
r
'
then
2891
l
=
myfile
:
read
(
"
*a
"
)
2892
if
not
l
then
2893
return
ps_error
(
'
invalidfileaccess
'
)
2894
end
2895
-- myfile:close() -- do not close here, easier later on
2896
push_opstack
{
'
file
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
l
)
,
1
,
#
l
,
fmode
,
myfile
}
2897
else
2898
push_opstack
{
'
file
'
,
'
unlimited
'
,
'
literal
'
,
0
,
0
,
0
,
fmode
,
myfile
}
2899
end
2900
end
2901
return
true
2902
end
2903 2904
function
operators
.
read
(
)
2905
local
a
=
pop_opstack
(
)
2906
if
not
a
then
2907
return
ps_error
(
'
stackunderflow
'
)
2908
end
2909
if
a
[
1
]
~
=
'
file
'
then
2910
return
ps_error
(
'
typecheck
'
)
2911
end
2912
if
a
[
7
]
~
=
'
r
'
then
2913
return
ps_error
(
'
invalidaccess
'
)
2914
end
2915
local
b
2916
local
v
=
a
[
4
]
2917
local
f
=
a
[
8
]
2918
if
v
>
0
then
2919
local
thestr
=
get_VM
(
v
)
2920
local
n
=
a
[
5
]
2921
if
n
<
a
[
6
]
then
2922
byte
=
sub
(
thestr
,
n
,
n
+
1
)
2923
-- a[5] = n + 1
2924
end
2925
else
-- %stdin
2926
b
=
f
:
read
(
1
)
2927
end
2928
if
b
then
2929
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
byte
(
b
)
}
2930
push_opstack
(
p_true
)
2931
else
2932
f
:
close
(
)
2933
push_opstack
(
p_false
)
2934
end
2935
return
true
2936
end
2937 2938
function
operators
.
write
(
)
2939
local
b
=
pop_opstack
(
)
2940
local
a
=
pop_opstack
(
)
2941
if
not
a
then
2942
return
ps_error
(
'
stackunderflow
'
)
2943
end
2944
if
b
[
1
]
~
=
'
integer
'
then
2945
return
ps_error
(
'
typecheck
'
)
2946
end
2947
if
a
[
1
]
~
=
'
file
'
then
2948
return
ps_error
(
'
typecheck
'
)
2949
end
2950
if
a
[
7
]
=
=
'
r
'
then
2951
return
ps_error
(
'
ioerror
'
)
2952
end
2953
a
[
8
]
:
write
(
char
(
b
[
4
]
%
256
)
)
2954
return
true
2955
end
2956 2957
function
operators
.
writestring
(
)
2958
local
b
=
pop_opstack
(
)
2959
local
a
=
pop_opstack
(
)
2960
if
not
a
then
2961
return
ps_error
(
'
stackunderflow
'
)
2962
end
2963
if
b
[
1
]
~
=
'
string
'
then
2964
return
ps_error
(
'
typecheck
'
)
2965
end
2966
if
a
[
1
]
~
=
'
file
'
then
2967
return
ps_error
(
'
typecheck
'
)
2968
end
2969
if
a
[
7
]
=
=
'
r
'
then
2970
return
ps_error
(
'
ioerror
'
)
2971
end
2972
a
[
8
]
:
write
(
get_VM
(
b
[
4
]
)
)
2973
return
true
2974
end
2975 2976
function
operators
.
writehexstring
(
)
2977
local
b
=
pop_opstack
(
)
2978
local
a
=
pop_opstack
(
)
2979
if
not
a
then
2980
return
ps_error
(
'
stackunderflow
'
)
2981
end
2982
if
b
[
1
]
~
=
'
string
'
then
2983
return
ps_error
(
'
typecheck
'
)
2984
end
2985
if
a
[
1
]
~
=
'
file
'
then
2986
return
ps_error
(
'
typecheck
'
)
2987
end
2988
if
a
[
7
]
=
=
'
r
'
then
2989
return
ps_error
(
'
ioerror
'
)
2990
end
2991
local
f
=
a
[
8
]
2992
local
s
=
get_VM
(
b
[
4
]
)
2993
for
w
in
gmatch
(
s
,
"
.
"
)
do
2994
f
:
write
(
format
(
"
%x
"
,
byte
(
w
)
)
)
-- we have a table for that somewhere
2995
end
2996
return
true
2997
end
2998 2999
do
3000 3001
local
function
get_string_line
(
a
)
3002
local
str
=
get_VM
(
a
[
4
]
)
3003
local
start
=
a
[
5
]
3004
local
theend
=
a
[
6
]
3005
if
start
=
=
theend
then
3006
return
nil
3007
end
3008
str
=
match
(
str
,
"
[\n\r]*([^\n\r]*)
"
,
start
)
3009
a
[
5
]
=
a
[
5
]
+
#
str
+
1
-- ?
3010
return
str
3011
end
3012 3013
local
function
get_hexstring_line
(
a
,
b
)
3014
local
thestring
=
get_VM
(
a
[
4
]
)
3015
local
start
,
theend
=
a
[
5
]
,
a
[
6
]
3016
if
start
=
=
theend
then
3017
return
nil
3018
end
3019
local
prefix
,
result
,
n
=
nil
,
{
}
,
0
3020
local
nmax
=
b
[
6
]
3021
while
start
<
theend
do
3022
local
b
=
sub
(
thestring
,
start
,
start
)
3023
if
not
b
then
3024
break
3025
end
3026
local
hexbyte
=
tonumber
(
b
,
16
)
3027
if
not
hexbyte
then
3028
-- skip
3029
elseif
prefix
then
3030
n
=
n
+
1
3031
result
[
n
]
=
char
(
prefix
*
16
+
hexbyte
)
3032
if
n
=
=
nmax
then
3033
break
3034
else
3035
prefix
=
nil
3036
end
3037
else
3038
prefix
=
hexbyte
3039
end
3040
start
=
start
+
1
3041
end
3042
a
[
5
]
=
start
+
1
-- ?
3043
return
concat
(
result
)
3044
end
3045 3046
function
operators
.
readline
(
)
3047
local
b
=
pop_opstack
(
)
3048
local
a
=
pop_opstack
(
)
3049
if
not
a
then
3050
return
ps_error
(
'
stackunderflow
'
)
3051
end
3052
if
a
[
1
]
~
=
'
file
'
then
3053
return
ps_error
(
'
typecheck
'
)
3054
end
3055
if
a
[
7
]
~
=
'
r
'
then
3056
return
ps_error
(
'
invalidaccess
'
)
3057
end
3058
local
va
=
a
[
4
]
3059
if
va
>
0
then
3060
va
=
get_string_line
(
a
)
3061
else
3062
va
=
a
[
8
]
:
read
(
'
*l
'
)
3063
end
3064
if
not
va
then
3065
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
'
'
)
,
0
,
0
}
3066
push_opstack
(
p_false
)
3067
else
3068
local
n
=
#
va
3069
if
n
>
b
[
6
]
then
3070
return
ps_error
(
'
rangecheck
'
)
3071
end
3072
local
thestring
=
get_VM
(
b
[
4
]
)
3073
VM
[
b
[
4
]
]
=
va
.
.
sub
(
thestring
,
#
va
+
1
,
-1
)
3074
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
va
)
,
n
,
n
}
3075
push_opstack
(
p_true
)
3076
end
3077
return
true
3078
end
3079 3080
function
operators
.
readhexstring
(
)
3081
local
b
=
pop_opstack
(
)
3082
local
a
=
pop_opstack
(
)
3083
if
not
a
then
3084
return
ps_error
(
'
stackunderflow
'
)
3085
end
3086
local
ta
=
a
[
1
]
3087
if
not
(
ta
=
=
'
string
'
or
ta
=
=
'
file
'
)
then
3088
return
ps_error
(
'
typecheck
'
)
3089
end
3090
local
thefile
=
a
[
8
]
3091
local
va
=
a
[
4
]
3092
if
va
>
0
then
3093
va
=
get_hexstring_line
(
a
,
b
)
3094
else
3095
local
prefix
,
result
,
n
=
nil
,
{
}
,
0
3096
-- todo: read #va bytes and lpeg
3097
while
true
do
3098
local
b
=
thefile
:
read
(
1
)
3099
if
not
b
then
3100
break
3101
end
3102
local
hexbyte
=
tonumber
(
b
,
16
)
3103
local
nmax
=
b
[
6
]
3104
if
not
hexbyte
then
3105
-- skip
3106
elseif
prefix
then
3107
n
=
n
+
1
3108
result
[
n
]
=
char
(
prefix
*
16
+
hexbyte
)
3109
if
n
=
=
nmax
then
3110
break
3111
else
3112
prefix
=
nil
3113
end
3114
else
3115
prefix
=
hexbyte
3116
end
3117
end
3118
va
=
concat
(
result
)
3119
end
3120
local
thestring
=
get_VM
(
b
[
4
]
)
3121
local
n
=
#
va
3122
VM
[
b
[
4
]
]
=
repl
.
.
sub
(
thestring
,
n
+
1
,
-1
)
3123
push_opstack
{
b
[
1
]
,
b
[
2
]
,
b
[
3
]
,
add_VM
(
va
)
,
n
,
n
}
3124
push_opstack
(
(
n
=
=
b
[
6
]
)
and
p_true
or
p_false
)
3125
return
true
3126
end
3127 3128
end
3129 3130
function
operators
.
flush
(
)
3131
io
.
flush
(
)
3132
return
true
3133
end
3134 3135
function
operators
.
bytesavailable
(
)
3136
local
a
=
pop_opstack
(
)
3137
if
not
a
then
3138
return
ps_error
(
'
stackunderflow
'
)
3139
end
3140
if
a
[
1
]
~
=
'
file
'
then
3141
return
ps_error
(
'
typecheck
'
)
3142
end
3143
if
a
[
7
]
~
=
'
r
'
then
3144
return
ps_error
(
'
typecheck
'
)
3145
end
3146
local
waiting
=
(
a
[
4
]
>
0
)
and
(
a
[
6
]
-
a
[
5
]
+
1
)
or
-1
3147
push_opstack
{
"
integer
"
,
"
unlimited
"
,
"
literal
"
,
waiting
}
3148
return
true
3149
end
3150 3151
-- this does not really do anything useful
3152 3153
function
operators
.
resetfile
(
)
3154
local
a
=
pop_opstack
(
)
3155
if
not
a
then
3156
return
ps_error
(
'
stackunderflow
'
)
3157
end
3158
if
a
[
1
]
~
=
'
file
'
then
3159
return
ps_error
(
'
typecheck
'
)
3160
end
3161
return
true
3162
end
3163 3164
function
operators
.
flushfile
(
)
3165
local
a
=
pop_opstack
(
)
3166
if
not
a
then
3167
return
ps_error
(
'
stackunderflow
'
)
3168
end
3169
if
a
[
1
]
~
=
'
file
'
then
3170
return
ps_error
(
'
typecheck
'
)
3171
end
3172
if
a
[
4
]
>
0
then
3173
a
[
5
]
=
a
[
6
]
3174
else
3175
a
[
8
]
:
flush
(
)
3176
end
3177
return
true
3178
end
3179 3180
function
operators
.
closefile
(
)
3181
local
a
=
pop_opstack
(
)
3182
if
not
a
then
3183
return
ps_error
(
'
stackunderflow
'
)
3184
end
3185
if
a
[
1
]
~
=
'
file
'
then
3186
return
ps_error
(
'
typecheck
'
)
3187
end
3188
if
a
[
7
]
=
=
'
r
'
then
3189
a
[
5
]
=
a
[
6
]
3190
else
3191
push_opstack
(
a
)
3192
operators
.
flushfile
(
)
3193
end
3194
a
[
8
]
:
close
(
)
3195
return
true
3196
end
3197 3198
function
operators
.
status
(
)
3199
local
a
=
pop_opstack
(
)
3200
if
not
a
then
3201
return
ps_error
(
'
stackunderflow
'
)
3202
end
3203
if
a
[
1
]
~
=
'
file
'
then
3204
return
ps_error
(
'
typecheck
'
)
3205
end
3206
local
state
=
io
.
type
(
a
[
8
]
)
3207
push_opstack
{
"
boolean
"
,
'
unlimited
'
,
'
literal
'
,
not
state
or
state
=
=
"
closed file
"
}
3208
return
true
3209
end
3210 3211
function
operators
.
run
(
)
3212
push_opstack
{
"
string
"
,
"
unlimited
"
,
"
literal
"
,
add_VM
(
"
r
"
)
,
1
,
1
}
3213
local
ret
,
err
=
operators
.
file
(
)
3214
if
not
ret
then
3215
return
ret
,
err
3216
end
3217
ret
,
err
=
operators
.
cvx
(
)
3218
if
not
ret
then
3219
return
ret
,
err
3220
end
3221
local
a
=
pop_opstack
(
)
-- an executable file
3222
push_execstack
{
"
.run
"
,
"
unlimited
"
,
"
literal
"
,
false
}
-- constant
3223
local
curstack
=
execstackptr
3224
local
thefile
=
a
[
8
]
3225
push_execstack
(
a
)
3226
while
curstack
<
execstackptr
do
3227
do_exec
(
)
3228
end
3229
local
state
=
io
.
type
(
thefile
)
3230
if
not
state
or
state
=
=
"
closed file
"
then
3231
-- okay
3232
else
3233
thefile
:
close
(
)
3234
end
3235
if
execstackptr
>
0
then
3236
local
entry
=
execstack
[
execstackptr
]
3237
if
entry
[
1
]
=
=
'
.run
'
and
entry
[
4
]
=
=
true
then
3238
pop_execstack
(
)
3239
end
3240
end
3241
return
true
3242
end
3243 3244
function
operators
.
currentfile
(
)
3245
local
n
=
execstackptr
3246
while
n
>
=
0
do
3247
local
entry
=
execstack
[
n
]
3248
if
entry
[
1
]
=
=
'
file
'
and
entry
[
7
]
=
=
'
r
'
then
3249
push_opstack
(
entry
)
3250
return
true
3251
end
3252
n
=
n
-
1
3253
end
3254
push_opstack
{
'
file
'
,
'
unlimited
'
,
'
executable
'
,
add_VM
(
'
'
)
,
0
,
0
,
'
r
'
,
stdin
}
3255
return
true
3256
end
3257 3258
function
operators
.
print
(
)
3259
local
a
=
pop_opstack
(
)
3260
if
not
a
then
return
3261
ps_error
(
'
stackunderflow
'
)
3262
end
3263
if
a
[
1
]
~
=
'
string
'
then
3264
return
ps_error
(
'
typecheck
'
)
3265
end
3266
report
(
get_VM
(
a
[
4
]
)
)
3267
end
3268 3269
-- '=' is also defined as a procedure below;
3270
--
3271
-- it is actually supposed to do this: "equaldict begin dup type exec end"
3272
-- where each of the entries in equaldict handles one type only, but this
3273
-- works just as well
3274 3275
do
3276 3277
local
pattern
=
Cs
(
3278
Cc
(
"
(
"
)
3279
*
(
3280
P
(
"
\n
"
)
/
"
\\n
"
3281
+
P
(
"
\r
"
)
/
"
\\r
"
3282
+
P
(
"
(
"
)
/
"
\\(
"
3283
+
P
(
"
)
"
)
/
"
\\)
"
3284
+
P
(
"
\\
"
)
/
"
\\\\
"
3285
+
P
(
"
\b
"
)
/
"
\\b
"
3286
+
P
(
"
\t
"
)
/
"
\\t
"
3287
+
P
(
"
\f
"
)
/
"
\\f
"
3288
+
R
(
"
\000\032
"
,
"
\127\255
"
)
/
tonumber
/
formatters
[
"
\\%03o
"
]
3289
+
P
(
1
)
3290
)
^
0
3291
*
Cc
(
"
)
"
)
3292
)
3293 3294
-- print(lpegmatch(pattern,[[h(a\nn)s]]))
3295 3296
local
function
do_operator_equal
(
a
)
3297
local
ta
,
va
=
a
[
1
]
,
a
[
4
]
3298
if
ta
=
=
'
real
'
then
3299
if
floor
(
va
)
=
=
va
then
3300
return
tostring
(
va
.
.
'
.0
'
)
3301
else
3302
return
tostring
(
va
)
3303
end
3304
elseif
ta
=
=
'
integer
'
then
3305
return
tostring
(
va
)
3306
elseif
ta
=
=
'
string
'
then
3307
return
lpegmatch
(
pattern
,
get_VM
(
va
)
)
3308
elseif
ta
=
=
'
boolean
'
then
3309
return
tostring
(
va
)
3310
elseif
ta
=
=
'
operator
'
then
3311
return
'
--
'
.
.
a
[
5
]
.
.
'
--
'
3312
elseif
ta
=
=
'
name
'
then
3313
if
a
[
3
]
=
=
'
literal
'
then
3314
return
'
/
'
.
.
get_VM
(
va
)
3315
else
3316
return
get_VM
(
va
)
3317
end
3318
elseif
ta
=
=
'
array
'
then
3319
va
=
get_VM
(
va
)
3320
local
isexec
=
a
[
3
]
=
=
'
executable
'
3321
local
result
=
{
isexec
and
"
{
"
or
"
[
"
}
3322
local
n
=
1
3323
for
i
=
1
,
#
va
do
3324
n
=
n
+
1
3325
result
[
n
]
=
do_operator_equal
(
va
[
i
]
)
3326
end
3327
result
[
n
+
1
]
=
isexec
and
"
}
"
or
"
]
"
3328
return
concat
(
result
,
"
"
)
3329
elseif
ta
=
=
'
null
'
then
3330
return
'
null
'
3331
elseif
ta
=
=
'
dict
'
then
3332
return
'
-dicttype-
'
3333
elseif
ta
=
=
'
save
'
then
3334
return
'
-savetype-
'
3335
elseif
ta
=
=
'
mark
'
then
3336
return
'
-marktype-
'
3337
elseif
ta
=
=
'
file
'
then
3338
return
'
-filetype-
'
3339
elseif
ta
=
=
'
font
'
then
3340
return
'
-fonttype-
'
3341
end
3342
end
3343 3344
function
operators
.
equal
(
)
3345
local
a
=
pop_opstack
(
)
3346
if
not
a
then
3347
return
ps_error
(
'
stackunderflow
'
)
3348
end
3349
report
(
do_operator_equal
(
a
)
)
3350
return
true
3351
end
3352 3353
end
3354 3355
local
function
commonstack
(
seperator
)
3356
for
n
=
1
,
opstackptr
do
3357
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
seperator
)
,
1
,
1
}
3358
push_opstack
(
opstack
[
n
]
)
3359
push_execstack
{
'
operator
'
,
'
unlimited
'
,
'
executable
'
,
operators
.
print
,
'
print
'
}
3360
push_execstack
{
'
operator
'
,
'
unlimited
'
,
'
executable
'
,
operators
.
equal
,
'
==
'
}
3361
end
3362
return
true
3363
end
3364 3365
function
operators
.
pstack
(
)
3366
return
commonstack
(
"
\n
"
)
3367
end
3368 3369
function
operators
.
stack
(
)
3370
return
commonstack
(
"
"
)
3371
end
3372 3373
-- this does not really do anything useful
3374 3375
function
operators
.
echo
(
)
3376
local
a
=
pop_opstack
(
)
3377
if
not
a
then
3378
return
ps_error
(
'
stackunderflow
'
)
3379
end
3380
if
a
[
1
]
~
=
'
boolean
'
then
3381
return
ps_error
(
'
typecheck
'
)
3382
end
3383
return
true
3384
end
3385 3386
-- Virtual memory operators
3387
--
3388
-- +save +restore +vmstatus
3389 3390
-- to be checked: we do a one-level shallow copy now, not sure if that
3391
-- is good enough yet
3392 3393
local
savelevel
=
0
3394 3395
initializers
[
#
initializers
+
1
]
=
function
(
reset
)
3396
savelevel
=
0
3397
end
3398 3399
function
operators
.
save
(
)
3400
local
saved_VM
=
{
}
3401
-- for k1, v1 in next, VM do
3402
for
k1
=
1
,
#
VM
do
3403
local
v1
=
VM
[
k1
]
3404
if
type
(
v1
)
=
=
"
table
"
then
3405
local
t1
=
{
}
3406
saved_VM
[
k1
]
=
t1
3407
-- for k2, v2 in next, v1 do
3408
for
k2
=
1
,
#
v1
do
3409
local
v2
=
v1
[
k2
]
3410
if
type
(
v2
)
=
=
"
table
"
then
3411
local
t2
=
{
}
3412
t1
[
k2
]
=
t2
3413
-- for k3, v3 in next, v2 do
3414
for
k3
=
1
,
#
v2
do
3415
local
v3
=
v2
[
k3
]
3416
t2
[
k3
]
=
v3
3417
end
3418
else
3419
t1
[
k2
]
=
v2
3420
end
3421
end
3422
else
3423
saved_VM
[
k1
]
=
v1
3424
end
3425
end
3426
push_gsstack
{
'
save
'
,
copy_gsstate
(
)
}
3427
savelevel
=
savelevel
+
1
3428
push_opstack
{
'
save
'
,
'
unlimited
'
,
'
executable
'
,
add_VM
(
saved_VM
)
}
3429
end
3430 3431
function
operators
.
save
(
)
3432
local
saved_VM
=
table
.
copy
(
VM
)
3433
push_gsstack
{
'
save
'
,
copy_gsstate
(
)
}
3434
savelevel
=
savelevel
+
1
3435
push_opstack
{
'
save
'
,
'
unlimited
'
,
'
executable
'
,
add_VM
(
saved_VM
)
}
3436
end
3437 3438
do
3439 3440
local
function
validstack
(
stack
,
index
,
saved_VM
)
3441
-- loop over pstack, execstack, and dictstack to make sure
3442
-- there are no entries with VM_id > #saved_VM
3443
for
i
=
index
,
1
,
-1
do
3444
local
v
=
stack
[
i
]
3445
if
type
(
v
)
=
=
"
table
"
then
3446
local
tv
=
v
[
1
]
3447
if
tv
=
=
"
save
"
or
tv
=
=
"
string
"
or
tv
=
=
"
array
"
or
tv
=
=
"
dict
"
or
tv
=
=
"
name
"
or
tv
=
=
"
file
"
then
3448
-- todo: check on %stdin/%stdout, but should be ok
3449
if
v
[
4
]
>
#
saved_VM
then
3450
return
false
3451
end
3452
end
3453
end
3454
i
=
i
-
1
3455
end
3456
return
true
3457
end
3458 3459
function
operators
.
restore
(
)
3460
local
a
=
pop_opstack
(
)
3461
if
not
a
then
3462
return
ps_error
(
'
stackunderflow
'
)
3463
end
3464
if
a
[
1
]
~
=
'
save
'
then
3465
return
ps_error
(
'
typecheck
'
)
3466
end
3467
if
a
[
4
]
=
=
0
or
savelevel
=
=
0
then
3468
return
ps_error
(
'
invalidrestore
'
)
3469
end
3470
local
saved_VM
=
get_VM
(
a
[
4
]
)
3471
if
directvm
then
3472
else
3473
if
not
validstack
(
execstack
,
execstackptr
,
saved_VM
)
then
3474
return
ps_error
(
'
invalidrestore
'
)
3475
end
3476
if
not
validstack
(
dictstack
,
dictstackptr
,
saved_VM
)
then
3477
return
ps_error
(
'
invalidrestore
'
)
3478
end
3479
if
not
validstack
(
opstack
,
opstackptr
,
saved_VM
)
then
3480
return
ps_error
(
'
invalidrestore
'
)
3481
end
3482
end
3483
while
gsstackptr
>
0
do
3484
local
g
=
gsstack
[
gsstackptr
]
3485
gsstackptr
=
gsstackptr
-
1
3486
if
g
[
1
]
=
=
"
save
"
then
3487
gsstate
=
g
[
2
]
3488
return
3489
end
3490
end
3491
a
[
4
]
=
0
-- invalidate save object
3492
savelevel
=
savelevel
-
1
3493
VM
=
saved_VM
3494
end
3495 3496
end
3497 3498
function
operators
.
vmstatus
(
)
3499
local
n
=
0
-- #VM * 100
3500
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
savelevel
}
3501
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
n
}
3502
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
n
}
3503
return
true
3504
end
3505 3506
-- Miscellaneous operators
3507
--
3508
-- +bind +null +usertime +version
3509 3510
-- the reference manual says bind only ERRORS on typecheck
3511 3512
local
function
bind
(
)
3513
local
a
=
pop_opstack
(
)
3514
if
not
a
then
3515
return
true
-- ps_error('stackunderflow')
3516
end
3517
if
not
a
[
1
]
=
=
'
array
'
then
3518
return
ps_error
(
'
typecheck
'
)
3519
end
3520
local
proc
=
get_VM
(
a
[
4
]
)
3521
for
i
=
1
,
#
proc
do
3522
local
v
=
proc
[
i
]
3523
local
t
=
v
[
1
]
3524
if
t
=
=
'
name
'
then
3525
if
v
[
3
]
=
=
'
executable
'
then
3526
local
op
=
lookup
(
get_VM
(
v
[
4
]
)
)
3527
if
op
and
op
[
1
]
=
=
'
operator
'
then
3528
proc
[
i
]
=
op
3529
end
3530
end
3531
elseif
t
=
=
'
array
'
then
3532
if
v
[
2
]
=
=
'
unlimited
'
then
3533
push_opstack
(
v
)
3534
bind
(
)
-- recurse
3535
pop_opstack
(
)
3536
proc
[
i
]
[
2
]
=
'
read-only
'
3537
end
3538
end
3539
end
3540
push_opstack
(
a
)
3541
end
3542 3543
operators
.
bind
=
bind
3544 3545
function
operators
.
null
(
)
3546
push_opstack
{
'
null
'
,
'
unlimited
'
,
'
literal
'
}
3547
return
true
3548
end
3549 3550
function
operators
.
usertime
(
)
3551
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
floor
(
os
.
clock
(
)
*
1000
)
}
3552
return
true
3553
end
3554 3555
function
operators
.
version
(
)
3556
push_opstack
{
'
string
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
'
23.0
'
)
}
3557
return
true
3558
end
3559 3560
-- Graphics state operators
3561
--
3562
-- +gsave +grestore +grestoreall +initgraphics +setlinewidth +currentlinewidth +setlinecap +currentlinecap
3563
-- +setlinejoin +currentlinejoin +setmiterlimit +currentmiterlimit +setdash +currentdash +setflat +currentflat
3564
-- +setgray +currentgray +sethsbcolor +currenthsbcolor +setrgbcolor +setcmykcolor +currentrgbcolor +setscreen
3565
-- +currentscreen +settransfer +currenttransfer
3566 3567
function
operators
.
gsave
(
)
3568
push_gsstack
{
'
gsave
'
,
copy_gsstate
(
)
}
3569
currentpage
[
#
currentpage
+
1
]
=
{
3570
type
=
'
gsave
'
,
3571
}
3572
return
true
3573
end
3574 3575
function
operators
.
grestore
(
)
3576
if
gsstackptr
>
0
then
3577
local
g
=
gsstack
[
gsstackptr
]
3578
if
g
[
1
]
=
=
"
gsave
"
then
3579
gsstackptr
=
gsstackptr
-
1
3580
gsstate
=
g
[
2
]
3581
end
3582
end
3583
currentpage
[
#
currentpage
+
1
]
=
{
3584
type
=
'
grestore
'
,
3585
}
3586
return
true
3587
end
3588 3589
function
operators
.
grestoreall
(
)
-- needs checking
3590
for
i
=
gsstackptr
,
1
,
-1
do
3591
local
g
=
gsstack
[
i
]
3592
if
g
[
1
]
=
=
"
save
"
then
3593
gsstate
=
g
[
2
]
3594
gsstackptr
=
i
3595
return
true
3596
end
3597
end
3598
gsstackptr
=
0
3599
return
true
3600
end
3601 3602
function
operators
.
initgraphics
(
)
3603
local
newstate
=
copy_gsstate
(
)
-- hm
3604
newstate
.
matrix
=
{
1
,
0
,
0
,
1
,
0
,
0
}
3605
newstate
.
color
=
{
gray
=
0
,
hsb
=
{
}
,
rgb
=
{
}
,
cmyk
=
{
}
,
type
=
"
gray
"
}
3606
newstate
.
position
=
{
}
-- actual x and y undefined
3607
newstate
.
path
=
{
}
3608
newstate
.
linewidth
=
1
3609
newstate
.
linecap
=
0
3610
newstate
.
linejoin
=
0
3611
newstate
.
miterlimit
=
10
3612
newstate
.
dashpattern
=
{
}
3613
newstate
.
dashoffset
=
0
3614
gsstate
=
newstate
3615
device
.
initgraphics
(
)
3616
operators
.
initclip
(
)
3617
return
true
3618
end
3619 3620
function
operators
.
setlinewidth
(
)
3621
local
a
=
pop_opstack
(
)
3622
if
not
a
then
3623
return
ps_error
(
'
stackunderflow
'
)
3624
end
3625
local
t
=
a
[
1
]
3626
if
not
(
t
=
=
'
integer
'
or
t
=
=
'
real
'
)
then
3627
return
ps_error
(
'
typecheck
'
)
3628
end
3629
gsstate
.
linewidth
=
a
[
4
]
3630
return
true
3631
end
3632 3633
function
operators
.
currentlinewidth
(
)
3634
local
w
=
gsstate
.
linewidth
3635
push_opstack
{
3636
(
abs
(
w
)
>
MAX_INT
or
floor
(
w
)
~
=
w
)
and
'
real
'
or
'
integer
'
,
3637
'
unlimited
'
,
3638
'
literal
'
,
3639
w
,
3640
}
3641
return
true
3642
end
3643 3644
function
operators
.
setlinecap
(
)
3645
local
a
=
pop_opstack
(
)
3646
if
not
a
then
3647
return
ps_error
(
'
stackunderflow
'
)
3648
end
3649
if
a
[
1
]
~
=
'
integer
'
then
3650
return
ps_error
(
'
typecheck
'
)
3651
end
3652
local
c
=
a
[
4
]
3653
if
c
>
2
or
c
<
0
then
3654
return
ps_error
(
'
rangecheck
'
)
3655
end
3656
gsstate
.
linecap
=
c
3657
return
true
3658
end
3659 3660
function
operators
.
currentlinecap
(
)
3661
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
gsstate
.
linecap
}
3662
return
true
3663
end
3664 3665
function
operators
.
setlinejoin
(
)
3666
local
a
=
pop_opstack
(
)
3667
if
not
a
then
3668
return
ps_error
(
'
stackunderflow
'
)
3669
end
3670
if
a
[
1
]
~
=
'
integer
'
then
3671
return
ps_error
(
'
typecheck
'
)
3672
end
3673
local
j
=
a
[
4
]
3674
if
j
>
2
or
j
<
0
then
3675
return
ps_error
(
'
rangecheck
'
)
3676
end
3677
gsstate
.
linejoin
=
j
3678
return
true
3679
end
3680 3681
function
operators
.
currentlinejoin
(
)
3682
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
gsstate
.
linejoin
}
3683
return
true
3684
end
3685 3686
function
operators
.
setmiterlimit
(
)
3687
local
a
=
pop_opstack
(
)
3688
if
not
a
then
3689
return
ps_error
(
'
stackunderflow
'
)
3690
end
3691
local
t
=
a
[
1
]
3692
if
not
(
t
=
=
'
integer
'
or
t
=
=
'
real
'
)
then
3693
return
ps_error
(
'
typecheck
'
)
3694
end
3695
local
m
=
a
[
4
]
3696
if
m
<
1
then
3697
return
ps_error
(
'
rangecheck
'
)
3698
end
3699
gsstate
.
miterlimit
=
m
3700
return
true
3701
end
3702 3703
function
operators
.
currentmiterlimit
(
)
3704
local
w
=
gsstate
.
miterlimit
3705
push_opstack
{
3706
(
abs
(
w
)
>
MAX_INT
or
floor
(
w
)
~
=
w
)
and
'
real
'
or
'
integer
'
,
3707
'
unlimited
'
,
3708
'
literal
'
,
3709
w
3710
}
3711
return
true
3712
end
3713 3714
function
operators
.
setdash
(
)
3715
local
b
=
pop_opstack
(
)
3716
local
a
=
pop_opstack
(
)
3717
if
not
a
then
3718
return
ps_error
(
'
stackunderflow
'
)
3719
end
3720
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
3721
if
ta
~
=
'
array
'
then
3722
return
ps_error
(
'
typecheck
'
)
3723
end
3724
if
not
(
tb
=
=
'
integer
'
or
tb
=
=
'
real
'
)
then
3725
return
ps_error
(
'
typecheck
'
)
3726
end
3727
local
pattern
=
{
}
3728
local
total
=
0
3729
local
thearray
=
get_VM
(
a
[
4
]
)
3730
for
i
=
1
,
#
thearray
do
3731
local
a
=
thearray
[
i
]
3732
local
ta
,
va
=
a
[
1
]
,
a
[
4
]
3733
if
ta
~
=
"
integer
"
then
3734
return
ps_error
(
'
typecheck
'
)
3735
end
3736
if
va
<
0
then
3737
return
ps_error
(
'
limitcheck
'
)
3738
end
3739
total
=
total
+
va
3740
pattern
[
#
pattern
+
1
]
=
va
3741
end
3742
if
#
pattern
>
0
and
total
=
=
0
then
3743
return
ps_error
(
'
limitcheck
'
)
3744
end
3745
gsstate
.
dashpattern
=
pattern
3746
gsstate
.
dashoffset
=
b
[
4
]
3747
return
true
3748
end
3749 3750
function
operators
.
currentdash
(
)
3751
local
thearray
=
gsstate
.
dashpattern
3752
local
pattern
=
{
}
3753
for
i
=
1
,
#
thearray
do
3754
pattern
[
i
]
=
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
thearray
[
i
]
}
3755
end
3756
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
pattern
)
,
#
pattern
,
#
pattern
}
3757
local
w
=
gsstate
.
dashoffset
3758
push_opstack
{
3759
(
abs
(
w
)
>
MAX_INT
or
floor
(
w
)
~
=
w
)
and
'
real
'
or
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
w
3760
}
3761
return
true
3762
end
3763 3764
function
operators
.
setflat
(
)
3765
local
a
=
pop_opstack
(
)
3766
if
not
a
then
3767
return
ps_error
(
'
stackunderflow
'
)
3768
end
3769
local
ta
,
va
=
a
[
1
]
,
a
[
4
]
3770
if
not
(
ta
=
=
'
integer
'
or
ta
=
=
'
real
'
)
then
3771
return
ps_error
(
'
typecheck
'
)
3772
end
3773
gsstate
.
flatness
=
va
3774
return
true
3775
end
3776 3777
function
operators
.
currentflat
(
)
3778
local
w
=
gsstate
.
flatness
3779
push_opstack
{
3780
(
abs
(
w
)
>
MAX_INT
or
floor
(
w
)
~
=
w
)
and
'
real
'
or
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
w
3781
}
3782
return
true
3783
end
3784 3785
-- Color conversion functions
3786
--
3787
-- normally, level one colors are based on hsb, but for our backend it is better to
3788
-- stick with the original request when possible
3789 3790
do
3791 3792
local
function
rgb_to_gray
(
r
,
g
,
b
)
3793
return
0
.
30
*
r
+
0
.
59
*
g
+
0
.
11
*
b
3794
end
3795 3796
local
function
cmyk_to_gray
(
c
,
m
,
y
,
k
)
3797
return
0
.
30
*
(
1
.
0
-
min
(
1
.
0
,
c
+
k
)
)
+
0
.
59
*
(
1
.
0
-
min
(
1
.
0
,
m
+
k
)
)
+
0
.
11
*
(
1
.
0
-
min
(
1
.
0
,
y
+
k
)
)
3798
end
3799 3800
local
function
cmyk_to_rgb
(
c
,
m
,
y
,
k
)
3801
return
1
.
0
-
min
(
1
.
0
,
c
+
k
)
,
1
.
0
-
min
(
1
.
0
,
m
+
k
)
,
1
.
0
-
min
(
1
.
0
,
y
+
k
)
3802
end
3803 3804
local
function
rgb_to_hsv
(
r
,
g
,
b
)
3805
local
offset
,
maximum
,
other_1
,
other_2
3806
if
r
>
=
g
and
r
>
=
b
then
3807
offset
,
maximum
,
other_1
,
other_2
=
0
,
r
,
g
,
b
3808
elseif
g
>
=
r
and
g
>
=
b
then
3809
offset
,
maximum
,
other_1
,
other_2
=
2
,
g
,
b
,
r
3810
else
3811
offset
,
maximum
,
other_1
,
other_2
=
4
,
b
,
r
,
g
3812
end
3813
if
maximum
=
=
0
then
3814
return
0
,
0
,
0
3815
end
3816
local
minimum
=
other_1
<
other_2
and
other_1
or
other_2
3817
if
maximum
=
=
minimum
then
3818
return
0
,
0
,
maximum
3819
end
3820
local
delta
=
maximum
-
minimum
3821
return
(
offset
+
(
other_1
-
other_2
)
/
delta
)
/
6
,
delta
/
maximum
,
maximum
3822
end
3823 3824
local
function
gray_to_hsv
(
col
)
3825
return
0
,
0
,
col
3826
end
3827 3828
local
function
gray_to_rgb
(
col
)
3829
return
1
-
col
,
1
-
col
,
1
-
col
3830
end
3831 3832
local
function
gray_to_cmyk
(
col
)
3833
return
0
,
0
,
0
,
col
3834
end
3835 3836
local
function
hsv_to_rgb
(
h
,
s
,
v
)
3837
local
hi
=
floor
(
h
*
6
.
0
)
%
6
3838
local
f
=
(
h
*
6
)
-
floor
(
h
*
6
)
3839
local
p
=
v
*
(
1
-
s
)
3840
local
q
=
v
*
(
1
-
f
*
s
)
3841
local
t
=
v
*
(
1
-
(
1
-
f
)
*
s
)
3842
if
hi
=
=
0
then
3843
return
v
,
t
,
p
3844
elseif
hi
=
=
1
then
3845
return
q
,
v
,
p
3846
elseif
hi
=
=
2
then
3847
return
p
,
v
,
t
3848
elseif
hi
=
=
3
then
3849
return
p
,
q
,
v
3850
elseif
hi
=
=
4
then
3851
return
t
,
p
,
v
3852
elseif
hi
=
=
5
then
3853
return
v
,
p
,
q
3854
end
3855
end
3856 3857
local
function
hsv_to_gray
(
h
,
s
,
v
)
3858
return
rgb_to_gray
(
hsv_to_rgb
(
h
,
s
,
v
)
)
3859
end
3860 3861
-- color operators
3862 3863
function
operators
.
setgray
(
)
3864
local
g
=
pop_opstack
(
)
3865
if
not
g
then
3866
return
ps_error
(
'
stackunderflow
'
)
3867
end
3868
local
gt
=
g
[
1
]
3869
if
not
(
gt
=
=
'
integer
'
or
gt
=
=
'
real
'
)
then
3870
return
ps_error
(
'
typecheck
'
)
3871
end
3872
local
gv
=
g
[
4
]
3873
local
color
=
gsstate
.
color
3874
color
.
type
=
"
gray
"
3875
color
.
gray
=
(
gv
<
0
and
0
)
or
(
gv
>
1
and
1
)
or
gv
3876
return
true
3877
end
3878 3879
function
operators
.
currentgray
(
)
3880
local
color
=
gsstate
.
color
3881
local
t
=
color
.
type
3882
local
s
3883
if
t
=
=
"
gray
"
then
3884
s
=
color
.
gray
3885
elseif
t
=
=
"
rgb
"
then
3886
local
col
=
color
.
rgb
3887
s
=
rgb_to_gray
(
col
[
1
]
,
col
[
2
]
,
col
[
3
]
)
3888
elseif
t
=
=
"
cmyk
"
then
3889
local
col
=
cmyk
3890
s
=
cmyk_to_gray
(
col
[
1
]
,
col
[
2
]
,
col
[
3
]
,
col
[
4
]
)
3891
else
3892
local
col
=
color
.
hsb
3893
s
=
hsv_to_gray
(
col
[
1
]
,
col
[
2
]
,
col
[
3
]
)
3894
end
3895
push_opstack
{
(
s
=
=
0
or
s
=
=
1
)
and
'
integer
'
or
'
real
'
,
'
unlimited
'
,
'
literal
'
,
s
}
3896
return
true
3897
end
3898 3899
function
operators
.
sethsbcolor
(
)
3900
local
b
=
pop_opstack
(
)
3901
local
s
=
pop_opstack
(
)
3902
local
h
=
pop_opstack
(
)
3903
if
not
h
then
3904
return
ps_error
(
'
stackunderflow
'
)
3905
end
3906
local
ht
,
st
,
bt
=
h
[
1
]
,
s
[
1
]
,
b
[
1
]
3907
if
not
(
ht
=
=
'
integer
'
or
ht
=
=
'
real
'
)
then
3908
return
ps_error
(
'
typecheck
'
)
3909
end
3910
if
not
(
st
=
=
'
integer
'
or
st
=
=
'
real
'
)
then
3911
return
ps_error
(
'
typecheck
'
)
3912
end
3913
if
not
(
bt
=
=
'
integer
'
or
bt
=
=
'
real
'
)
then
3914
return
ps_error
(
'
typecheck
'
)
3915
end
3916
local
hv
,
sv
,
bv
=
h
[
4
]
,
s
[
4
]
,
b
[
4
]
3917
local
color
=
gsstate
.
color
3918
color
.
type
=
"
hsb
"
3919
color
.
hsb
=
{
3920
(
hv
<
0
and
0
)
or
(
hv
>
1
and
1
)
or
hv
,
3921
(
sv
<
0
and
0
)
or
(
sv
>
1
and
1
)
or
sv
,
3922
(
bv
<
0
and
0
)
or
(
bv
>
1
and
1
)
or
bv
,
3923
}
3924
return
true
3925
end
3926 3927
function
operators
.
currenthsbcolor
(
)
3928
local
color
=
gsstate
.
color
3929
local
t
=
color
.
type
3930
local
h
,
s
,
b
3931
if
t
=
=
"
gray
"
then
3932
h
,
s
,
b
=
gray_to_hsv
(
color
.
gray
)
3933
elseif
t
=
=
"
rgb
"
then
3934
local
col
=
color
.
rgb
3935
h
,
s
,
b
=
rgb_to_hsv
(
col
[
1
]
,
col
[
2
]
,
col
[
3
]
)
3936
elseif
t
=
=
"
cmyk
"
then
3937
local
col
=
color
.
cmyk
3938
h
,
s
,
b
=
cmyk_to_hsv
(
col
[
1
]
,
col
[
2
]
,
col
[
3
]
,
col
[
4
]
)
3939
else
3940
local
col
=
color
.
hsb
3941
h
,
s
,
b
=
col
[
1
]
,
col
[
2
]
,
col
[
3
]
3942
end
3943
push_opstack
{
(
h
=
=
0
or
h
=
=
1
)
and
'
integer
'
or
'
real
'
,
'
unlimited
'
,
'
literal
'
,
h
}
3944
push_opstack
{
(
s
=
=
0
or
s
=
=
1
)
and
'
integer
'
or
'
real
'
,
'
unlimited
'
,
'
literal
'
,
s
}
3945
push_opstack
{
(
b
=
=
0
or
b
=
=
1
)
and
'
integer
'
or
'
real
'
,
'
unlimited
'
,
'
literal
'
,
b
}
3946
return
true
3947
end
3948 3949
function
operators
.
setrgbcolor
(
)
3950
local
b
=
pop_opstack
(
)
3951
local
g
=
pop_opstack
(
)
3952
local
r
=
pop_opstack
(
)
3953
if
not
r
then
3954
return
ps_error
(
'
stackunderflow
'
)
3955
end
3956
local
rt
,
gt
,
bt
=
r
[
1
]
,
g
[
1
]
,
b
[
1
]
3957
if
not
(
rt
=
=
'
integer
'
or
rt
=
=
'
real
'
)
then
3958
return
ps_error
(
'
typecheck
'
)
3959
end
3960
if
not
(
gt
=
=
'
integer
'
or
gt
=
=
'
real
'
)
then
3961
return
ps_error
(
'
typecheck
'
)
3962
end
3963
if
not
(
bt
=
=
'
integer
'
or
bt
=
=
'
real
'
)
then
3964
return
ps_error
(
'
typecheck
'
)
3965
end
3966
local
rv
,
gv
,
bv
=
r
[
4
]
,
g
[
4
]
,
b
[
4
]
3967
local
color
=
gsstate
.
color
3968
color
.
type
=
"
rgb
"
3969
color
.
rgb
=
{
3970
(
rv
<
0
and
0
)
or
(
rv
>
1
and
1
)
or
rv
,
3971
(
gv
<
0
and
0
)
or
(
gv
>
1
and
1
)
or
gv
,
3972
(
bv
<
0
and
0
)
or
(
bv
>
1
and
1
)
or
bv
,
3973
}
3974
return
true
3975
end
3976 3977
function
operators
.
currentrgbcolor
(
)
3978
local
color
=
gsstate
.
color
3979
local
t
=
color
.
type
3980
local
r
,
g
,
b
3981
if
t
=
=
"
gray
"
then
3982
r
,
g
,
b
=
gray_to_rgb
(
color
.
gray
)
3983
elseif
t
=
=
"
rgb
"
then
3984
local
col
=
color
.
rgb
3985
r
,
g
,
b
=
col
[
1
]
,
col
[
2
]
,
col
[
3
]
3986
elseif
t
=
=
"
cmyk
"
then
3987
r
,
g
,
b
=
cmyk_to_rgb
(
color
.
cmyk
)
3988
else
3989
local
col
=
color
.
hsb
3990
r
,
g
,
b
=
hsv_to_rgb
(
col
[
1
]
,
col
[
2
]
,
col
[
3
]
)
3991
end
3992
push_opstack
{
(
r
=
=
0
or
r
=
=
1
)
and
"
integer
"
or
"
real
"
,
'
unlimited
'
,
'
literal
'
,
r
}
3993
push_opstack
{
(
g
=
=
0
or
g
=
=
1
)
and
"
integer
"
or
"
real
"
,
'
unlimited
'
,
'
literal
'
,
g
}
3994
push_opstack
{
(
b
=
=
0
or
b
=
=
1
)
and
"
integer
"
or
"
real
"
,
'
unlimited
'
,
'
literal
'
,
b
}
3995
return
true
3996
end
3997 3998
function
operators
.
setcmykcolor
(
)
3999
local
k
=
pop_opstack
(
)
4000
local
y
=
pop_opstack
(
)
4001
local
m
=
pop_opstack
(
)
4002
local
c
=
pop_opstack
(
)
4003
if
not
c
then
4004
return
ps_error
(
'
stackunderflow
'
)
4005
end
4006
local
ct
,
mt
,
yt
,
kt
=
c
[
1
]
,
m
[
1
]
,
y
[
1
]
,
k
[
1
]
4007
if
not
(
ct
=
=
'
integer
'
or
ct
=
=
'
real
'
)
then
4008
return
ps_error
(
'
typecheck
'
)
4009
end
4010
if
not
(
mt
=
=
'
integer
'
or
mt
=
=
'
real
'
)
then
4011
return
ps_error
(
'
typecheck
'
)
4012
end
4013
if
not
(
yt
=
=
'
integer
'
or
yt
=
=
'
real
'
)
then
4014
return
ps_error
(
'
typecheck
'
)
4015
end
4016
if
not
(
kt
=
=
'
integer
'
or
kt
=
=
'
real
'
)
then
4017
return
ps_error
(
'
typecheck
'
)
4018
end
4019
local
cv
,
mv
,
yv
,
kv
=
c
[
4
]
,
m
[
4
]
,
y
[
4
]
,
k
[
4
]
4020
local
color
=
gsstate
.
color
4021
color
.
type
=
"
cmyk
"
4022
color
.
cmyk
=
{
4023
(
cv
<
0
and
0
)
or
(
cv
>
1
and
1
)
or
cv
,
4024
(
mv
<
0
and
0
)
or
(
mv
>
1
and
1
)
or
mv
,
4025
(
yv
<
0
and
0
)
or
(
yv
>
1
and
1
)
or
yv
,
4026
(
kv
<
0
and
0
)
or
(
kv
>
1
and
1
)
or
kv
,
4027
}
4028
return
true
4029
end
4030 4031
function
operators
.
currentcmykcolor
(
)
4032
local
color
=
gsstate
.
color
4033
local
t
=
color
.
type
4034
local
c
,
m
,
y
,
k
4035
if
t
=
=
"
gray
"
then
4036
c
,
m
,
y
,
k
=
gray_to_cmyk
(
color
.
gray
)
4037
elseif
t
=
=
"
rgb
"
then
4038
c
,
m
,
y
,
k
=
rgb_to_cmyk
(
color
.
rgb
)
4039
elseif
t
=
=
"
cmyk
"
then
4040
local
col
=
color
.
cmyk
4041
c
,
m
,
y
,
k
=
col
[
1
]
,
col
[
2
]
,
col
[
3
]
,
col
[
4
]
4042
else
4043
local
col
=
color
.
hsb
4044
c
,
m
,
y
,
k
=
hsv_to_cmyk
(
col
[
1
]
,
col
[
2
]
,
col
[
3
]
)
4045
end
4046
push_opstack
{
(
c
=
=
0
or
c
=
=
1
)
and
"
integer
"
or
"
real
"
,
'
unlimited
'
,
'
literal
'
,
c
}
4047
push_opstack
{
(
m
=
=
0
or
m
=
=
1
)
and
"
integer
"
or
"
real
"
,
'
unlimited
'
,
'
literal
'
,
m
}
4048
push_opstack
{
(
y
=
=
0
or
y
=
=
1
)
and
"
integer
"
or
"
real
"
,
'
unlimited
'
,
'
literal
'
,
y
}
4049
push_opstack
{
(
k
=
=
0
or
k
=
=
1
)
and
"
integer
"
or
"
real
"
,
'
unlimited
'
,
'
literal
'
,
k
}
4050
return
true
4051
end
4052 4053
end
4054 4055
function
operators
.
setscreen
(
)
4056
local
c
=
pop_opstack
(
)
4057
local
b
=
pop_opstack
(
)
4058
local
a
=
pop_opstack
(
)
4059
if
not
a
then
4060
return
ps_error
(
'
stackunderflow
'
)
4061
end
4062
local
ta
,
tb
,
tc
,
ac
=
a
[
1
]
,
b
[
1
]
,
c
[
1
]
,
c
[
3
]
4063
if
not
(
tc
=
=
'
array
'
and
ac
=
=
'
executable
'
)
then
4064
return
ps_error
(
'
typecheck
'
)
4065
end
4066
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
4067
return
ps_error
(
'
typecheck
'
)
4068
end
4069
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
4070
return
ps_error
(
'
typecheck
'
)
4071
end
4072
local
va
,
vb
,
vc
=
a
[
4
]
,
b
[
4
]
,
c
[
4
]
4073
if
vb
<
0
or
vb
>
360
then
4074
return
ps_error
(
'
rangecheck
'
)
4075
end
4076
if
va
<
0
then
4077
return
ps_error
(
'
rangecheck
'
)
4078
end
4079
gsstate
.
screen
=
{
va
,
vb
,
vc
}
4080
return
true
4081
end
4082 4083
function
operators
.
currentscreen
(
)
4084
local
w
4085
if
not
gsstate
.
screen
then
4086
local
popper
=
{
'
operator
'
,
'
unlimited
'
,
'
executable
'
,
operators
.
pop
,
'
pop
'
}
4087
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
1
}
4088
push_opstack
{
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
0
}
4089
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
executable
'
,
add_VM
{
popper
}
,
1
,
1
,
'
d
'
}
4090
else
4091
local
w1
=
gsstate
.
screen
[
1
]
4092
local
w2
=
gsstate
.
screen
[
2
]
4093
local
w3
=
gsstate
.
screen
[
3
]
4094
push_opstack
{
4095
(
abs
(
w
)
>
MAX_INT
or
floor
(
w1
)
~
=
w1
)
and
'
real
'
or
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
w1
4096
}
4097
push_opstack
{
4098
(
abs
(
w
)
>
MAX_INT
or
floor
(
w2
)
~
=
w2
)
and
'
real
'
or
'
integer
'
,
'
unlimited
'
,
'
literal
'
,
w2
4099
}
4100
local
thearray
=
get_VM
(
w3
)
4101
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
executable
'
,
w3
,
1
,
#
thearray
,
'
d
'
}
-- w3 or thearray ?
4102
end
4103
return
true
4104
end
4105 4106
function
operators
.
settransfer
(
)
4107
local
a
=
pop_opstack
(
)
4108
if
not
a
then
4109
return
ps_error
(
'
stackunderflow
'
)
4110
end
4111
if
not
(
a
[
1
]
=
=
'
array
'
and
a
[
3
]
=
=
'
executable
'
)
then
4112
return
ps_error
(
'
typecheck
'
)
4113
end
4114
local
va
=
a
[
4
]
4115
if
va
<
0
then
4116
return
ps_error
(
'
rangecheck
'
)
4117
end
4118
gsstate
.
transfer
=
va
4119
return
true
4120
end
4121 4122
function
operators
.
currenttransfer
(
)
4123
local
transfer
=
gsstate
.
transfer
4124
if
not
transfer
then
4125
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
executable
'
,
add_VM
{
}
,
0
,
0
,
'
d
'
}
4126
else
4127
local
thearray
=
get_VM
(
transfer
)
4128
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
executable
'
,
transfer
,
1
,
#
thearray
,
'
d
'
}
4129
end
4130
return
true
4131
end
4132 4133
-- Coordinate system and matrix operators
4134
--
4135
-- +matrix +initmatrix +identmatrix +defaultmatrix +currentmatrix +setmatrix +translate
4136
-- +scale +rotate +concat +concatmatrix +transform +dtransform +itransform +idtransform
4137
-- +invertmatrix
4138 4139
-- are these changed in place or not? if not then we can share
4140 4141
function
operators
.
matrix
(
)
4142
local
matrix
=
{
4143
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
1
}
,
4144
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
0
}
,
4145
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
0
}
,
4146
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
1
}
,
4147
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
0
}
,
4148
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
0
}
,
4149
}
4150
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
literal
'
,
add_VM
(
matrix
)
,
6
,
6
}
4151
return
true
4152
end
4153 4154
function
operators
.
initmatrix
(
)
4155
gsstate
.
matrix
=
{
1
,
0
,
0
,
1
,
0
,
0
}
4156
return
true
4157
end
4158 4159
function
operators
.
identmatrix
(
)
4160
local
a
=
pop_opstack
(
)
4161
if
not
a
then
return
4162
ps_error
(
'
stackunderflow
'
)
4163
end
4164
if
a
[
1
]
~
=
'
array
'
then
4165
return
ps_error
(
'
typecheck
'
)
4166
end
4167
if
a
[
6
]
<
6
then
4168
return
ps_error
(
'
rangecheck
'
)
4169
end
4170
local
m
=
VM
[
a
[
4
]
]
-- or can we replace the numbers
4171
m
[
1
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
1
}
4172
m
[
2
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
0
}
4173
m
[
3
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
0
}
4174
m
[
4
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
1
}
4175
m
[
5
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
0
}
4176
m
[
6
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
0
}
4177
a
[
5
]
=
6
4178
push_opstack
(
a
)
4179
return
true
4180
end
4181 4182
operators
.
defaultmatrix
=
operators
.
identmatrix
4183 4184
function
operators
.
currentmatrix
(
)
4185
local
a
=
pop_opstack
(
)
4186
if
not
a
then
4187
return
ps_error
(
'
stackunderflow
'
)
4188
end
4189
if
a
[
1
]
~
=
'
array
'
then
4190
return
ps_error
(
'
typecheck
'
)
4191
end
4192
if
a
[
6
]
<
6
then
4193
return
ps_error
(
'
rangecheck
'
)
4194
end
4195
local
thearray
=
get_VM
(
a
[
4
]
)
4196
local
matrix
=
gsstate
.
matrix
4197
for
i
=
1
,
6
do
4198
thearray
[
i
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
matrix
[
i
]
}
4199
end
4200
push_opstack
{
'
array
'
,
'
unlimited
'
,
'
literal
'
,
a
[
4
]
,
6
,
6
}
4201
return
true
4202
end
4203 4204
function
operators
.
setmatrix
(
)
4205
local
a
=
pop_opstack
(
)
4206
if
not
a
then
4207
return
ps_error
(
'
stackunderflow
'
)
4208
end
4209
if
a
[
1
]
~
=
'
array
'
then
4210
return
ps_error
(
'
typecheck
'
)
4211
end
4212
if
a
[
6
]
~
=
6
then
4213
return
ps_error
(
'
rangecheck
'
)
4214
end
4215
local
thearray
=
get_VM
(
a
[
4
]
)
4216
local
matrix
=
gsstate
.
matrix
4217
for
i
=
1
,
#
thearray
do
4218
local
a
=
thearray
[
i
]
4219
local
ta
,
tv
=
a
[
1
]
,
a
[
4
]
4220
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
4221
return
ps_error
(
'
typecheck
'
)
4222
end
4223
if
i
>
6
then
4224
return
ps_error
(
'
rangecheck
'
)
4225
end
4226
matrix
[
i
]
=
tv
4227
end
4228
return
true
4229
end
4230 4231
local
function
do_transform
(
matrix
,
a
,
b
)
4232
local
x
=
matrix
[
1
]
*
a
+
matrix
[
3
]
*
b
+
matrix
[
5
]
4233
local
y
=
matrix
[
2
]
*
a
+
matrix
[
4
]
*
b
+
matrix
[
6
]
4234
return
x
,
y
4235
end
4236 4237
local
function
do_itransform
(
matrix
,
a
,
b
)
4238
local
m1
=
matrix
[
1
]
4239
local
m4
=
matrix
[
4
]
4240
if
m1
=
=
0
or
m4
=
=
0
then
4241
return
nil
4242
end
4243
local
x
=
(
a
-
matrix
[
5
]
-
matrix
[
3
]
*
b
)
/
m1
4244
local
y
=
(
b
-
matrix
[
6
]
-
matrix
[
2
]
*
a
)
/
m4
4245
return
x
,
y
4246
end
4247 4248
local
function
do_concat
(
a
,
b
)
4249
local
a1
,
a2
,
a3
,
a4
,
a5
,
a6
=
a
[
1
]
,
a
[
2
]
,
a
[
3
]
,
a
[
4
]
,
a
[
5
]
,
a
[
6
]
4250
local
b1
,
b2
,
b3
,
b4
,
b5
,
b6
=
b
[
1
]
,
b
[
2
]
,
b
[
3
]
,
b
[
4
]
,
b
[
5
]
,
b
[
6
]
4251
local
c1
=
a1
*
b1
+
a2
*
b3
4252
local
c2
=
a1
*
b2
+
a2
*
b4
4253
local
c3
=
a1
*
b3
+
a3
*
b4
4254
local
c4
=
a3
*
b2
+
a4
*
b4
4255
local
c5
=
a5
*
b1
+
a6
*
b3
+
b5
4256
local
c6
=
a5
*
b2
+
a6
*
b4
+
b6
4257
-- this is because double calculation introduces a small error
4258
return
{
4259
abs
(
c1
)
<
1.0e-16
and
0
or
c1
,
4260
abs
(
c2
)
<
1.0e-16
and
0
or
c2
,
4261
abs
(
c3
)
<
1.0e-16
and
0
or
c3
,
4262
abs
(
c4
)
<
1.0e-16
and
0
or
c4
,
4263
abs
(
c5
)
<
1.0e-16
and
0
or
c5
,
4264
abs
(
c6
)
<
1.0e-16
and
0
or
c6
,
4265
}
4266
end
4267 4268
local
function
do_inverse
(
a
)
4269
local
a1
,
a2
,
a3
,
a4
,
a5
,
a6
=
a
[
1
]
,
a
[
2
]
,
a
[
3
]
,
a
[
4
]
,
a
[
5
]
,
a
[
6
]
4270
local
det
=
a1
*
a4
-
a3
*
a2
4271
if
det
=
=
0
then
4272
return
nil
4273
end
4274
local
c1
=
a4
/
det
4275
local
c3
=
-
a3
/
det
4276
local
c2
=
-
a2
/
det
4277
local
c4
=
a1
/
det
4278
local
c5
=
(
a3
*
a6
-
a5
*
a4
)
/
det
4279
local
c6
=
(
a5
*
a2
-
a1
*
a6
)
/
det
4280
return
{
4281
abs
(
c1
)
<
1.0e-16
and
0
or
c1
,
4282
abs
(
c2
)
<
1.0e-16
and
0
or
c2
,
4283
abs
(
c3
)
<
1.0e-16
and
0
or
c3
,
4284
abs
(
c4
)
<
1.0e-16
and
0
or
c4
,
4285
abs
(
c5
)
<
1.0e-16
and
0
or
c5
,
4286
abs
(
c6
)
<
1.0e-16
and
0
or
c6
,
4287
}
4288
end
4289 4290
function
operators
.
translate
(
)
4291
local
a
=
pop_opstack
(
)
4292
if
not
a
then
4293
return
ps_error
(
'
stackunderflow
'
)
4294
end
4295
if
a
[
1
]
=
=
'
array
'
then
4296
if
a
[
6
]
~
=
6
then
4297
return
ps_error
(
'
typecheck
'
)
4298
end
4299
local
tf
=
a
4300
local
a
=
pop_opstack
(
)
4301
local
b
=
pop_opstack
(
)
4302
if
not
b
then
4303
return
ps_error
(
'
stackunderflow
'
)
4304
end
4305
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
4306
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
4307
return
ps_error
(
'
typecheck
'
)
4308
end
4309
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
4310
return
ps_error
(
'
typecheck
'
)
4311
end
4312
local
m
=
VM
[
tf
[
4
]
]
4313
local
old
=
{
m
[
1
]
[
4
]
,
m
[
2
]
[
4
]
,
m
[
3
]
[
4
]
,
m
[
4
]
[
4
]
,
m
[
5
]
[
4
]
,
m
[
6
]
[
4
]
}
4314
local
c
=
do_concat
(
old
,
{
1
,
0
,
0
,
1
,
b
[
4
]
,
a
[
4
]
}
)
4315
for
i
=
1
,
6
do
4316
m
[
i
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
[
i
]
}
4317
end
4318
tf
[
5
]
=
6
4319
push_opstack
(
tf
)
4320
else
4321
local
b
=
pop_opstack
(
)
4322
local
ta
=
a
[
1
]
4323
local
tb
=
b
[
1
]
4324
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
4325
return
ps_error
(
'
typecheck
'
)
4326
end
4327
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
4328
return
ps_error
(
'
typecheck
'
)
4329
end
4330
gsstate
.
matrix
=
do_concat
(
gsstate
.
matrix
,
{
1
,
0
,
0
,
1
,
b
[
4
]
,
a
[
4
]
}
)
4331
end
4332
return
true
4333
end
4334 4335
function
operators
.
scale
(
)
4336
local
a
=
pop_opstack
(
)
4337
if
not
a
then
4338
return
ps_error
(
'
stackunderflow
'
)
4339
end
4340
local
ta
=
a
[
1
]
4341
if
ta
=
=
'
array
'
then
4342
local
tf
=
a
4343
if
a
[
6
]
~
=
6
then
4344
return
ps_error
(
'
typecheck
'
)
4345
end
4346
local
a
=
pop_opstack
(
)
4347
local
b
=
pop_opstack
(
)
4348
if
not
b
then
4349
return
ps_error
(
'
stackunderflow
'
)
4350
end
4351
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
4352
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
4353
return
ps_error
(
'
typecheck
'
)
4354
end
4355
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
4356
return
ps_error
(
'
typecheck
'
)
4357
end
4358
local
v
=
VM
[
tf
[
4
]
]
4359
local
c
=
do_concat
(
4360
{
v
[
1
]
[
4
]
,
v
[
2
]
[
4
]
,
v
[
3
]
[
4
]
,
v
[
4
]
[
4
]
,
v
[
5
]
[
4
]
,
v
[
6
]
[
4
]
}
,
4361
{
b
[
4
]
,
0
,
0
,
a
[
4
]
,
0
,
0
}
4362
)
4363
for
i
=
1
,
6
do
4364
v
[
i
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
[
i
]
}
4365
end
4366
tf
[
5
]
=
6
4367
push_opstack
(
tf
)
4368
else
4369
local
b
=
pop_opstack
(
)
4370
if
not
b
then
4371
return
ps_error
(
'
stackunderflow
'
)
4372
end
4373
local
ta
,
tb
=
a
[
1
]
,
b
[
1
]
4374
if
not
(
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
)
then
4375
return
ps_error
(
'
typecheck
'
)
4376
end
4377
if
not
(
tb
=
=
'
real
'
or
tb
=
=
'
integer
'
)
then
4378
return
ps_error
(
'
typecheck
'
)
4379
end
4380
gsstate
.
matrix
=
do_concat
(
gsstate
.
matrix
,
{
b
[
4
]
,
0
,
0
,
a
[
4
]
,
0
,
0
}
)
4381
end
4382
return
true
4383
end
4384 4385
function
operators
.
concat
(
)
4386
local
a
=
pop_opstack
(
)
4387
if
not
a
then
4388
return
ps_error
(
'
stackunderflow
'
)
4389
end
4390
if
a
[
1
]
~
=
"
array
"
then
4391
return
ps_error
(
'
typecheck
'
)
4392
end
4393
if
a
[
6
]
~
=
6
then
4394
return
ps_error
(
'
typecheck
'
)
4395
end
4396
local
thearray
=
get_VM
(
a
[
4
]
)
4397
local
l
=
{
}
4398
for
i
=
1
,
#
thearray
do
4399
local
v
=
thearray
[
i
]
4400
local
t
=
v
[
1
]
4401
if
not
(
t
=
=
'
real
'
or
t
=
=
'
integer
'
)
then
4402
return
ps_error
(
'
typecheck
'
)
4403
end
4404
l
[
i
]
=
v
[
4
]
4405
end
4406
gsstate
.
matrix
=
do_concat
(
gsstate
.
matrix
,
l
)
4407
return
true
4408
end
4409 4410
function
operators
.
concatmatrix
(
)
4411
local
tf
=
pop_opstack
(
)
4412
local
b
=
pop_opstack
(
)
4413
local
a
=
pop_opstack
(
)
4414
if
not
a
then
4415
return
ps_error
(
'
stackunderflow
'
)
4416
end
4417
if
tf
[
1
]
~
=
"
array
"
then
return
ps_error
(
'
typecheck
'
)
end
4418
if
b
[
1
]
~
=
"
array
"
then
return
ps_error
(
'
typecheck
'
)
end
4419
if
a
[
1
]
~
=
"
array
"
then
return
ps_error
(
'
typecheck
'
)
end
4420
if
tf
[
6
]
~
=
6
then
return
ps_error
(
'
typecheck
'
)
end
4421
if
b
[
6
]
~
=
6
then
return
ps_error
(
'
typecheck
'
)
end
4422
if
a
[
6
]
~
=
6
then
return
ps_error
(
'
typecheck
'
)
end
4423
local
al
=
{
}
4424
local
thearray
=
get_VM
(
a
[
4
]
)
4425
for
i
=
1
,
#
thearray
do
4426
local
v
=
thearray
[
i
]
4427
local
tv
=
v
[
1
]
4428
if
not
(
tv
=
=
'
real
'
or
tv
=
=
'
integer
'
)
then
4429
return
ps_error
(
'
typecheck
'
)
4430
end
4431
al
[
i
]
=
v
[
4
]
4432
end
4433
local
bl
=
{
}
4434
local
thearray
=
get_VM
(
b
[
4
]
)
4435
for
i
=
1
,
#
thearray
do
4436
local
v
=
thearray
[
i
]
4437
local
tv
=
v
[
1
]
4438
if
not
(
tv
=
=
'
real
'
or
tv
=
=
'
integer
'
)
then
4439
return
ps_error
(
'
typecheck
'
)
4440
end
4441
bl
[
i
]
=
v
[
4
]
4442
end
4443
local
c
=
do_concat
(
al
,
bl
)
4444
local
m
=
VM
[
tf
[
4
]
]
4445
for
i
=
1
,
6
do
4446
m
[
i
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
[
i
]
}
4447
end
4448
tf
[
5
]
=
6
4449
push_opstack
(
tf
)
4450
return
true
4451
end
4452 4453
function
operators
.
rotate
(
)
4454
local
a
=
pop_opstack
(
)
4455
if
not
a
then
4456
return
ps_error
(
'
stackunderflow
'
)
4457
end
4458
local
ta
=
a
[
1
]
4459
if
ta
=
=
'
array
'
then
4460
local
tf
4461
if
a
[
6
]
~
=
6
then
4462
return
ps_error
(
'
typecheck
'
)
4463
end
4464
tf
=
a
4465
a
=
pop_opstack
(
)
4466
if
not
a
then
4467
return
ps_error
(
'
stackunderflow
'
)
4468
end
4469
if
not
(
a
[
1
]
=
=
'
real
'
or
a
[
1
]
=
=
'
integer
'
)
then
4470
return
ps_error
(
'
typecheck
'
)
4471
end
4472
local
m
=
VM
[
tf
[
4
]
]
4473
local
old
=
{
m
[
1
]
[
4
]
,
m
[
2
]
[
4
]
,
m
[
3
]
[
4
]
,
m
[
4
]
[
4
]
,
m
[
5
]
[
4
]
,
m
[
6
]
[
4
]
}
4474
local
av
=
a
[
4
]
4475
local
c
=
do_concat
(
old
,
{
cos
(
rad
(
av
)
)
,
sin
(
rad
(
av
)
)
,
-
sin
(
rad
(
av
)
)
,
cos
(
rad
(
av
)
)
,
0
,
0
}
)
4476
for
i
=
1
,
6
do
4477
m
[
i
]
=
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
c
[
i
]
}
4478
end
4479
push_opstack
(
tf
)
4480
elseif
ta
=
=
'
real
'
or
ta
=
=
'
integer
'
then
4481
local
av
=
a
[
4
]
4482
gsstate
.
matrix
=
do_concat
(
gsstate
.
matrix
,
{
cos
(
rad
(
av
)
)
,
sin
(
rad
(
av
)
)
,
-
sin
(
rad
(
av
)
)
,
cos
(
rad
(
av
)
)
,
0
,
0
}
)
4483
else
4484
return
ps_error
(
'
typecheck
'
)
4485
end
4486
return
true
4487
end
4488 4489
function
operators
.
transform
(
)
4490
local
a
=
pop_opstack
(
)
4491
local
b
=
pop_opstack
(
)
4492
if
not
b
then
4493
ps_error
(
'
stackunderflow
'
)
4494
end
4495
local
tf
4496
if
a
[
1
]
=
=
'
array
'
then
4497
if
a
[
6
]
~
=
6
then
4498
return
ps_error
(
'
typecheck
'
)
4499
end
4500
local
thearray
=
get_VM
(
a
[
4
]
)
4501
tf
=
{
}
4502
for
i
=
1
,
#
thearray
do
4503
local
v
=
thearray
[
i
]
4504
local
v1
=
v
[
1
]
4505
if
not
(
v1
=
=
'
real
'
or
v1
=
=
'
integer
'
)
then
4506
return
ps_error
(
'
typecheck
'
)
4507
end
4508
tf
[
i
]
=
v
[
4
]
4509
end
4510
a
=
pop_opstack
(
)
4511
if
not
a
then
4512
return
ps_error
(
'
stackunderflow
'
)
4513
end
4514
else
4515
tf
=
gsstate
.
matrix
4516
end
4517
local
a1
=
a
[
1
]
4518
local
b1
=
b
[
1
]
4519
if
not
(
a1
=
=
'
real
'
or
a1
=
=
'
integer
'
)
then
4520
return
ps_error
(
'
typecheck
'
)
4521
end
4522
if
not
(
b1
=
=
'
real
'
or
b1
=
=
'
integer
'
)
then
4523
return
ps_error
(
'
typecheck
'
)
4524
end
4525
local
x
,
y
=
do_transform
(
tf
,
b
[
4
]
,
a
[
4
]
)
;
4526
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
x
}
4527
push_opstack
{
'
real
'
,
'
unlimited
'
,
'
literal
'
,
y
}
4528
return
true
4529
end
4530 4531
local
function
commontransform
(
)
4532
local
a
=
pop_opstack
(
)
4533
if
not
a
then
4534
return
ps_error
(
'
stackunderflow
'
)
4535
end
4536
local
tf
4537
if
a
[