Source Browser ?

1if 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
69local type, unpack, tonumber, tostring, next = type, unpack, tonumber, tostring, next
70
71local format     = string.format
72local gmatch     = string.gmatch
73local match      = string.match
74local sub        = string.sub
75local char       = string.char
76local byte       = string.byte
77
78local insert     = table.insert
79local remove     = table.remove
80local concat     = table.concat
81local reverse    = table.reverse
82
83local abs        = math.abs
84local ceil       = math.ceil
85local floor      = math.floor
86local sin        = math.sin
87local cos        = math.cos
88local rad        = math.rad
89local sqrt       = math.sqrt
90local atan2      = math.atan2
91local tan        = math.tan
92local deg        = math.deg
93local pow        = math.pow
94local log        = math.log
95local log10      = math.log10
96local random     = math.random
97local setranseed = math.randomseed
98
99local bitand     = bit32.band     -- when lmtx: Lua 5.4
100local bitor      = bit32.bor
101local bitxor     = bit32.bxor
102local bitrshift  = bit32.rshift
103local bitlshift  = bit32.lshift
104
105local lpegmatch  = lpeg.match
106local 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
108local formatters        = string.formatters
109local 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
116escrito = { }
117
118----- escrito      = escrito
119local initializers = { }
120local devices      = { }
121local specials
122
123local DEBUG     = false -- these will become trackers if needed
124local INITDEBUG = false -- these will become trackers if needed
125local MAX_INT   = 0x7FFFFFFF -- we could have slightly larger ints because lua internally uses doubles
126
127initializers[#initializers+1] = function(reset)
128    if reset then
129        specials = nil
130    else
131        specials = { }
132    end
133end
134
135local devicename
136local 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
148local VM -- todo: just a hash
149
150initializers[#initializers+1] = function()
151    VM = { }
152end
153
154local directvm = false -- true (but then we ned to patch more VM[..]
155
156local add_VM, get_VM
157
158if 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
167else
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
179end
180
181-- Execution stack
182
183local execstack
184local execstackptr
185local do_exec
186local next_object
187local stopped
188
189initializers[#initializers+1] = function()
190    execstack    = { }
191    execstackptr = 0
192    stopped      = false
193end
194
195local 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
203end
204
205local function push_execstack(v)
206    execstackptr = execstackptr + 1
207    execstack[execstackptr] = v
208end
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
263local opstack
264local opstackptr
265
266local b_true  = { 'boolean', 'unlimited', 'literal', true  }
267local b_false = { 'boolean', 'unlimited', 'literal', false }
268
269initializers[#initializers+1] = function()
270    opstack    = { }
271    opstackptr = 0
272end
273
274local 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
282end
283
284local function push_opstack(v)
285    opstackptr = opstackptr + 1
286    opstack[opstackptr] = v
287end
288
289local function check_opstack(n)
290    return opstackptr >= n
291end
292
293local function get_opstack()
294    if opstackptr > 0 then
295        return opstack[opstackptr]
296    else
297        return nil -- stackunderflow
298    end
299end
300
301-- In case of error, the interpreter has to restore the opstack
302
303local 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
310end
311
312local function set_opstack(new)
313   opstackptr = #new
314   opstack    = new
315end
316
317-- Dict stack
318
319local dictstack
320local dictstackptr
321
322initializers[#initializers+1] = function()
323    dictstack    = { }
324    dictstackptr = 0
325end
326
327-- this finds a name in the current dictionary stack
328
329local 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
343end
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
352local gsstate
353
354initializers[#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
382end
383
384local 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    }
415end
416
417-- gsstack entries are of the form
418-- [1] "[save|gsave]"
419-- [2] {gsstate}
420
421local gsstack
422local gsstackptr
423
424initializers[#initializers+1] = function(reset)
425    if reset then
426        gsstack    = nil
427        gsstackptr = nil
428    else
429        gsstack    = { }
430        gsstackptr = 0
431    end
432end
433
434local function push_gsstack(v)
435    gsstackptr = gsstackptr + 1
436    gsstack[gsstackptr] = v
437end
438
439local function pop_gsstack()
440    if gsstackptr > 0 then
441        local v = gsstack[gsstackptr]
442        gsstackptr = gsstackptr - 1
443        return v
444   end
445end
446
447-- Currentpage
448
449local currentpage
450
451initializers[#initializers+1] = function(reset)
452    if reset then
453        currentpage = nil
454    else
455        currentpage = { }
456    end
457end
458
459-- Errordict
460
461-- The standard errordict entry. The rest of these dictionaries will be filled
462-- in the new() function.
463
464local errordict
465local dicterror
466
467-- find an error handler
468
469local function lookup_error(name)
470    local dict = get_VM(errordict).dict
471    return dict and dict[name]
472end
473
474-- error handling and reporting
475
476local report = logs.reporter("escrito")
477
478local function ps_error(a)
479    -- can have print hook
480    return false, a
481end
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
495local operators = { }
496
497-- Operand stack manipulation operators
498--
499-- +pop +exch +dup +copy +index +roll +clear +count +mark +cleartomark +counttomark
500
501function operators.pop()
502    local a = pop_opstack()
503    if not a then
504        return ps_error('stackunderflow')
505    end
506    return true
507end
508
509function 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
516end
517
518function 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
526end
527
528function 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
633end
634
635function 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
653end
654
655function 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
704end
705
706function operators.clear()
707    opstack    = { } -- or just keep it
708    opstackptr = 0
709    return true
710end
711
712function operators.count()
713    push_opstack { 'integer', 'unlimited', 'literal', opstackptr }
714    return true
715end
716
717function operators.mark()
718    push_opstack { 'mark', 'unlimited', 'literal', null }
719end
720
721operators.beginarray = operators.mark
722
723function 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')
734end
735
736function 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')
746end
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
753function 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
772end
773
774function 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
793end
794
795function 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
814end
815
816function 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
835end
836
837function 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
868end
869
870function 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
889end
890
891function 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
907end
908
909function 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
924end
925
926function 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
938end
939
940function 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
952end
953
954function 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
966end
967
968function 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
981end
982
983function 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
999end
1000
1001function 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
1024end
1025
1026function 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
1042end
1043
1044function 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
1060end
1061
1062function 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
1082end
1083
1084function 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
1100end
1101
1102function 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
1118end
1119
1120escrito.randomseed = os.time()
1121
1122-- this interval is one off, but that'll do
1123
1124function operators.rand()
1125    local c = random(MAX_INT) - 1
1126    push_opstack { 'integer', 'unlimited', 'literal', c }
1127    return true
1128end
1129
1130function 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
1142end
1143
1144function operators.rrand()
1145    push_opstack { 'integer', 'unlimited', 'literal', escrito.randomseed }
1146    return true
1147end
1148
1149-- Array operators
1150--
1151-- +array ^[ +] +length +get +put +getinterval +putinterval +aload +astore ^copy +forall
1152
1153function 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'}
1171end
1172
1173function 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' }
1193end
1194
1195function 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
1216end
1217
1218function 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
1273end
1274
1275function 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
1346end
1347
1348function 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
1387end
1388
1389function 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
1436end
1437
1438function 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
1456end
1457
1458function 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
1482end
1483
1484function 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
1583end
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
1590function 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    }
1616end
1617
1618function 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 }
1632end
1633
1634function 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]
1644end
1645
1646operators["end"] = function()
1647    if dictstackptr < 3 then
1648        return ps_error('dictstackunderflow')
1649    end
1650    dictstack[dictstackptr] = nil
1651    dictstackptr = dictstackptr - 1
1652end
1653
1654function 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
1675end
1676
1677-- unclear: the book says this operator can return typecheck
1678
1679function 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)
1693end
1694
1695function 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
1728end
1729
1730function 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
1750end
1751
1752function 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
1772end
1773
1774function operators.currentdict()
1775    push_opstack { 'dict', 'unlimited', 'literal', dictstack[dictstackptr] }
1776    return true
1777end
1778
1779function operators.countdictstack()
1780    push_opstack { 'integer', 'unlimited', 'literal', dictstackptr }
1781    return true
1782end
1783
1784function 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
1807end
1808
1809-- String operators
1810--
1811-- +string ^length ^get ^put ^getinterval ^putinterval ^copy ^forall +anchorsearch +search
1812-- +token
1813
1814function 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 }
1827end
1828
1829function 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
1865end
1866
1867function 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
1914end
1915
1916function 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
1981end
1982
1983-- Relational, boolean and bitwise operators
1984--
1985-- +eq +ne +ge +gt +le +lt +and +not +or +xor ^true ^false +bitshift
1986
1987local 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
2013end
2014
2015function 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
2023end
2024
2025function 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
2033end
2034
2035local 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
2059end
2060
2061function 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
2069end
2070
2071function 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
2079end
2080
2081function 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
2089end
2090
2091function 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
2099end
2100
2101local 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
2123end
2124
2125operators["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
2136end
2137
2138operators["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
2149end
2150
2151function 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
2162end
2163
2164operators["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
2182end
2183
2184function 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
2204end
2205
2206-- Control operators
2207--
2208-- +exec +if +ifelse +for +repeat +loop +exit +stop +stopped +countexecstack +execstack
2209-- +quit +start
2210
2211function 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
2222end
2223
2224operators["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
2242end
2243
2244function 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
2270end
2271
2272operators["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
2327end
2328
2329operators["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
2370end
2371
2372function 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
2402end
2403
2404function 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
2420end
2421
2422function 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
2435end
2436
2437function 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
2451end
2452
2453function operators.countexecstack()
2454    push_opstack { 'integer', 'unlimited', 'literal', execstackptr }
2455    return true
2456end
2457
2458function 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
2484end
2485
2486-- clearing the execstack does the trick,
2487-- todo: leave open files to be handled by the lua interpreter, for now
2488
2489function 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
2495end
2496
2497-- does nothing, for now
2498
2499function operators.start()
2500    return true
2501end
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
2508function 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
2515end
2516
2517function 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
2524end
2525
2526function 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
2533end
2534
2535function 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
2542end
2543
2544function 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
2560end
2561
2562function 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
2584end
2585
2586function 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
2610end
2611
2612function 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
2628end
2629
2630function 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
2647end
2648
2649function 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
2686end
2687
2688function 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
2703end
2704
2705function 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
2737end
2738
2739do
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
2796end
2797
2798function 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
2838end
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
2846function 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
2902end
2903
2904function 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
2936end
2937
2938function 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
2955end
2956
2957function 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
2974end
2975
2976function 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
2997end
2998
2999do
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
3128end
3129
3130function operators.flush()
3131    io.flush()
3132    return true
3133end
3134
3135function 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
3149end
3150
3151-- this does not really do anything useful
3152
3153function 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
3162end
3163
3164function 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
3178end
3179
3180function 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
3196end
3197
3198function 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
3209end
3210
3211function 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
3242end
3243
3244function 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
3256end
3257
3258function 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]))
3267end
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
3275do
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
3353end
3354
3355local 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
3363end
3364
3365function operators.pstack()
3366    return commonstack("\n")
3367end
3368
3369function operators.stack()
3370    return commonstack(" ")
3371end
3372
3373-- this does not really do anything useful
3374
3375function 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
3384end
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
3393local savelevel = 0
3394
3395initializers[#initializers+1] = function(reset)
3396    savelevel = 0
3397end
3398
3399function 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) }
3429end
3430
3431function 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) }
3436end
3437
3438do
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
3496end
3497
3498function 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
3504end
3505
3506-- Miscellaneous operators
3507--
3508-- +bind +null +usertime +version
3509
3510-- the reference manual says bind only ERRORS on typecheck
3511
3512local 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)
3541end
3542
3543operators.bind = bind
3544
3545function operators.null()
3546    push_opstack { 'null', 'unlimited', 'literal' }
3547    return true
3548end
3549
3550function operators.usertime()
3551    push_opstack { 'integer', 'unlimited', 'literal', floor(os.clock() * 1000) }
3552    return true
3553end
3554
3555function operators.version()
3556    push_opstack { 'string', 'unlimited', 'literal', add_VM('23.0') }
3557    return true
3558end
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
3567function operators.gsave()
3568    push_gsstack { 'gsave', copy_gsstate() }
3569    currentpage[#currentpage+1] = {
3570        type      = 'gsave',
3571    }
3572    return true
3573end
3574
3575function 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
3587end
3588
3589function 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
3600end
3601
3602function 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
3618end
3619
3620function 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
3631end
3632
3633function 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
3642end
3643
3644function 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
3658end
3659
3660function operators.currentlinecap()
3661    push_opstack { 'integer', 'unlimited', 'literal', gsstate.linecap }
3662    return true
3663end
3664
3665function 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
3679end
3680
3681function operators.currentlinejoin()
3682   push_opstack { 'integer', 'unlimited', 'literal', gsstate.linejoin }
3683   return true
3684end
3685
3686function 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
3701end
3702
3703function 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
3712end
3713
3714function 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
3748end
3749
3750function 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
3762end
3763
3764function 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
3775end
3776
3777function 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
3783end
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
3790do
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
4053end
4054
4055function 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
4081end
4082
4083function 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
4104end
4105
4106function 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
4120end
4121
4122function 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
4131end
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
4141function 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
4152end
4153
4154function operators.initmatrix()
4155    gsstate.matrix = { 1, 0, 0, 1, 0, 0 }
4156    return true
4157end
4158
4159function 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
4180end
4181
4182operators.defaultmatrix = operators.identmatrix
4183
4184function 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
4202end
4203
4204function 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
4229end
4230
4231local 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
4235end
4236
4237local 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
4246end
4247
4248local 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    }
4266end
4267
4268local 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    }
4288end
4289
4290function 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
4333end
4334
4335function 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