path: root/toolbin/scan_ps_dicts.ps

%!

% -dSCANDEBUG to enable extra noise ("skipping" messages)

(rwx = Read/Write/eXecutable, - = no, . = not applicable to this type\n) print
(systemdict length is ) print systemdict length 256 string cvs print (\n) print
(Name                             type                             RWX\n) print
(---------------------------------------------------------------------\n) print

20 dict begin	% so our local stuff doesn't end up in the list

/concatenate % (string1) (string2) concatenate string3 % array1 array2 concatenate array3
{ %def
    dup type 2 index type 2 copy ne { %if
        pop pop
        errordict begin (concatenate) typecheck end }{ %else
        /stringtype ne exch /arraytype ne and {
            errordict begin (concatenate) typecheck end
        } if } ifelse
    dup length 2 index length add 1 index type /arraytype eq { array }{ string } ifelse
    % stack: arg1 arg2 new
    dup 0 4 index putinterval
    % stack: arg1 arg2 new
    dup 4 -1 roll length 4 -1 roll putinterval % stack: new
} bind def

/pstring {
  dup print
  length 16 exch sub
  0 1 3 -1 roll {pop ( ) print} for
} def

/visited systemdict length 3 mul dict def
/operator_list systemdict length 3 mul dict def

/operator_name {	% convert operator to a name
  /S 256 string def
  /F S /NullEncode filter def
  F exch write==only
  F closefile
  S (\000) search
  { exch pop exch pop } { S } ifelse
  % trim trailing nulls from the string.
  cvn
} def

/nest_level -1 def
/indent {
  (                             ) 0 nest_level 2 mul getinterval print
} def

/rwx {
  dup type
  dup /arraytype eq exch
  dup /packedarraytype eq exch
  dup /dicttype eq exch
  dup /filetype eq exch
  /stringtype eq
  or
  or
  or
  or {
    dup rcheck {(r) print}{(-) print} ifelse
    dup wcheck {(w) print}{(-) print} ifelse
  }{
    (..) print
  } ifelse
  dup xcheck {(x ) print}{(- ) print} ifelse
} def

/lsitem {
  indent
  /item_name 2 index  def
  dup rwx
  type 16 string cvs pstring
  item_name
  = flush
} def

/add_op_definition {
   /SCANDEBUG where { pop (add op def: ) print 1 index =only ( ) print dup = } if
   operator_list 2 index known not {
     operator_list 2 index 2 dict put
   } if
   operator_list 2 index get exch /def
   put
   pop
} def

/add_op_reference {
   /SCANDEBUG where { pop (add op ref ) print 1 index =only ( ) print dup = } if
   operator_list 2 index known not {
     operator_list 2 index 2 dict put
   } if
   operator_list 2 index get exch /ref
   put
   pop
} def

/show_dictionary {
  {
    1 index whitelist exch
    known not {
    5 dict begin
    indent
    lsitem
    dup type /operatortype eq {
      1 index 3 index add_op_definition
    } if
    dup type /dicttype eq {
      check_dictionary
    } {
      dup type /arraytype eq 1 index type /packedarraytype eq or {
        1 index 3 index add_op_definition
        dup rcheck {
          exch pop check_array
        } {
          pop pop
        } ifelse
      } {
        pop pop
      } ifelse
    } ifelse
    end
    } {
      pop
      /SCANDEBUG where { pop (skipping ') print dup =only (') = flush } if
      whitelist exch true put
    }
    ifelse
  } forall
} def

/check_array {
  /nest_level nest_level 1 add store
  /i 0 def
  {
    dup type /operatortype eq {
      dup operator_name
      /SCANDEBUG where { pop dup /--.forceput-- eq { (.forceput in ) print item_name = } if } if
      item_name add_op_reference
    } if
    dup type /arrayttype eq 1 index type /packedarraytype eq or {
      dup
      dup wcheck {
        indent (writable array, element ) print i =only (: )  print dup ==
      } if
      dup rcheck {
        check_array
      } {
        pop
      } ifelse
    } if
    dup type /dicttype eq {
      dup wcheck {
        indent (writable dict, element: ) print i =only (: ) print dup { exch ==only (	) print == exit } forall
      } if
      indent ( dict, element: ) print i =
      (unknown) 1 index dup systemdict ne {
        check_dictionary
     } {
       pop pop
     } ifelse
    } if
    pop
    /i i 1 add def
  } forall
  /nest_level nest_level 1 sub store
} def

