wendt@ives.cs.colostate.edu (alan l wendt) (06/06/90)
The following program fails with "nocurrentpoint" on our Apple lw's
but works on dxpsview. If you change the user function named "arc" to
"narc" it works on the lw's. Apparently the lw's lose the current
point when calling a user function that redefines a system function.
Alan W.
--------------------------------------------------------------------------
%!
% Include this file in at the beginning of any postscript file to catch
% postscript errors and print a page of debug information.
% Define how to print any postcript object. Objects whos values I do not
% know how to print have their type (surrounded by double dashes) printed.
% This could probably be made smart enough to print values of ALL objects
% if one wanted to work hard enough.
/typeDict 25 dict def typeDict begin
/booleantype { 25 string cvs show } def
/integertype { 25 string cvs show } def
/nametype { 25 string cvs show } def
/operatortype { 25 string cvs show } def
/realtype { 25 string cvs show } def
/stringtype { 25 string cvs show } def
/arraytype { pop (--array--) show } def
/packedarraytype { pop (--packedarray--) show } def
/dicttype { pop (--dict--) show } def
/filetype { pop (--file--) show } def
/fonttype { pop (--font--) show } def
/marktype { pop (--mark--) show } def
/nulltype { pop (--null--) show } def
/savetype { pop (--save--) show } def
end
% Print an item and move down one line
/PrI
{0 10 translate 0 0 moveto dup type typeDict begin exec end}
def
% Print an array of items in a vertical list
/PrS
{gsave 0 0 moveto show 0 10 translate $error exch get {PrI} forall grestore }
def
% (Re)Define the error handler in the errordict dictionary to print all the
% data concerning the error which was stored in the errordict.
errordict begin
/handleerror {
showpage initgraphics
/Times-Roman findfont 30 scalefont setfont
144 700 moveto (Error: ) show $error /errorname get 100 string cvs show
144 650 moveto (Command: ) show $error /command get 100 string cvs show
/Times-Roman findfont 10 scalefont setfont
144 72 translate /ostack (Operand stack:) PrS
144 0 translate /estack (Execution stack:) PrS
144 0 translate /dstack (Dictionary stack:) PrS
showpage
} def
end
%!
%! slides 6/88 Compiler Conference
/arc { % x y ->
56 currentpoint pop pop pop % DEBUG
0 setlinewidth
58 currentpoint pop pop pop % DEBUG
0 vs 2 div neg rmoveto % down half a line
vs 2 div add rlineto % line to half a line up from (x,y)
0 vs neg rmoveto % down a line
} def
/arc2 { % deltax dir ->
64 currentpoint pop pop pop % DEBUG
/dir exch def % set dir
dir mul 0 rmoveto % move deltax*dir horizontally
arcsize dir mul arcsize neg
68 currentpoint pop pop pop % debug
arc % line to (dir*arcsize,-arcsize)
} def
/binary { % str -> x y (for right son)
dup stringwidth pop 6 div /hadjust exch def % hadjust = width(str)/6
s % center str at dot
currentpoint % save loc of root
hadjust 1 arc2 % arc from root to right son
currentpoint 4 2 roll moveto % exchange loc of root and right son
hadjust -1 arc2 % arc from root to left son
currentpoint stroke moveto % move to left son
} def
/center { % str ->
dup stringwidth pop 2 div neg 0
82 currentpoint pop pop pop % DEBUG
rmoveto show % center str at dot
} def
/centerline { % str ->
currentpoint exch pop % find current line
4.25 inch exch moveto % move to its center
center crlf % center str there
} def
/crlf { currentpoint exch pop vs sub 1 inch exch moveto } def
/hline { currentpoint newpath 1 setlinewidth 2 sub moveto 0 rlineto stroke } def
/inch { 72 mul } def
/initfont { exch findfont exch scalefont def } def
/interp { { inarray infont instr pop } forall } def
/inarray { dup type /arraytype eq { dup {infont instr2 pop} forall crlf } if } def
/infont { dup type /dicttype eq {dup setfont} if } def
/instr { dup type /stringtype eq {dup show crlf} if } def
/instr2 { dup type /stringtype eq {dup show} if } def
/leaf { % x y s ->
s % center s at dot
moveto % move to (x,y)
} def
/line { show crlf } def
/s { % str ->
currentpoint 3 2 roll center moveto % center str at and return to dot
} def
/slide {
dup 0 get title
dup length 1 sub 1 exch getinterval interp
showpage
} def
/slideno 0 def
/title {
rmbig setfont
1 inch 10 inch moveto underline
1 inch 10 inch moveto show
rm setfont
crlf crlf
} def
/unary { % str ->
s % center str at dot
0 arcsize neg
123 currentpoint pop pop pop % debug
arc currentpoint stroke moveto % arc to lone son
} def
/underline { dup stringwidth pop hline } def
/arcsize 0.75 inch def
/ps 21 def
/vs 30 def
/it /Times-Italic ps initfont
/rm /Times-Roman ps initfont
/rmbig /Times-Roman ps 1.25 mul initfont
/sy /Symbol ps initfont
/tt /Courier ps initfont
rmbig setfont
4.25 inch 10 inch moveto
(Automatic Generation of) centerline
(Fast Optimizing Code Generators) centerline
crlf
rm setfont
(Christopher W. Fraser) centerline
(AT&T Bell Laboratories) centerline
crlf
(Alan L. Wendt) centerline
(University of Arizona) centerline
crlf
crlf
crlf
(Specs: Vax in 1 page, C intermediate code in 3.) show crlf
(Compilation rate like hand-done compilers.) show crlf
(Case analysis like pcc.) show crlf
showpage
tt setfont
5.75 inch 10 inch vs 2 mul sub moveto currentpoint
(ISET) binary
(IADD) binary
(IMUL) binary
(IADD) binary
(ISUB) binary
(REG 3) leaf
(REG 2) leaf
(ICONST 7) leaf
(ICONST 4) leaf
(GLOBAL up) leaf
(ICONST 0) leaf
5.75 inch 3 inch moveto currentpoint
(clrl _up+4*7[r6]) unary (subl3 r2,r3,r6) leaf
3.5 inch 10 inch moveto tt setfont (up[r-c+7] = 0;) show
[(I/O behavior:)] slide
[
(Common representation)
tt
(op = "addl3 r%1,r%0,r%2")
[(kids[0] = ) it (pointer to first child) tt]
[(kids[1] = ) it (pointer to second child) tt]
(vars[2] = "6")
()
[rm (Leading) tt ( vars ) rm (denote children's result registers.)]
] slide
[
(Specifying the intermediate code)
tt
(%shape 0 1)
(GLOBAL moval _%0,r%1)
(...)
(%shape 2 2)
(IADD addl3 r%1,r%0,r%2)
(ISUB subl3 r%1,r%0,r%2)
(...)
(%shape 2)
(ILT cmpl r%0,r%1; jlss L%2)
(ISET movl r%1,(r%0))
(...)
] slide