martes, 28 de septiembre de 2010

PS-HTTPD

PS-HTTPD: "

web-server-1


PS-HTTPD es un servidor web muy simple escrito en… sí: PS, Postscript!


Aquí copio el código fuente para los curiosos…



%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% @(#)ps.ps
% PostScript meta-interpreter.
% Copyright (C) 1989.
% By Don Hopkins. (don@brillig.umd.edu)
% All rights reserved.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% This program is provided for UNRESTRICTED use provided that this
% copyright message is preserved on all copies and derivative works.
% This is provided without any warranty. No author or distributor
% accepts any responsibility whatsoever to any person or any entity
% with respect to any loss or damage caused or alleged to be caused
% directly or indirectly by this program. If you have read this far,
% you obviously take this stuff far too seriously, and if you're a
% lawyer, you should give up your vile and evil ways, and go find
% meaningful employment. So there.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Problems:
% How do we catch the execution of event Name and Action dict values,
% executed by awaitevent?

systemdict begin

/iexec-types 100 dict def
/iexec-operators 100 dict def
/iexec-names 200 dict def
/iexec-exit-stoppers 20 dict def
/iexec-single-forall-types 20 dict def
/iexec-array-like-types 20 dict def

/iexec-continue-procs? true def
/iexec-continue-names? true def

/iexecing? false def

/signal-error { % name => -
dbgbreak
} def

/iexec-stopped-pending? { % - => bool
false
ExecSP 1 sub -1 0 {
ExecStack exch get % ob
dup type /dicttype eq {
dup /continuation known {
dup /continuation get /stopped eq {
pop true exit
} { pop } ifelse
} { pop } ifelse
} { pop } ifelse
} for
} def

/olddbgerrorhandler /DbgErrorHandler load ?def

/iexec-handle-error {
iexec-stopped-pending?
true { stoppedpending? } ifelse
{
/stop load PushExec
} {
$error /errorname get signal-error
} ifelse
} def

/DbgErrorHandler {
iexecing? {
iexec-handle-error
} //olddbgerrorhandler ifelse
} def

/isarray? { % obj => bool
type iexec-array-like-types exch known
} ?def

%
% A procedure to allow programmer to know if there is a "stopped"
% pending somewhere within the scope of the call. This is used
% to check if it's safe to rely on stopped to handle an error,
% rather than the errordict. The debugger can use this to
% catch errors that have no stopped call pending.
%
/stoppedpending? { % - => bool
false currentprocess /ExecutionStack get % result a
dup length 1 sub -2 1 { % result a i
2 copy get % result a i index
exch 1 sub 2 index exch get % result a index proc
dup isarray? {
exch 1 sub get % result a caller
/stopped load eq {pop true exch exit} if
} {
pop pop
} ifelse
} for
pop
} ?def

/?iexec-handle-error { % - => -
{ iexec-handle-error } if
} def

% interpretivly execute an object

/iexec { % obj => ...
100 dict begin
% This functions "end"s the interpreter dict, executes an object in the
% context of the interpreted process, and "begin"'s back onto the
% interpreter dict. Note the circularity.
/MumbleFrotz [ % obj => ...
/end load /exec load currentdict /begin load
] cvx def

/ExecStack 32 array def
/ExecSP -1 def

/PushExec [ % obj => -
/ExecSP dup cvx 1 /add load /store load
ExecStack /exch load /ExecSP cvx /exch load /put load
] cvx def

/PopExec [ % obj => -
ExecStack /ExecSP cvx /get load
/ExecSP dup cvx 1 /sub load /store load
] cvx def

/TraceStep {
iexec-step
} def

PushExec

{ ExecSP 0 lt { nullproc exit } if % nothing left to execute? goodbye.

ExecStack 0 ExecSP 1 add getinterval
TraceStep pop

% pop top of exec stack onto the operand stack
PopExec

% is it executable? (else just push literal)
dup xcheck { % obj
% do we know how to execute it?
dup type
//iexec-types 1 index known { % obj type
//iexec-types exch get exec % ...
} { % obj type
% some random type. just push it.
pop % obj
} ifelse
} if % else: obj

} loop % goodbye-proc

currentdict /MumbleFrotz undef % Clean up circular reference
end
exec % whoever exited the above loop left a goodbye proc on the stack.
} def

