View source for Graphviz code: graphviz.pal

<pre>
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% graphviz.pal
% Author: Mark R. Bannister
% Date: 20/Apr/2017
%
% Creates some graphviz functions for producing a .gv dot file based on
% nexus objects passed into gv_add_node()
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

~Module
EQUS {[sys.tools]}

._init
func/def	[gv_open], &[.open], NULL, [psIndex], [data]
func/def	[gv_add_node], &[.add_node], NULL, [psPointer], [node]
func/def	[gv_close], &[.close]

% For testing only
%func/def	[main], &[.main]
local/rtn

.open
var/addr        P0, [data]	% 0=no data, 1=classes, 2=attributes
				% 3=add stat class to file objects
                                %   (and convert statMode to octal)
attr/index      P0, P0, [psIndex]
reg/load        P15, P0
var/global      NULL, [psIndex], [data], P0
attr/mvadd	![.prose.sys.io], [psStreamOut],
			[digraph G {\n],
			[  concentrate=true;\n],
			[  ratio=compress;\n]

% Use HTML tables if we need to display data too
reg/jmpge       &[.no_shape], P15, #1
func/rtn

.no_shape
attr/add        ![.prose.sys.io], [psStreamOut], [  node [shape=none\]\n]
func/rtn

.close
attr/add	![.prose.sys.io], [psStreamOut], [}\n]
func/rtn

.add_node
var/addr	P0, [node], P15, [data]
attr/index      P15, P15, [psIndex]
attr/copy	P1, P0, [psPointer]
obj/addr	P0, P1

reg/jmplt	&[.no_add_stat], P15, #3

% Add the stat class if requested
reg/clr		SFLG
class/test	P0, [psFile], [psFileHook]
reg/jmpeq	&[.no_add_stat], SFLG, #0
class/add	P0, [psStatUnix]
attr/load       P14, [statMode]

.no_add_stat
% Convert dots in node path to underscores
local/jsr	&[.replace_illegal_chars]
reg/move	P9, P1
reg/copy        P11, P9

% Get parent node
reg/load	P8, NULL
error/jmp	&[.no_parent], ![.prose.error.sys.BadObject]
obj/pa		P5, P0
error/jmp

var/local	P5, [psPointer], [parent], P5
attr/copy	P1, P5, [psPointer]
local/jsr	&[.replace_illegal_chars]
reg/move	P8, P1

% Add node label
local/jsr	&[.label_node]

% Output node in graph
attr/mvadd	![.prose.sys.io], [psStreamOut], [  ], P8, [ -> ], P9, [\n]
func/rtn

.no_parent
% Output root node
local/jsr	&[.label_node]
func/rtn

.label_node
attr/copy	P12, P0, [pn]
reg/jmpge	&[.render_class], P15, #1
attr/mvadd	![.prose.sys.io], [psStreamOut], [  ], P11, [ [label="], P12, ["\]\n]
local/rtn