/check_dictionary {
  /nest_level nest_level 1 add store
  5 dict begin
  visited 2 index known {
    pop pop
  } {
    visited 2 index true put
    dup rcheck {
      indent (-------------------- Dumping dict: ) print 1 index 256 string cvs print ( length: ) print dup length =
      show_dictionary
      indent (==================== Done with dict: ) print 256 string cvs =
    } {
      indent (-------------------- Cannot read dict: ) print 1 index 256 string cvs =
      pop pop
    } ifelse
  } ifelse
  end
  /nest_level nest_level 1 sub store
} def

/STANDARD_OP_LIST
[
(AdobeGlyphList)
(ReverseAdobeGlyphList)
($error)
([)
(])
(<<)
(=)
(==)
(>>)
(abs)
(add)
(aload)
(anchorsearch)
(and)
(arc)
(arcn)
(arct)
(arcto)
(array)
(ashow)
(astore)
(atan)
(awidthshow)
(begin)
(bind)
(bitshift)
(bytesavailable)
(ceiling)
(charpath)
(clear)
(cleardictstack)
(cleartomark)
(clip)
(clippath)
(cliprestore)
(clipsave)
(closefile)
(closepath)
(colorimage)
(composefont)
(concat)
(concatmatrix)
(copy)
(copypage)
(cos)
(count)
(countdictstack)
(countexecstack)
(counttomark)
(cshow)
(currentblackgeneration)
(currentcacheparams)
(currentcmykcolor)
(currentcolor)
(currentcolorrendering)
(currentcolorscreen)
(currentcolorspace)
(currentcolortransfer)
(currentdash)
(currentdevparams)
(currentdict)
(currentfile)
(currentflat)
(currentglobal)
(currentgray)
(currentgstate)
(currenthalftone)
(currenthsbcolor)
(currentlinecap)
(currentlinejoin)
(currentlinewidth)
(currentmatrix)
(currentmiterlimit)
(currentobjectformat)
(currentoverprint)
(currentpacking)
(currentpagedevice)
(currentpoint)
(currentrgbcolor)
(currentscreen)
(currentsmoothness)
(currentstrokeadjust)
(currentsystemparams)
(currenttransfer)
(currentundercolorremoval)
(currentuserparams)
(curveto)
(cvi)
(cvlit)
(cvn)
(cvr)
(cvrs)
(cvs)
(cvx)
(def)
(defaultmatrix)
(definefont)
(defineresource)
(defineuserobject)
(deletefile)
(dict)
(dictstack)
(div)
(dtransform)
(dup)
(echo)
(end)
(eoclip)
(eofill)
(eq)
(erasepage)
(errordict)
(exch)
(exec)
(execform)
(execstack)
(execuserobject)
(executeonly)
(executive)
(exit)
(exp)
(false)
(file)
(filenameforall)
(fileposition)
(fill)
(filter)
(findcolorrendering)
(findencoding)
(findfont)
(findresource)
(flattenpath)
(floor)
(flush)
(flushfile)
(FontDirectory)
(for)
(forall)
(gcheck)
(ge)
(get)
(getinterval)
(globaldict)
(GlobalFontDirectory)
(glyphshow)
(grestore)
(grestoreall)
(gsave)
(gstate)
(gt)
(identmatrix)
(idiv)
(idtransform)
(if)
(ifelse)
(image)
(imagemask)
(index)
(ineofill)
(infill)
(initclip)
(initgraphics)
(initmatrix)
(instroke)
(inueofill)
(inufill)
(inustroke)
(invertmatrix)
(ISOLatin1Encoding)
(itransform)
(known)
(kshow)
(languagelevel)
(le)
(length)
(lineto)
(ln)
(load)
(log)
(loop)
(lt)
(makefont)
(makepattern)
(mark)
(matrix)
(maxlength)
(mod)
(moveto)
(mul)
(ne)
(neg)
(newpath)
(noaccess)
(not)
(null)
(nulldevice)
(or)
(packedarray)
(pathbbox)
(pathforall)
(pop)
(print)
(printobject)
(product)
(prompt)
(pstack)
(put)
(putinterval)
(quit)
(rand)
(rcheck)
(rcurveto)
(read)
(readhexstring)
(readline)
(readonly)
(readstring)
(realtime)
(rectclip)
(rectfill)
(rectstroke)
(renamefile)
(repeat)
(resetfile)
(resourceforall)
(resourcestatus)
(restore)
(reversepath)
(revision)
(rlineto)
(rmoveto)
(roll)
(rotate)
(round)
(rrand)
(run)
(save)
(scale)
(scalefont)
(search)
(selectfont)
(serialnumber)
(setbbox)
(setblackgeneration)
(setcachedevice)
(setcachedevice2)
(setcachelimit)
(setcacheparams)
(setcharwidth)
(setcmykcolor)
(setcolor)
(setcolorrendering)
(setcolorscreen)
(setcolorspace)
(setcolortransfer)
(setdash)
(setdevparams)
(setfileposition)
(setflat)
(setfont)
(setglobal)
(setgray)
(setgstate)
(sethalftone)
(sethsbcolor)
(setlinecap)
(setlinejoin)
(setlinewidth)
(setmatrix)
(setmiterlimit)
(setobjectformat)
(setoverprint)
(setpacking)
(setpagedevice)
(setpattern)
(setrgbcolor)
(setscreen)
(setsmoothness)
(setstrokeadjust)
(setsystemparams)
(settransfer)
(setucacheparams)
(setundercolorremoval)
(setuserparams)
(setvmthreshold)
(shfill)
(show)
(showpage)
(sin)
(sqrt)
(srand)
(stack)
(StandardEncoding)
(start)
(startjob)
(status)
(stop)
(stopped)
(store)
(string)
(stringwidth)
(stroke)
(strokepath)
(sub)
(systemdict)
(token)
(transform)
(translate)
(true)
(truncate)
(type)
(uappend)
(ucache)
(ucachestatus)
(ueofill)
(ufill)
(undef)
(undefinefont)
(undefineresource)
(undefineuserobject)
(upath)
(userdict)
%(UserObjects) % Not an operator, it's just a name that will only be defined in after 'defineuserobject'
(usertime)
(ustroke)
(ustrokepath)
(version)
(vmreclaim)
(vmstatus)
(wcheck)
(where)
(widthshow)
(write)
(writehexstring)
(writeobject)
(writestring)
(xcheck)
(xor)
(xshow)
(xyshow)
(yshow)
(%Type1BuildChar)
(%Type1BuildGlyph)
(.begintransparencygroup)
(.begintransparencymaskgroup)
(.bind)
(.bindnow)
(.currentoverprintmode)
(.dicttomark)
(.endtransparencygroup)
(.fileposition)
(.knownget)
(.locksafe)
(.setblendmode)
(.setdebug)
(.setopacityalpha)
(.setoverprintmode)
(.setsafe)
(.setshapealpha)
(.settextknockout)
(.tempfile)
(arccos)
(arcsin)
(copydevice)
(copyscanlines)
(currentdevice)
(finddevice)
(findlibfile)
(findprotodevice)
(getdeviceprops)
(getenv)
(makeimagedevice)
(max)
(min)
(.genordered)
(.setpdfwrite)
(putdeviceprops)
(setdevice)
(.password)
(.timeouts)
(11x17)
(11x17tray)
(a0)
(a1)
(a10)
(a2)
(a3)
(a3tray)
(a4)
(a4small)
(a4tray)
(a5)
(a5tray)
(a6)
(a6tray)
(a7)
(a8)
(a9)
(allowjobreset)
(ANSI_A)
(ANSI_B)
(ANSI_C)
(ANSI_D)
(ANSI_E)
(ANSI_F)
(appletalktype)
(archA)
(archB)
(archC)
(archD)
(archE)
(b0)
(b1)
(b2)
(b3)
(b4)
(b4tray)
(b5)
(b5tray)
(b6)
(c0)
(c1)
(c2)
(c3)
(c4)
(c5)
(c6)
(checkpassword)
(defaultpaperfamily)
(defaultpapertray)
(defaulttimeouts)
(defaulttrayswitch)
(devforall)
(devformat)
(devstatus)
(diskonline)
(diskstatus)
(dosysstart)
(eescratch)
(execjob)
(exitserver)
(flsa)
(flsatray)
(flse)
(flsetray)
(hagaki)
(halfletter)
(halflettertray)
(hardwareiomode)
(idlefonts)
(isob0)
(isob1)
(isob2)
(isob3)
(isob4)
(isob5)
(isob6)
(jisb0)
(jisb1)
(jisb2)
(jisb3)
(jisb4)
(jisb5)
(jisb6)
(jobname)
(ledger)
(ledgertray)
(legal)
(legaltray)
(letter)
(lettersmall)
(lettertray)
(manualfeed)
(manualfeedtimeout)
(margins)
(note)
(pa4)
(pagecount)
(pagemargin)
(pageparams)
(pagestackorder)
(pagetype)
(paperfamily)
(papertray)
(prefeed)
(printererror)
(printername)
(processcolors)
(product)
(ramsize)
(revision)
(sccbatch)
(sccinteractive)
(setallowjobreset)
(setdefaultpaperfamily)
(setdefaultpapertray)
(setdefaulttimeouts)
(setdefaulttrayswitch)
(setdostartpage)
(setdosysstart)
(setduplexmode)
(seteescratch)
(sethardwareiomode)
(setidlefonts)
(setjobtimeout)
(setmargins)
(setpage)
(setpagemargin)
(setpageparams)
(setpagetype)
(setpapertray)
(setpassword)
(setprintername)
(setrealdevice)
(setresolution)
(setsccbatch)
(setsccinteractive)
(setsoftwareiomode)
(settumble)
(softwareiomode)
(tabloid)
(trayswitch)
(waittimeout)

%% Manually added
%% These are official from some tech note or something
(customcolorimage)
(findcmykcustomcolor)
(findrgbcustomcolor)
(separationimage)
(setcmykoverprint)
(setcustomcolor)
(setseparationgray)

%% Appear to be official but didn't make it into whitelist for some reason
(cachestatus)
(currentfont)
(currentshared)
(eexec)
(scheck)
(setshared)

] def