% visually execute an object, dumping drawing of stacks to trace-file

/vexec { % obj => ...
{ {
(
%!
/l { % gray x y lastx lasty
moveto
2 copy lineto
0 setgray
stroke

2 copy .3 0 360 arc
0 setgray
fill

.25 0 360 arc
setgray
fill

pause
} def
/e { % x y => -
gsave
translate
0 setlinewidth
360 32 div rotate
16 {
0 0 moveto
1 0 rlineto
0 setgray
stroke
1 0 .1 0 360 arc
random setgray
fill
360 16 div rotate
} repeat
grestore
} def
systemdict /pause known not {
/pause {} def
} if
gsave
20 20 scale
1 1 translate
0 setgray
0 setlinewidth
erasepage
)
trace-print
/TraceX 0 def
/TraceY count 1 sub def
/TraceZ 0 def
/TraceStep {
% (\() print ExecSP iexec-printexec (\)print ) trace-print
TraceY TraceX % x y
/TraceX ExecSP def
/TraceY count 2 sub def
/TraceZ TraceZ 1 add 360 mod def
TraceZ 15 mul cos 1 add 3 div 1 exch sub trace-print#
TraceX trace-print# TraceY trace-print#
trace-print# trace-print# % print x,y
(l\n) trace-print
random .2 le { flush pause pause pause } if
} def
/signal-error { % name => -
/TraceX ExecSP def
/TraceY count 3 sub def
TraceX trace-print# TraceY trace-print#
(e\n) trace-print
(grestore showpage\n) trace-print trace-flush
/stop load PushExec
} def
} meta-exec
exec
(grestore showpage\n) trace-print trace-flush
} iexec
} def

/trace-file (%socketc2000) (w) file def

/trace-flush {
trace-file dup null eq { pop currentfile } if
flushfile
} def

/trace-print { % string => -
trace-file dup null eq { pop currentfile } if
exch writestring
} def

%/trace-print# {typedprint} def
%/trace-print# {=} def
/trace-print# {
(%\n) sprintf trace-print
} def

/annealexec { % obj => ...
{ {
(
%!
/F /Times-Roman findfont
/s { % str point h s b x y
moveto sethsbcolor
F exch scalefont setfont
show
} def
gsave
)
trace-print
/TracedObjects 2000 dict def
/TracedTypes 20 dict def
TracedTypes begin
/nametype 0 def
/array .2 def
/packedarray .2 def
/operatortype .4 def
/dicttype .6 def
/canvas .8 def
end

/!FieldWidth 100 def
/!FieldHeight 100 def

/!StartBrightness .5 def
/!StartSaturation 1 def
/!StartPoint 18 def

/!StepBrightness .2 def
/!StepSaturation .2 def

/!DecayBrightness .95 def
/!DecaySaturation .95 def

/!TraceHistory 10 def

/!DistNear 5 def
/!DistFar 50 def
/!DistGrav .1 def
/!DecaySpeedNear .5 def

/!MagDecay .9 def
/!Friction .95 def

/LastTraced [] def

/TraceStep { % estack => popped
dup length 1 sub get % obj
dup type TracedTypes known {
TracedObjects 1 index known not {
30 dict begin
TracedObjects 1 index currentdict put
/Hue TracedTypes 2 index type get def
/Saturation !StartSaturation def
/Brightness !StartBrightness def
/Point !StartPoint def
/X !FieldWidth random mul def
/Y !FieldHeight random mul def
/DX 0 def
/DY 0 def
/String 1 index cvs def
end
} if
10 dict begin
/Other null def /Dist 0 def /Dir 0 def /Mag 1 def
TracedObjects exch get begin
LastObjects {
TracedObjects exch get
dup currentdict eq { pop } {
/Other exch store
Other /X get X sub
Other /Y get Y sub
2 index dup mul 2 index dup mul sub sqrt
/Dist exch store
Dist !DistNear lt {
% Wow, they're close together:
% Let's slow the other one down!
pop pop
Other begin
/DX DX !DecaySpeedNear mul def
/DY DY !DecaySpeedNear mul def
end
} {
atan /Dir exch store
Dist DistFar min
DistFar div DistGrav mul
/DX 1 index Dir cos mul Mag mul DX add store
/DY 1 index Dir sin mul Mag mul DY add store
} ifelse
/Brightness Brightness !StepBrightness add 1 min def
/Mag Mag !DecayMag mul store
} ifelse
} forall
/LastObjects [
currentdict LastObjects {
counttomark !TraceHistory ge { exit } if
} forall
] store
end
end
TracedObjects {
begin
/X X DX add !FieldWidth add !FieldWidth mod def
/Y Y DY add !FieldHeight add !FieldHeight mod def
/DX DX !Friction mul def
/DY DY !Friction mul def
/Brightness Brightness !DecayBrightness mul def
Y X Brightness Saturation Hue Point Str
((%) % % % % % % F\n) sprintf trace-print
end
} forall
null % for pop
} ifelse
} def
} meta-exec
exec
(grestore showpage\n) trace-print trace-flush
} iexec
} def