.render_class
% Render HTML for the list of object classes and attributes
attr/mvadd	![.prose.sys.io], [psStreamOut],
			[  ], P11, [ [label=<\n],
			[    <table border="0" cellborder="1" cellspacing="0" cellpadding="8">\n],
			[    <tr><td bgcolor="#3366ff"><font color="#ffffff"><b>], P12, [</b></font></td></tr>\n],
			[    <tr><td><table border="0" cellborder="0" cellspacing="0" cellpadding="2">\n]

% Iterate through class list
stack/push	P1, P2, P3, P4, P5
class/load	P1, (P0)

.class_loop
class/load	P2, (P1)
reg/jmpeq	&[.class_break], P2, NULL
reg/copy	P3, P2
attr/mvadd	![.prose.sys.io], [psStreamOut],
			[      <tr><td align="left"><font color="#3366ff"><b>objectClass:</b></font></td><td align="left">], P3, [</td></tr>\n]
local/jmp	&[.class_loop]

.class_break
attr/mvadd	![.prose.sys.io], [psStreamOut], [    </table></td></tr>\n]
reg/jmplt	&[.label_rtn], P15, #2

% Iterate through attribute list
attr/mvadd	![.prose.sys.io], [psStreamOut],
			[    <tr><td><table border="0" cellborder="0" cellspacing="0" cellpadding="2">\n]
attr/load	P1, (P0)
error/jmp	&[.attr_catch], ![.prose.error.sys.NoEntry], ![.prose.error.sys.NoSupport]

.attr_loop
attr/load	P2, (P1)
reg/jmpeq	&[.attr_break], P2, NULL
local/jsr	&[.render_attr]
local/jmp	&[.attr_loop]

.render_attr
reg/copy	P3, P2

% Iterate through attribute values
attr/copy	P4, (P0, P2)

% ... except stdin, stdout, stderr
reg/clr		SFLG
reg/cmp		P3, [psStreamIn], P3, [psStreamOut], P3, [psStreamError],
		P3, [psStreamDebug], P3, [psByteStream]
reg/jmpeq	&[.atval_loop], SFLG, #0

attr/mvadd	![.prose.sys.io], [psStreamOut],
			[      <tr><td align="left"><font color="#3366ff"><b>], P3, [:</b></font></td><td align="left">&nbsp;], [</td></tr>\n]
local/rtn

.attr_catch
error/clr
error/jmp	&[.attr_catch], ![.prose.error.sys.NoEntry], ![.prose.error.sys.NoSupport]
local/rtn

.atval_loop
attr/copy	P5, (P4)
reg/jmpeq	&[.atval_break], P5, NULL

%
% If data mode is 3 and this is the statMode class, convert to octal
%
reg/jmplt	&[.atval_display], P15, #3
reg/jmpne       &[.atval_display], P2, P14
reg/conv        P5, P5, #10
reg/conv        P5, P5, #8
reg/copy        P5, [0], P5

.atval_display
reg/copy	P3, P2
attr/mvadd	![.prose.sys.io], [psStreamOut],
			[      <tr><td align="left"><font color="#3366ff"><b>], P3, [:</b></font></td><td align="left">], P5, [</td></tr>\n]
local/jmp	&[.atval_loop]

.atval_break
local/rtn

.attr_break
error/jmp
attr/mvadd	![.prose.sys.io], [psStreamOut], [    </table></td></tr>\n]

.label_rtn
attr/mvadd	![.prose.sys.io], [psStreamOut], [    </table>\n  >\]\n]
stack/pull	P5, P4, P3, P2, P1
local/rtn

.replace_illegal_chars
stack/push	P0

.loop
reg/xscan	P0, P1, [.]
reg/jmpeq	&[.loop2], P0, NULL
reg/save	P1, (#0x5f000000, P0, #0xff000000)
local/jmp	&[.loop]

.loop2
reg/xscan	P0, P1, [#]
reg/jmpeq	&[.loop3], P0, NULL
reg/save	P1, (#0x5f000000, P0, #0xff000000)
local/jmp	&[.loop2]

.loop3
reg/xscan	P0, P1, [-]
reg/jmpeq	&[.loop4], P0, NULL
reg/save	P1, (#0x5f000000, P0, #0xff000000)
local/jmp	&[.loop3]

.loop4
reg/xscan	P0, P1, [/]
reg/jmpeq	&[.loop_end], P0, NULL
reg/save	P1, (#0x5f000000, P0, #0xff000000)
local/jmp	&[.loop4]

.loop_end
stack/pull	P0
local/rtn

%.main
% For testing only
%func/call	NULL, [tools.gv_open], #0
%func/call	NULL, [tools.gv_add_node], ![.prose]
%func/call	NULL, [tools.gv_add_node], ![.prose.sys]
%func/call	NULL, [tools.gv_add_node], ![.prose.sys.io]
%func/call	NULL, [tools.gv_add_node], ![.prose.code]
%func/call	NULL, [tools.gv_add_node], ![.prose.code.sys]
%func/call	NULL, [tools.gv_add_node], ![.prose.error]
%func/call	NULL, [tools.gv_add_node], ![.prose.error.sys]
%func/call	NULL, [tools.gv_add_node], ![.prose.error.sys.StackLocked]
%func/call	NULL, [tools.gv_add_node], ![.prose.error.sys.RegisterDuplication]
%func/call	NULL, [tools.gv_add_node], ![.prose.error.sys.OutOfBounds]
%func/call	NULL, [tools.gv_close]
%func/rtn
</pre>