% Standard Functions (no -- form)
/STANDARD_FUNC_LIST [
] def

% Extensions that are Functions (no -- form)
/EXTENSIONS_FUNC_LIST [
(.shellarguments)
(===)
(===only)
(==only)
(=only)
(write=)
(write==)
(write===)
(write===only)
(write==only)
(write=only)

(concatstrings)
(copyarray)
(devicenames)
(loadallfonts)
(runlibfile)
(selectdevice)

% Internal, undef in SAFER
(.mementolistnewblocks)
(.sort)
] def

% Extensions that are Operators
/EXTENSIONS_OPER_LIST [
] def

% make a dictionary out of the lists of operators
% size is arbitrary, it will auto-expand
/whitelist 2000 dict def
/operlist_to_whitelist {
    dup
    {whitelist exch cvn //false put} forall
    {(--) exch concatenate (--) concatenate cvn whitelist exch //false put} forall
} bind def
/funclist_to_whitelist {
    {whitelist exch cvn //false put} forall
} bind def

STANDARD_OP_LIST operlist_to_whitelist
STANDARD_FUNC_LIST funclist_to_whitelist
EXTENSIONS_FUNC_LIST funclist_to_whitelist
EXTENSIONS_OPER_LIST operlist_to_whitelist

/systemdict systemdict check_dictionary

(######################################################################################) =

[ operator_list { pop } forall ]
/.sort where { pop { 100 string cvs exch 100 string cvs gt } .sort } if
{
  whitelist 1 index 100 string cvs cvn known not {
    dup =only (  ) print operator_list exch get ===
  } {
    /SCANDEBUG where { pop
      (skipping ') print dup =only (') = flush
    } if
    whitelist exch true put
  }
  ifelse
} forall

(######################################################################################) =
(\nChecking internal dictionaries returned by operators\n) =
/currentcolorrendering currentcolorrendering check_dictionary
/currenthalftone currenthalftone check_dictionary
/currentpagedevice currentpagedevice check_dictionary
/currentsystemparams currentsystemparams check_dictionary
%%%/currenttrapparams currenttrapparams check_dictionary
/currentuserparams currentuserparams check_dictionary

(*)
{ (currentdevparams/) 1 index concatstrings cvn exch currentdevparams check_dictionary }
100 string
/IODevice
resourceforall

(######################################################################################) =
(\nusage from operator_list capture\n) =
operator_list {
  whitelist 2 index 100 string cvs cvn known not {
    exch =only (	defined in: ) print dup { /def eq { =only (, ) print } { pop } ifelse } forall
    () =
    (	referenced by: ) print  { /ref eq { =only (, ) print } { pop } ifelse } forall
    () =
  } {
    pop
    /SCANDEBUG where { pop (skipping ') print dup =only (') = flush } if
    whitelist exch true put
  }
  ifelse
} forall

(######################################################################################) =
(\nwhitelist entries not seen in scan:\n) =
% pre-scan whitelist to mark anything that was marked in -- form
% (this will error if there is something on the whitelist that starts with - and isn't at least
% 5 characters long, so don't do that...  why would you?)
whitelist {
    {
        % see if it starts with a '-'
        256 string cvs dup 0 1 getinterval (-) eq {
            % mark the corresponding non- --oper-- form as true
            2 1 index length 4 sub getinterval cvn whitelist exch //true put
        }{
            pop
        } ifelse
    } {
        pop
    } ifelse
} forall

% now print the stuff that wasn't found, ignoring all -- forms
whitelist {
    {
        pop
    } {
        256 string cvs dup 0 1 getinterval (-) eq {
            pop
        }{
            =
        } ifelse
    } ifelse
} forall



(######################################################################################) =
quit