/iexec-printexec { % index => -
ExecStack 1 index get
dup type /dicttype eq {
dup /namestring known {
begin namestring end
} if
} if
exch (% %\n) printf
} def

/iexec-where {
0 1 ExecSP {
iexec-printexec
} for
} def

% execute step by step on the cyberspace deck stack display.
% To step, execute 'exit'. (make an 'exit' button to step with the mouse).

/cexec {
{ { /TraceStep {
ExecSP
iexec-printexec
select-object
/ThisStep ThisStep 1 add def
ThisStep Steps ge {
/ThisStep 0 def
_SendUpdateStack
eventloop
} if
null
} def
/Steps 1 def
/ThisStep 0 def
} meta-exec
exec
} iexec
} def

/iexec-step { % operand stack ... execee
} def

/iexec-sends { % - => context0 context1 ... contextn
ExecSP 1 sub -1 0 {
ExecStack exch get % ob
dup type /dicttype eq {
dup /continuation known {
dup /continuation get /send eq {
/context get
dup null eq { pop } if
} { pop } ifelse
} { pop } ifelse
} { pop } ifelse
} for
} def

% Re-enter the NeWS PS interpreter, execute object, and return.
% We need to construct the currentprocess's /SendStack from the interpreter's
% send stack, so ThisWindow and other functions that look at the SendStack
% will work.
/iexec-reenter { % obj => ...
mark
/ParentDictArray where pop
iexec-sends % obj mark context0 context1 ... contextn
{ { % obj mark context0 context1 ... contextn {func}
1 index mark eq { % obj mark {func}
pop pop % obj
{exec} stopped % ... bool
} { % obj mark context0 context1 ... contextn {func}
dup 3 -1 roll send % ...
} ifelse
} dup exec
} MumbleFrotz
?iexec-handle-error
} def

iexec-array-like-types begin
/arraytype true def
/packedarraytype true def
end % iexec-array-like-types

/iexec-token { % token => ...
dup xcheck {
% This is the "weird" thing about PostScript:
% If object is isn't an executable array, execute it, else push it.
//iexec-array-like-types 1 index type known not { PushExec } if
} if
} def

iexec-types begin

/nametype { % name => ...
pause
iexec-continue-names? {
% We push a dummy name continuation on the exec stack here to
% help with debugging, by making stack dumps more informative...
10 dict begin
/continuation /name def
/continue { % dict
pop
} def
/name 1 index def
/namestring {
/name load cvlit (name: % *done*) sprintf
} def
currentdict cvx PushExec
end
} if
//iexec-names 1 index known { % name
//iexec-names exch get % func
exec %
} {
% name
{{load}stopped} MumbleFrotz {
true ?iexec-handle-error
} {
PushExec
} ifelse
} ifelse
} def

/arraytype { % array => ...
iexec-continue-procs? {
10 dict begin
/continuation /procedure def
/proc exch def
/i 0 def
/len /proc load length def
/continue { % dict => -
begin
i len lt {
currentdict cvx PushExec
/proc load i get iexec-token
/i i 1 add def
} if
end
} def
/namestring {
(procedure % @ %: %)
[ /proc load i
1 index length 1 index gt { 2 copy get } (*done*) ifelse
] sprintf
} def
currentdict cvx PushExec
end
} {
dup length dup 0 eq { % array length
pop pop %
} { % array length
1 eq { % array
0 get %
iexec-token %
} { % array
dup 0 get % array head
% push rest of array to execute later
exch 1 1 index length 1 sub getinterval % head tail
PushExec % head
iexec-token %
} ifelse
} ifelse
} ifelse
} def

/packedarraytype /arraytype load def

/stringtype { % string => ...
dup token { % string rest token
exch dup length 0 eq { pop } { PushExec } ifelse % string token
exch pop % token
iexec-token % ...
} { % str
dup length 0 eq {
pop %
} { % str
/syntax signal-error
} ifelse
} ifelse
} def

/filetype { % file => -
dup token { % file token
exch dup % token file file
status { PushExec } { pop } ifelse % token
iexec-token % ...
} { % file
dup status {
/syntax signal-error
} {
pop
} ifelse
} ifelse
} def

/operatortype { % operator => -
//iexec-operators 1 index known {
//iexec-operators exch get exec
} {
{{exec}stopped}
MumbleFrotz
?iexec-handle-error
} ifelse
} def

/dicttype { % dict => -
dup /continuation known {
dup /continue get exec
} if
} def

end % iexec-types

iexec-operators begin

/exec load { % obj => -
PushExec
} def

/if load { % bool proc => -
exch {
PushExec
} {
pop
} ifelse
} def

/ifelse load { % bool trueproc falseproc
3 -1 roll { exch } if % wrongproc rightproc
PushExec pop
} def

iexec-single-forall-types begin
{/arraytype /packedarraytype /stringtype}
{true def} forall
end % iexec-single-forall-types

/forall load { % obj proc => -
10 dict begin
/continuation /forall def
/proc exch def
/obj exch cvlit def
/i 0 def
//iexec-single-forall-types obj type known {
/continue { % dict => -
begin
i obj length lt {
currentdict cvx PushExec
obj i get
/proc load PushExec
/i i 1 add def
} if
end
} def
/namestring {
(forall: proc=% obj=% @ %: %)
[ /proc load /obj load i
1 index length 1 index gt { 2 copy get } (*done*) ifelse
] sprintf
} def
} {
/keys [
obj {pop} forall
] def
/continue { % dict => -
begin
i obj length lt {
currentdict cvx PushExec
keys i get % key
obj 1 index get % key val
/proc load PushExec
/i i 1 add def
} if
end
} def
/namestring {
(forall: proc=% obj=% @ %: %)
[ /proc load /obj load
keys i
1 index length 1 index gt {
get 2 copy get
} {
pop null (*done*)
} ifelse
] sprintf
} def
} ifelse
currentdict cvx PushExec
end
} def

/for load { % first step last proc
10 dict begin
/continuation /for def
/proc exch def
/last exch def
/step exch def
/first exch def
/i first def
/continue { % dict => -
begin
i last step 0 gt {le} {ge} ifelse {
currentdict cvx PushExec
i
/proc load PushExec
/i i step add def
} if
end
} def
/namestring {
(for: proc=% first=% step=% last=% i=%)
[/proc load first step last i] sprintf
} def
currentdict cvx PushExec
end
} def

/repeat load {
10 dict begin
/continuation /repeat def
/proc exch def
/times exch def
/i 0 def
/continue { % dict => -
begin
i times lt {
currentdict cvx PushExec
/proc load PushExec
/i i 1 add def
} if
end
} def
/namestring {
(repeat: proc=% times=% i=%)
[/proc load times i] sprintf
} def
currentdict cvx PushExec
end
} def

/loop load {
10 dict begin
/continuation /loop def
/proc exch def
/continue { % dict => -
begin
currentdict cvx PushExec
/proc load PushExec
end
} def
/namestring {
/proc load (loop: proc=%) sprintf
} def
currentdict cvx PushExec
end
} def

/pathforallvec load {
%...
} def

iexec-exit-stoppers begin
{/forall /for /repeat /loop /pathforallvec}
{true def} forall
end % iexec-exit-stoppers

/exit load {
{ ExecSP 0 lt { % exit out of interpreter?
true exit
} {
PopExec % obj
dup dup xcheck exch type /dicttype eq and { % obj
dup /continuation known {
dup /continuation get iexec-exit-stoppers exch known {
pop false exit
} {
pop
} ifelse
} {
pop
} ifelse
} { % obj
pop
} ifelse
} ifelse
} loop

{ {exit} exit } if
} def

/stop load {
{ ExecSP 0 lt { % stop out of interpreter?
true exit
} {
PopExec % obj
dup dup xcheck exch type /dicttype eq and { % obj
dup /continuation known {
dup /continuation get /stopped eq {
pop true false exit
} {
pop
} ifelse
} {
pop
} ifelse
} { % obj
pop
} ifelse
} ifelse
} loop

{ {stop} exit } if
} def

/stopped load { % proc
10 dict begin
/continuation /stopped def
/continue { % dict => -
pop false
} def
/proc 1 index def % debugging
/namestring {
/proc load (stopped: proc=%) sprintf
} def
currentdict cvx PushExec
PushExec
end
} def

/send load { % <args> message object => <results>
{ currentdict } MumbleFrotz % message object context
2 copy eq { % message object context
pop pop cvx PushExec
} { % message object context
10 dict begin
/continuation /send def
/context
exch dup /ParentDictArray known not { pop null } if
def % message object
/object exch def % message
/message 1 index def % message
/continue { % cdict => -
{ % cdict
ParentDictArray dup type /arraytype ne { % X11/NeWS
/ParentDictArray get length 1 add
} {
length
} ifelse
1 add {end} repeat
/context get % context
dup null eq { % context
pop %
} { % idict context
dup /ParentDictArray get {begin} forall begin %
} ifelse %
} MumbleFrotz
} def
/unwind /continue load def
/namestring {
(send: message=% object=% context=%)
[/message load object context] sprintf
} def
currentdict cvx PushExec
object context % message object context
end % of cdict
{ null ne {
ParentDictArray length 1 add {end} repeat
} if
dup /ParentDictArray get
dup type /arraytype ne { % X11/NeWS
dup /ParentDictArray get
{begin} forall begin begin % message
} {
{begin} forall begin % message
} ifelse
} MumbleFrotz % message
cvx PushExec %
} ifelse
} def

% supersend (operator in X11/NeWS, proc in 1.1?)

/currentfile load { % => file
null
ExecStack length 1 sub -1 0 {
ExecStack exch get % obj
dup type /filetype eq {
exit
} {
pop
} ifelse
} for
dup null eq {
pop currentfile
} {
exch pop
} ifelse
} def

% We have to have the send contexts set up right when we do a fork, since
% the child process inherits them. (i.e. so ThisWindow works)
/fork load {
{fork} iexec-reenter
} def

/countexecstack load {
/countexecstack dbgbreak
} def

/quit load {
/quit dbgbreak
} def

end % iexec-operators

iexec-names begin

/sendstack {
[ iexec-sends
currentprocess /SendContexts get aload pop
]
} def

/iexecing? true def

% meta-exec is a hook back up to the interpreter context.
/meta-exec {
exec
} def

/append {
{{append} stopped} MumbleFrotz
?iexec-handle-error
} def

/sprintf {
{{sprintf} stopped} MumbleFrotz
?iexec-handle-error
} def

% execstack

end % iexec-names

/iexec-trace-changes {
iexec-operators begin
/def load {(/% % def\n) [3 index 3 index] dbgprintf def } def
/store load {(/% % store\n) [3 index 3 index]dbgprintf store} def
/put load {(% /% % put\n) [4 index 4 index 4 index]dbgprintf put} def
end
} def

end % systemdict



No related posts.



Creado por tuxotron for CyberHades, 2010. |
Permalink |
2 comments |


Post tags: , , ,

"