js@UW-JUNE.ARPA (Joe Meadows) (03/19/86)
Well, I guess a few more people are interested in VERB (aka CLEX
for VMS 4.0) this time around, so, I'm posting the sources to it.
Just save this as MAKEVERB.COM and execute it (from within an empty
directory to make things simple..)
I wrote this last summer, and it contains many kludges to be
sure, but, it works! I haven't had a problem with it, and I've rebuilt
the entire command tables with it as a check. You can look at VERB.CLD
to see the possible options, and VERB accepts wildcarded verb names,
i.e. VERB/LIST B* would list all verbs starting with B. VERB B* would
display the command definitions for all verbs starting with B.
Cheers.
Cut here....
$ write sys$output "This command procedure will create the necessary files"
$ write sys$output "to create VERB, it will also compile, link and"
$ write sys$output "define the VERB command."
$ copy:=copy/log
$copy sys$input COMPILE.COM
$deck
$ ! This command procedure reads a data file, with lines like the following:
$ ! Source name, object name, compile command, link options, required files
$ ! where source name is the name of the file to be acted upon
$ ! Object name is the name of the file to compare dates against
$ ! compile command is the actual command to use to produce the object file
$ ! link options are options to be added to the link command
$ ! required files is a list of files, seperated by "/" whose dates
$ ! are checked also to see if recompilation is necessary
$ !
$ ! Parameters to this command procedure are concatenated together, and
$ ! then seperated again via commas
$ ! 1 = command file to read from
$ ! 2 = compile options
$ ! 3 = global link options
$ ! So that, you could say @COMPILE "file,/debug,/exe=[-.exe]" and the "/debug"
$ ! option would affect all compiles, and the /exe=[-.exe] would of course be
$ ! added to the link command.
$ ! Currently theres no method for determining wether an option is applicable
$ ! to all files, i.e. /DEBUG doesn't work to well if one of the "compilers"
$ ! happens to be the librarian (i.e. in VERB)
$ !
$ err=0
$ if p1.nes."" then goto got_file
$get_p1:
$ if err then write sys$output "compile file not found"
$ tmp=f$search("*.COMPILE")
$ if tmp.nes."" then tmp=f$parse(tmp,,,"NAME")
$ inquire p1 "control file <''tmp'> "
$ if p1.eqs."" then p1=tmp
$got_file:
$ p1=p1+p2+p3+p4+p5+p6+p7+p8
$ p1=f$edit(p1,"UNCOMMENT")
$ file=f$search(f$parse(f$element(0,",",p1),".COMPILE"))
$ if file.nes."" then goto cntnue
$ err=1
$ goto get_p1
$!
$cntnue:
$ comp_opt=f$element(1,",",p1)
$ if comp_opt.eqs."," then comp_opt=""
$ link_opts=f$element(2,",",p1)
$ if link_opts.eqs."," then link_opts=""
$!
$ on control_y then goto end
$ on severe then goto end
$ open/read files 'file'
$ file_list=""
$compile_loop:
$ read/end=link_section files line
$10$:
$ ! if last character on line is "-" then concatenate with next line
$ line=f$edit(line,"TRIM")
$ if (f$extract(f$length(line)-1,1,line) .nes. "-") then goto 20$
$ read/end=20$ files nextline
$ line=f$edit(f$extract(0,f$len(line)-1,line),"UNCOMMENT")+nextline
$ goto 10$
$20$:
$ line=f$edit(line,"UNCOMMENT")
$ if line.eqs."" then goto compile_loop
$ src_file=f$element(0,",",line)
$ obj_file=f$element(1,",",line)
$ if obj_file.eqs."," then obj_file=""
$ obj_file=f$parse(obj_file,src_file)
$ compile=f$element(2,",",line)
$ if compile.eqs."," then compile=""
$ link_opt=f$element(3,",",line)
$ if link_opt.eqs."," then link_opt=""
$ includes=f$element(4,",",line)
$ if includes.eqs."," then includes=""
$ include=0
$!
$ if compile.eqs."" then goto do_not_compile_it
$ if "''f$search(obj_file,1)'".eqs."" then goto compile_it
$ src_rdt=f$cvtime(f$file_attributes(src_file,"RDT"))
$ obj_rdt=f$cvtime(f$file_attributes(obj_file,"RDT"))
$ if obj_rdt.les.src_rdt then goto compile_it
$ if includes.eqs."" then goto do_not_compile_it
$includes_loop:
$ inc_file=f$element(include,"/",includes)
$ if inc_file.eqs."/" then goto do_not_compile_it
$ inc_rdt=f$cvtime(f$file_attributes(inc_file,"RDT"))
$ if inc_rdt.gts.obj_rdt then goto compile_it
$ include=include+1
$ goto includes_loop
$compile_it:
$ write sys$output "''compile' ''comp_opt' ''src_file'"
$ 'compile 'comp_opt' 'src_file
$do_not_compile_it:
$ if link_opt.eqs."%NOLINK" then goto compile_loop
$ if "''link_file'".nes."" then goto add_name
$ link_file="LINK"+f$getjpi("","PID")+".COM;"
$ on control_y then goto err_close_link
$ on severe then goto err_close_link
$ open/write linkcom 'link_file
$ write linkcom "$ Link ''link_opts' -"
$ write linkcom " ''obj_file' ''link_opt' -"
$ goto compile_loop
$add_name:
$ write linkcom " ,''obj_file' ''link_opt' -"
$ goto compile_loop
$link_section:
$ write linkcom ""
$ close linkcom
$ type 'link_file
$ @'link_file
$ delete 'link_file
$end:
$ close files
$ exit
$err_close_link:
$ close files
$ close linkcom
$EOD
$copy sys$input BLURB.TXT
$deck
VERB is a program to extract verb definitions from either
your process space or a command table file (such as SYS$SHARE:DCLTABLES.EXE).
These verb definitions can then be changed and recompiled via the command
definition utility, SET COMMAND. This program is similar to the 3.n program
CLEX, except that it works with version 4.n command tables. This program
is a must if you need to change verb definitions, or if you just hate the
DEC defaults (getting tired of HELP/PAGE, or LINK creating maps when
executed from a batch job?).
VERB allows you to do wildcard searches for verbs (commands)
and lists of verbs, such as VERB A*,B*,%%% (which would return all the verb
definitions for commands that start with A, B, and all three letter commands).
You can specify a table to search for the verb, or even to search your
process space. The command defaults to searching your process space, but if you
enter VERB/TABLE it will default to using the system command table
SYS$SHARE:DCLTABLES, you can of course specify a table other than that, as in
VERB/TABLE=MY_OWN_TABLE, note that it uses SYS$SHARE:DCLTABLES.EXE as the
default file name in an RMS $OPEN call.
VERB allows you to put the output in a file, as in
VERB/OUTPUT=filename, VERB also can list available verbs (commands), w/o
the verb definition, as in VERB/LIST/ALL, and note the /ALL qualifier.
restrictions:
Well, it hasn't been tested with MCR tables.I wouldn't be surprised if
it didn't like them.
When extracting several verbs at a time the verbs may reference common
TYPE defnitions, in these cases only one is output, this only becomes a problem
if you cut up the output file into several smaller files.
When extracting several verbs (such as BASIC,MACRO,FORTRAN) they
may each reference a TYPE defnition that is different for each verb, but has
the same name. Since the TYPE definitions are actually different each one will
be included in the file, but the CDU will not appreciate having similarly
named TYPE definitions. In such cases simply extact the verbs into seperate
files.
$EOD
$copy sys$input BUFFER.MAR
$deck
.title buffer routines
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.psect _clex_local rd,wrt,noexe
_clex_desc::
_clex_pos::
.long
.long _clex_buffer
_clex_buffer:
.blkb 512
.psect _clex_code rd,nowrt,exe
.entry put_output,0
tstl _clex_pos ; is there really anything to output?
beql 5$ ; don't bother to output empty line
pushaq _clex_desc
calls #1,@clex_output ; output the buffer
blbc r0,10$
clrl _clex_pos ; clear the buffer, if successfully output
5$: movl #1,r0
10$: ret
.entry add_to_buffer,^m<r2,r3,r4,r5>
; 4(ap) = pointer to ascic
movl 4(ap),r4
movzbl (r4),r5
incl r4
brb _add_buffer
.entry add_to_buffer_trunc,^m<r2,r3,r4,r5>
; 4(ap) = pointer to ascic
; 8(ap) = length to truncate to
movl 4(ap),r4
movzbl (r4),r5
incl r4
cmpl r5,8(ap)
blss _add_buffer
movl 8(ap),r5
_add_buffer:
subl3 _clex_pos,clex_width,r2
cmpl r5,r2
bleq 20$
calls #0,put_output ; output string if it whats to be added wont fit
blbc r0,30$
brb _add_buffer
20$: movl _clex_pos,r3
addl r5,_clex_pos
movc3 r5,(r4),_clex_buffer(r3)
movl #1,r0
30$: ret
.end
$EOD
$copy sys$input CLEXLIB.MAR
$deck
.title macro routines
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.macro add_ascic,thing
pushl thing
calls #1,g^add_to_buffer
.endm add_ascic
.macro add_ascic_trunc,thing,leng,?l1,?l2
pushl leng
pushl thing
calls #2,g^add_to_buffer_trunc
.endm add_ascic_trunc
.macro add_string,thing
push_string <thing>
calls #1,g^add_to_buffer
.endm add_string
.macro case,src,displist,type=w,limit=#0,nmode=s^#,?base,?max
case'type src,limit,nmode'<<max-base>/2-1>
base:
.irp ep,<displist>
.word ep-base
.endr
max:
.endm case
.macro push_string text,?l1,?l2
.save
.psect _clex$strings,exe,nowrt,pic
l1: .ascic text
.restore
pushal l1
.endm push_string
.macro string text,?l1,?l2
.save
.psect _clex$strings,exe,nowrt,pic
l1: .ascic text
.restore
.long l1
.endm string
$EOD
$copy sys$input CLITABLE.TXT
$deck
! CLI Table Blocks
! Each block begins with a standard header, as follows
! +------------------------------+
! | subtype | type | length |
! +------------------------------+
! | TRO Count | Flags |
! +------------------------------+
! all references to other blocks are made via Table relative offsets (TRO)
! the TRO count specifies how many such references there are, and the
! reference longwords always follow the header immediately. The rest of
! each block contains other information necessary for the definition
! of the item.Following the fixed portion of the block is a variable
! portion, which contains any variable length strings. Each of these
! strings is referenced from the fixed portion of the block by a
! word Block relative offset (BRO)
! These are the valid block types starting at 1.
! vector Vector (root) block
! command Command block
! type Type block
! entity Entity block
! expression Expression block
! cdu_visited for CDU internal use
!vector block
! the primary vector block appears at the beginning of a CLI table,
! and contains references to all other blocks and block lists.
!
! standard header, valid subtypes starting at 1
! DCL
! MCR
! Verb
! command
! flags - broken into two bytes, low byte contains structure level
!Two TRO's,
! verbtbl TRO of verb name table
! comdptr TRO of command block pointer table
!the verb name table is composed of the standard header, followed by one
! longword for each verb or synonym, the longword contains the first
! four characters of the verb name padded with nulls as necessary
!the command block pointer table is composed of the standard header,
! followed by one longword for each entry in the verb table. This
! longword contains the TRO of the corresponding command block.
!
!command block
!
! a command block is used to define a verb or a syntax change brought about
! by a parameter or qualifier. There is one command block for each verb
! (but not its synonyms), and one for each syntax change within a verb
!
! standard header, valid subtypes starting at 1
! verb
! syntax
! flags --bits, starting at zero I guess
! abbrev
! nostat
! foreign
! immed
! mcrparse
! parms
! quals
! disallows
!TRO's --
! parms TRO of first parameter, Entity block
! max parms=8
! quals TRO of first qualifier
! disallows TRO of top-level disallow boolean Expression block
!HANDLER (byte) How does CLI handle verb (starting at 0)
! none It doesn't
! cli Calls a cli routine
! user calls a user routine
! image imvokes an image
! same same handling as verb
!PARMCNT Two nibbles (1 byte)
! MINPARM first four bits
! MAXPARM second four bits
!VERBTYP (byte) Verb type code for use with old CLI interface
!PAD (byte)
!NAME (word) BRO of verb or syntax name
!IMAGE (word) BRO of routine or image reference
!OUTPUTS (word) BRO of outputs list
!PREFIX (word) BRO of prefix string
! -- end of fixed portion --
! variable section --
! Max sizes --
! max_name = 1+31
! max_image= 64
! max_outputs=1+7
! max_prefix=1+31
!--folowing the fixed portion, the verb names are stored as a sequence
! of ascic strings within an overall ascic string, or the syntax name is
! stored as a single ascic string.
! the routine or image reference is stored as follows
! CLI routine Routine name as ascic string
! user routine longword routine address, then ascic string
! image ascic string
! outputs list consists of a counted sequence of bytes. each byte contains
! either the negation of the parameter number or the qualifier number
! the prefix string is stored as an ascic string
!
!TYPE block
!
! a type block is used as a header of a chain of entity blocks
! that describe TYPE keywords there is one TYPE block for each
! user specified type definition
!
! standard header, valid subtypes starting at 1
! type
!no flags
!TRO ..
! keywrds TRO of first keyword entity block
!NAME (word) BRO of type name
!Prefix (word) BRO of prefix string
!-- end of fixed --
!-- following the fixed portion the type name is stored as ascic string,
! so is the prefix string
!
!Entity block
!
! an entity block is used to define each parameter, qualifier, and data
! type keyword. These blocks are liked off the command block for the
! verb, in the case of parameters and qualifiers, or off of the type
! block, in the case of type keywords.
!
! standard header, valid subtypes starting at 1
! parameter
! qualifier
! keyword
!flags, bits starting at 0 ..
! val can take a value
! neg can be replaced with no
! deftrue present by default
! batdef present by default if batch
! valreq a value is required
! list can be a list of values
! concat can be a concatenated list
! impcat implicit concatenated list
! verb global placement
! parm local placement (both means positional)
! mcroptdelim MCR SET UIC kluge
! mcrignore MCR ignores this entity
!
!TROs
! NEXT TRO of next entity block
! SYNTAX TRO of syntax change command block
! USER_TYPE TRO of user defined type
!NUMBER (byte) Entity number. Cli should only use for parameters
!VALTYP (byte) Value type, starting at zero,
! user_defined defined by user
! infile input file spec
! outfile output file spec
! number decimal integer
! privilege priv keyword
! datetime date/time
! protection protection spec
! process process name
! inlog input logical name
! outlog output logical name
! insym input symbol name
! outsym output symbol name
! node DECnet node spec
! device node/device spec
! dir node/dev/dir spec
! uic UIC spec
! restofline rest of command line
! parenvalue parenthesized value
! file any file spec
! expression general DCL expression
! test1 Three hooks for testing
! test2
! test3
! acl ACL spec
!NAME (word) BRO of entity name
!LABEL (word) BRO of label used to retrieve entity
!PROMPT (word) BRO of parameter prompt
!DEFVAL (word) BRO of parameter default value(s)
! --max sizes --
! Name=1+31
! label=1+31
! prompt=1+31
! defval=1+95
!-- end of fixed portion--
!-- following the fixed portion are the Name, Label, Prompt and default values,
! stored as ascic strings. The default values are stored as a sequence of ascic
! strings, within the overall ascic string.
!
!expression block
!
! an expression block is used to represent, within a boolean expression,
! one operator and its operands. The operands are themselves expression
! blocks, either subexpressions or paths. Paths represent the hierarchical
! path to an entity whose presence is to be determined.
!
! standard header, valid subtypes starting at 1
! path entity path
! not boolean NOT
! any2 " ANY2
! and " AND
! or " OR
! xor " XOR
! neg " NEG
! no flags defined
!TR0 Count
! operand_list character length 0 tag l
!(max 8 entities)
$EOD
$copy sys$input COMMAND.MAR
$deck
.title print command block
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.library 'clexlib'
.entry clex_print_command,^m<r2,r3,r4,r5,r6,r7>
; 4(ap) = address of command block
movl 4(ap),r6
5$: bitw #cmd_m_parms,cmd_w_flags(r6)
beql 10$
tstl cmd_l_parms(r6)
beql 10$
addl3 clex_table,cmd_l_parms(r6),-(sp)
calls #1,clex_evaluate_entity
10$: bitw #cmd_m_quals,cmd_w_flags(r6)
beql 20$
tstl cmd_l_quals(r6)
beql 20$
addl3 clex_table,cmd_l_quals(r6),-(sp)
calls #1,clex_evaluate_entity
20$: movzwl cmd_w_name(r6),r7
addl r6,r7
case cmd_b_subtype(r6),type=b,limit=#1,<-
_verb,-
_syntax>
movl #0,r0 ; invalid
ret
_verb: add_string <'define verb '>
movzbl (r7),r2 ; save size of entire thing
movzbl 1(r7),r3 ; save size of verb name
_verb1: incl r7 ; point to first ascic
add_ascic_trunc r7,r3
decl r2 ; subtract off extra byte for count byte
movzbl (r7),r4 ; assume verb bigger than synonym
cmpb (r7),r3 ; is synonym bigger than verb?
bleq _verb2
movzbl r3,r4 ; if so it got truncated by CDU
add_string <' !! warning, synonym truncated'>
_verb2: calls #0,g^put_output
subb r4,r2 ; subtract off printed portion.
beql _verb3
addl r4,r7
tstb 1(r7)
beql _verb1 ; if zero length string , skip to next.
add_string <' synonym '>
brb _verb1
_verb3: brb _continue
_syntax:
add_string <'define syntax '>
add_ascic r7
_continue:
calls #0,put_output
movzwl cmd_w_image(r6),r7
addl r6,r7
clrl _clex_handler_flag
case cmd_b_handler(r6),type=b,limit=#0,<-
_print_prefix,- ; no handler
_handler_cli,-
_handler_user,-
_handler_image,-
_handler_same>
movl #0,r0 ; invalid handler
ret
_handler_cli:
add_string <' cliroutine '>
add_ascic r7
bitw #^x1F,cmd_w_flags(r6) ; any cliflags?
bneq _handler_cli1
calls #0,g^put_output
brw _print_prefix
_handler_cli1:
clrq r4
add_string <' , cliflags ('>
moval table_cli_flags,r3
_handler_cli2:
bbc r4,cmd_w_flags(r6),_handler_cli4
tstl r5
beql _handler_cli3
add_string <','>
_handler_cli3:
incl r5
add_ascic (r3)[r4]
_handler_cli4:
aobleq #4,r4,_handler_cli2
add_string <')'>
calls #0,g^put_output
brw _print_prefix
_handler_user:
add_string <' routine '>
add_ascic r7
calls #0,g^put_output
brw _print_prefix
_handler_image:
add_string <' image '>
add_ascic r7
calls #0,g^put_output
brw _print_prefix
_handler_same:
movl #1,_clex_handler_flag
brw _print_prefix
_print_prefix:
movzwl cmd_w_prefix(r6),r7
beql _print_parms
addl r6,r7
add_string <' prefix '>
add_ascic r7
calls #0,g^put_output
_print_parms:
bitw #cmd_m_parms,cmd_w_flags(r6)
beql _print_quals
tstl cmd_l_parms(r6)
bneq _print_parms_1
add_string <' noparameters'>
calls #0,g^put_output
brb _print_quals
_print_parms_1:
addl3 clex_table,cmd_l_parms(r6),-(sp)
calls #1,clex_print_entity
_print_quals:
bitw #cmd_m_quals,cmd_w_flags(r6)
beql _print_disallows
tstl cmd_l_quals(r6)
bneq _print_quals_1
add_string <' noqualifiers'>
calls #0,g^put_output
brb _print_disallows
_print_quals_1:
addl3 clex_table,cmd_l_quals(r6),-(sp)
calls #1,clex_print_entity
_print_disallows:
bitw #cmd_m_disallows,cmd_w_flags(r6)
beql _print_outputs
tstl cmd_l_disallow(r6)
beql _print_outputs
add_string <' disallow '>
pushl r6
addl3 clex_table,cmd_l_disallow(r6),-(sp)
calls #2,clex_print_disallows
calls #0,g^put_output
brb _print_outputs
_print_outputs:
clrl r5
movzwl cmd_w_outputs(r6),r3 ; BRO outputs list
beql _end_of_command
addl r6,r3 ; point to ascic of outputs
movzbl (r3),r4 ; number of outputs
beql _end_of_command ; see if there is indeed any outputs
incl r3
add_string <' outputs('>
brb _print_continue
_print_out_loop:
add_string <','>
_print_continue:
movb (r3)[r5],r2
blss _print_out_parm
addl3 clex_table,cmd_l_quals(r6),r7 ; r7 is address of first entity
brb _get_entity_loop
_print_out_parm:
mnegb r2,r2
addl3 clex_table,cmd_l_parms(r6),r7
_get_entity_loop:
decb r2
beql _print_this_output
addl3 clex_table,ent_l_next(r7),r7
brb _get_entity_loop
_print_this_output:
movzwl ent_w_label(r7),r2
addl r7,r2
add_ascic r2
aoblss r4,r5,_print_out_loop
add_string <')'>
calls #0,g^put_output
_end_of_command:
ret
.psect string_table rd,nowrt,noexe
table_cli_flags:
string <'abbreviate'>
string <'nostatus'>
string <'foreign'>
string <'immediate'>
string <'mcrparse'>
.end
$EOD
$copy sys$input DISALLOWS.MAR
$deck
.title print disallows block
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.library 'clexlib'
_clex_l_bracket: string '<'
_clex_r_bracket: string '>'
.psect _clex_code rd,nowrt,exe
.entry clex_print_disallows,^m<r2,r3,r4,r5,r6,r7>
; 4(ap) = address of disallows block
movl 4(ap),r6
movzwl exp_w_tro_count(r6),r3
moval exp_l_operand_list(r6),r2
case cmd_b_subtype(r6),type=b,limit=#1,<-
_path,-
_not,-
_any2,-
_and,-
_or,-
_xor,-
_neg>
_path:
clrl r4
tstl _clex_handler_flag
beql _path2
addl3 clex_table,(r2)[r4],-(sp) ; this entity
calls #1,g^clex_find_entity
cmpl r0,8(ap)
beql _path2
movl r0,r7
beql _path2 ; hmm... How strange, it couldn't find it..
movl r7,r1
cmpb #block_k_command,cmd_b_type(r1)
bneq 10$
movzwl cmd_w_name(r1),r7
cmpb #cmd_k_verb,cmd_b_subtype(r1)
bneq 20$
incl r7
brb 20$
10$: cmpb #block_k_type,type_b_type(r1) ; let's assume this is true
bneq _path2
movzwl type_w_name(r1),r7
20$: addl r1,r7
add_ascic _clex_l_bracket
add_ascic r7
add_ascic _clex_r_bracket
brb _path2
_path1: add_string <'.'>
_path2: addl3 clex_table,(r2)[r4],r5
movzwl ent_w_label(r5),r1
addl r5,r1
add_ascic r1
aoblss r3,r4,_path1
brw _dis_end
_and:
clrl r4
add_string <'('>
brb _and2
_and1: add_string <' and '>
_and2: pushl 8(ap)
addl3 clex_table,(r2)[r4],-(sp)
calls #2,clex_print_disallows
aoblss r3,r4,_and1
add_string <')'>
brw _dis_end
_or:
clrl r4
cmpl r3,#1
beql _or2
add_string <'('>
brb _or2
_or1: add_string <' or '>
_or2: pushl 8(ap)
addl3 clex_table,(r2)[r4],-(sp)
calls #2,clex_print_disallows
aoblss r3,r4,_or1
cmpl r3,#1
beql _or3
add_string <')'>
_or3: brw _dis_end
_xor:
clrl r4
add_string <'('>
brb _xor2
_xor1: add_string <' xor '>
_xor2: pushl 8(ap)
addl3 clex_table,(r2)[r4],-(sp)
calls #2,clex_print_disallows
aoblss r3,r4,_xor1
add_string <')'>
brw _dis_end
_not:
clrl r4
add_string <'not'>
_not1: add_string <' '>
pushl 8(ap)
addl3 clex_table,(r2)[r4],-(sp)
calls #2,clex_print_disallows
aoblss r3,r4,_not1
; add_string <')'>
brw _dis_end
_neg:
clrl r4
add_string <'(neg'>
_neg1: add_string <' '>
_neg2: pushl 8(ap)
addl3 clex_table,(r2)[r4],-(sp)
calls #2,clex_print_disallows
aoblss r3,r4,_neg1
add_string <')'>
brw _dis_end
_any2:
clrl r4
add_string <'any2('>
brb _any22
_any21: add_string <','>
_any22: pushl 8(ap)
addl3 clex_table,(r2)[r4],-(sp)
calls #2,clex_print_disallows
aoblss r3,r4,_any21
add_string <')'>
brw _dis_end
_dis_end:
ret
.end
$EOD
$copy sys$input ENTITY.MAR
$deck
.title print entity block
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.library 'clexlib'
.entry clex_print_entity,^m<r2,r3,r4,r5,r6,r7,r8>
; 4(ap) = address of entity block
movl 4(ap),r6
moval table_types,r4
movzbl ent_b_subtype(r6),r5
decl r5
blss 10$
cmpl r5,#3
blss 20$
10$: clrl r0
ret
20$: add_string <' '>
add_ascic (r4)[r5]
add_string <' '>
movzwl ent_w_name(r6),r7
addl r6,r7
add_ascic r7
movl r7,r8
movl ent_l_syntax(r6),r7
beql _label
add_string <' , syntax='>
addl clex_table,r7
movzwl cmd_w_name(r7),r5
addl r7,r5
add_ascic r5
_label:
movzwl ent_w_label(r6),r7
beql _prompt
addl r6,r7
movzbl (r8),r0
movzbl (r7),r1
cmpc5 r0,1(r8),#^a' ',r1,1(r7) ; see if other that default
beql _prompt
add_string <' , label='>
add_ascic r7
movl r7,r8 ; prompt defaults to label right?
_prompt:
movzwl ent_w_prompt(r6),r7
beql _ent_neg
addl r6,r7
movzbl (r8),r0
movzbl (r7),r1
cmpc5 r0,1(r8),#^a' ',r1,1(r7) ; see if other than default
beql _ent_neg
add_string <' , prompt="'>
add_ascic r7
add_string <'"'>
_ent_neg:
calls #0,g^put_output
movzbl ent_b_subtype(r6),r5
cmpl r5,#2
beql _ent_neg1 ; default for qualifiers is negatable
bbc #ent_v_neg,ent_w_flags(r6),_ent_def
add_string <' negatable'>
calls #0,g^put_output
brb _ent_def
_ent_neg1:
bbs #ent_v_neg,ent_w_flags(r6),_ent_def
add_string <' nonnegatable'>
calls #0,g^put_output
_ent_def:
bbc #ent_v_deftrue,ent_w_flags(r6),_ent_bat
add_string <' default'>
calls #0,g^put_output
_ent_bat:
bbc #ent_v_batdef,ent_w_flags(r6),_ent_val
add_string <' batch'>
calls #0,g^put_output
_ent_val:
bbs #ent_v_val,ent_w_flags(r6),_ent_val1
brw _ent_cliflags
_ent_val1:
add_string <' value'>
clrl r7
bbc #ent_v_valreq,ent_w_flags(r6),_ent_impcat
add_string <' (required'>
incl r7
_ent_impcat:
bbc #ent_v_impcat,ent_w_flags(r6),_ent_list
tstl r7
bneq _ent_impcat1
add_string <' ('>
incl r7
brb _ent_impcat2
_ent_impcat1:
add_ascic comma
_ent_impcat2:
add_string <'impcat'>
_ent_list:
bbc #ent_v_list,ent_w_flags(r6),_ent_concat
tstl r7
bneq _ent_list1
add_string <' ('>
incl r7
brb _ent_list2
_ent_list1:
add_ascic comma
_ent_list2:
add_string <'list'>
bbs #ent_v_concat,ent_w_flags(r6),_ent_defval
add_string <',noconcatenate'>
_ent_concat:
bbc #ent_v_concat,ent_w_flags(r6),_ent_defval
tstl r7
bneq _ent_concat1
add_string <' ('>
incl r7
brb _ent_concat2
_ent_concat1:
add_ascic comma
_ent_concat2:
add_string <'concatenate'>
_ent_defval:
movzwl ent_w_defval(r6),r5
beql _ent_type
addl r6,r5
tstl r7
bneq _ent_defval1
add_string <' ('>
incl r7
brb _ent_defval2
_ent_defval1:
add_ascic comma
_ent_defval2:
add_string <'default="'>
clrl r3
movzbl (r5),r2 ; save size of entire thing
_ent_defval3:
incl r5 ; point to first ascic
decl r2 ; subtract off extra byte for count byte
movzbl (r5),r4
tstl r3
beql _ent_defval4
add_ascic comma
_ent_defval4:
add_ascic r5
incl r3
subb r4,r2 ; subtract off printed portion.
beql _ent_defval5
addl r4,r5
brb _ent_defval3
_ent_defval5:
add_string <'"'>
_ent_type:
tstb ent_b_valtype(r6)
bneq _ent_type1
movl ent_l_user_type(r6),r5
bneq _ent_type00
brw _ent_end_val
_ent_type00:
addl clex_table,r5
movzwl type_w_name(r5),r4
addl r5,r4
tstl r7
bneq _ent_type0
incl r7
add_string <' ('>
brb _ent_type01
_ent_type0:
add_ascic comma
_ent_type01:
add_string <'type='>
add_ascic r4
brb _ent_end_val
_ent_type1:
tstl r7
bneq _ent_type2
incl r7
add_string <' ('>
brb _ent_type3
_ent_type2:
add_ascic comma
_ent_type3:
add_string <'type='>
moval table_value_types,r1
movzbl ent_b_valtype(r6),r2
decl r2
add_ascic (r1)[r2]
_ent_end_val:
tstl r7
beql _ent_end_val1
add_string <')'>
_ent_end_val1:
calls #0,g^put_output
_ent_cliflags:
bitw #ent_m_mcroptdelim!ent_m_mcrignore,ent_w_flags(r6)
beql _ent_position
clrl r7
add_string <' cliflags ('>
bbc #ent_v_mcroptdelim,ent_w_flags(r6),_ent_cliflags1
add_string <'mcroptdelim'>
incl r7
_ent_cliflags1:
bbc #ent_v_mcrignore,ent_w_flags(r6),_ent_cliflags3
tstl r7
beql _ent_cliflags2
add_ascic comma
_ent_cliflags2:
add_string <'mcrignore'>
_ent_cliflags3:
add_string <')'>
calls #0,g^put_output
_ent_position:
bbc #ent_v_parm,ent_w_flags(r6),_ent_pos2
add_string <' placement='>
bbc #ent_v_verb,ent_w_flags(r6),_ent_pos1
add_string <'positional'>
brb _ent_pos2
_ent_pos1:
add_string <'local'>
_ent_pos2:
calls #0,g^put_output
movl ent_l_next(r6),r0
beql 10$
addl3 clex_table,r0,-(sp)
calls #1,clex_print_entity
10$: ret
.psect string_table rd,nowrt,noexe
comma: string <','>
table_types:
string <'parameter'>
string <'qualifier'>
string <'keyword'>
table_value_types:
string <'$infile'>
string <'$outfile'>
string <'$number'>
string <'$privilege'>
string <'$datetime'>
string <'$protection'>
string <'$process'>
string <'$inlog'>
string <'$outlog'>
string <'$insym'>
string <'$outsym'>
string <'$node'>
string <'$device'>
string <'$directory'>
string <'$uic'>
string <'$rest_of_line'>
string <'$parenthesized_value'>
string <'$deltatime'>
string <'$quoted_string'>
string <'$file'>
string <'$expression'>
string <'$$test1'>
string <'$$test2'>
string <'$$test3'>
string <'$acl'>
.end
$EOD
$copy sys$input EVALENTITY.MAR
$deck
.title evaluate entity, to print out TYPEs and SYNTAX's
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.psect _clex_local rd,wrt,noexe
_clex_eval_count::
.long
_clex_evals::
.blkl 4096
_clex_ents_count::
.long
_clex_ents::
.blkl 4096
.psect _clex_code rd,nowrt,exe
.entry clex_evaluate_entity,^m<r2,r3,r4,r5>
movl 4(ap),r2
moval _clex_evals,r3
_evaluate:
tstl ent_l_user_type(r2)
beql 10$
addl3 clex_table,ent_l_user_type(r2),r4
addl3 type_l_keywords(r4),clex_table,r4
clrl r1
tstl _clex_eval_count
beql 5$
3$: cmpl r4,(r3)[r1]
beql 10$
aoblss _clex_eval_count,r1,3$
5$: movl r4,(r3)[r1]
incl _clex_eval_count
pushl r4
calls #1,clex_evaluate_entity
addl3 clex_table,ent_l_user_type(r2),-(sp)
calls #1,clex_print_type
10$: tstl ent_l_syntax(r2)
beql 20$
addl3 clex_table,ent_l_syntax(r2),r4
clrl r1
tstl _clex_eval_count
beql 15$
13$: cmpl r4,(r3)[r1]
beql 20$
aoblss _clex_eval_count,r1,13$
15$: movl r4,(r3)[r1]
incl _clex_eval_count
pushl r4
calls #1,clex_print_command
20$: tstl ent_l_next(r2)
beql 30$
addl3 clex_table,ent_l_next(r2),-(sp)
calls #1,clex_evaluate_entity
30$: ret
.end
$EOD
$copy sys$input FIND.MAR
$deck
.title find verb routine
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.psect _clex_local rd,wrt,noexe
verb_buff_desc: .blkl 2
.psect _clex_code rd,nowrt,exe
.entry clex_find_verb,^m<r2,r3,r4,r5>
;
; 4(ap)=verb descriptor
; 8(ap)=verb number
; 12(ap)=command block address
; start at verb number and go to last verb
; looking for baby that matches
;
movl clex_commands,r3
movl @8(ap),r4 ; verb number
cmpl r4,clex_cmd_cnt
bgeq 40$
10$: movl (r3)[r4],r5 ; comand_block TRO
addl clex_table,r5
movzwl cmd_w_name(r5),r0 ; name BRO
addl r0,r5 ; ascic all names
movzbl (r5),r2
20$: incl r5 ; ascic verb name
movzbl (r5),verb_buff_desc
moval 1(r5),verb_buff_desc+4
pushl 4(ap)
pushaq verb_buff_desc
calls #2,g^str$match_wild
blbs r0,50$
decl r2
subb (r5),r2
bleq 30$
addl verb_buff_desc,r5
brb 20$
30$: aoblss clex_cmd_cnt,r4,10$
40$: clrl @8(ap)
clrl r0
brb 60$
50$: movl (r3)[r4],r5 ; get command TRO to compare with all previous
clrl r1 ; ones to see if we've already printed this one
tstl r4
beql 56$
55$: cmpl (r3)[r1],r5
beql 30$ ; if this one's been done before continue search
aoblss r4,r1,55$ ; continue checking
56$: movl r4,@8(ap)
movl (r3)[r4],@12(ap)
addl clex_table,@12(ap)
movl @12(ap),_clex_cmd_block
movl #1,r0
60$: ret
.end
$EOD
$copy sys$input FINDENTITY.MAR
$deck
.title find_entity
.library 'clexlib'
.entry clex_find_entity,^m<r2,r3,r4,r5>
; 4(ap) = entity block
; this routine searches down the entity block to see
; which command/syntax/keyword it belongs to.
clrl r0
clrl _clex_ents_count
pushl 4(ap)
pushl _clex_cmd_block
calls #2,clex_check_entity
ret
.entry clex_check_entity,^m<r2,r3,r4,r5>
cmpl 4(ap),8(ap)
bneq 10$
movl #1,r0
ret
; loop through and see if we've done this already
10$: movl 4(ap),r4
moval _clex_ents,r2
clrl r1
tstl _clex_ents_count
beql 35$
20$: cmpl (r2)[r1],r4
bneq 30$
ret
30$: aoblss _clex_ents_count,r1,20$
35$: incl _clex_ents_count
movl r4,(r2)[r1] ; remember having done this..
cmpb #block_k_entity,ent_b_type(r4)
bneq 60$
movl ent_l_next(r4),r5
beql 40$
jsb _clex_call_check
beql 40$
brw 90$
40$: movl ent_l_syntax(r4),r5
beql 50$
jsb _clex_call_check
beql 50$
brw 90$
50$: cmpb #ent_k_user_defined,ent_b_valtype(r4)
bneq 60$
movl ent_l_user_type(r4),r5
jsb _clex_call_check
beql 60$
cmpl r0,#1
bneq 90$
movl r5,r0
brw 90$
60$: cmpb #block_k_type,type_b_type(r4)
bneq 70$
movl type_l_keywords(r4),r5
jsb _clex_call_check
beql 70$
cmpl r0,#1
bneq 90$
movl r4,r0
brw 90$
70$: cmpb #block_k_command,cmd_b_type(r4)
bneq 90$
bitw #cmd_m_parms,cmd_w_flags(r4)
beql 80$
movl cmd_l_parms(r4),r5
beql 80$
jsb _clex_call_check
beql 80$
cmpl r0,#1
bneq 90$
movl r4,r0
brw 90$
80$: bitw #cmd_m_quals,cmd_w_flags(r4)
beql 90$
movl cmd_l_quals(r4),r5
beql 90$
jsb _clex_call_check
beql 90$
cmpl r0,#1
bneq 90$
movl r4,r0
brw 90$
90$: ret
_clex_call_check:
addl clex_table,r5
pushl 8(ap)
pushl r5
calls #2,clex_check_entity
tstl r0
rsb
.end
$EOD
$copy sys$input GET_TERM.MAR
$deck
.title get terminal characteristics
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
; calling sequence
; ret-stat = get_terminal_characteristics( terminal, characteristics )
; ret-stat is a longword return status from any of the following
; system services : ASSIGN,DASSGN,GETDVI,QIOW
; terminal is the address of a descriptor containing the name of the
; device to get information on
; characteristics is the address of the quadword to return
; the characteristics in.
$devdef ; device characteristics
$ttdef ; terminal characteristics
$dvidef ; device information
$dcdef ; device class
dvi_list:
.word 4,dvi$_devclass ; buffer length, item code
.long dev_class ; buffer address
.long 0 ; return length (0 = don't bother)
dev_class: .long
dev_chan: .word ; channel
dev_buff: .quad ; device characteristics buffer
.entry get_terminal_characteristics,0
; call getdvi to determine if SYS$INPUT is a terminal
$getdviw_s -
devnam=@4(ap),itmlst=dvi_list
blbs r0,5$
ret ; punt if error
; is it a terminal?
5$: cmpl #dc$_term,dev_class
beql 10$ ; branch to 10$ if it is a terminal
movl #0,r0
brb 30$ ; no sense in asking if isn't a terminal
10$: $assign_s -
devnam=@4(ap),chan=dev_chan
blbc r0,30$
$qiow_s chan=dev_chan,func=#io$_sensemode,p1=@8(ap),p2=#8
blbc r0,20$
20$: $dassgn_s -
chan=dev_chan
30$: ret
.end
$EOD
$copy sys$input INIT.MAR
$deck
.title initialization routines
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.library 'clexlib'
.psect _clex_common rd,wrt,noexe
clex_table:: .long ; table address
clex_verbs:: .long ; verb list
clex_commands:: .long ; command list
clex_cmd_cnt:: .long ; number of verbs
clex_output:: .long ; output routine address
clex_width:: .long ; width of output buffer
_clex_handler_flag::
.long
_clex_cmd_block::
.long
.sbttl initialize table address
.psect _clex_code rd,nowrt,exe
.entry clex_use_process_table,0
; ret-status = clex_use_process_table()
movl ctl$ag_clitable,clex_table
jsb _clex_initialize
ret
.entry clex_use_image,0
; ret-status = clex_use_image (tableaddress)
movl @4(ap),clex_table
jsb _clex_initialize
ret
.psect _clex_local rd,wrt,noexe
fab: $fab dnm=<SYS$SHARE:DCLTABLES.EXE>,fac=get,fop=ufo
inadr: .long ^x200,^x200
retadr: .quad
$secdef
.psect _clex_code rd,nowrt,exe
.entry clex_use_command_table,0
; ret-status = clex_use_command_table( table )
movl 4(ap),r0
movb (r0),fab+fab$b_fns
movl 4(r0),fab+fab$l_fna
$open fab=fab
blbc r0,10$
$crmpsc_s -
inadr=inadr,retadr=retadr,flags=#<sec$m_expreg>,-
chan=fab+fab$l_stv,vbn=#2
blbc r0,10$
movl retadr,clex_table
jsb _clex_initialize
10$: ret
_clex_initialize:
movl clex_table,r0
addl3 r0,vec_l_verbtbl(r0),clex_verbs
addl3 r0,vec_l_comdptr(r0),r1
movzwl vec_w_tro_count(r1),clex_cmd_cnt
addl #8,clex_verbs
addl3 #8,r1,clex_commands
movl #1,r0
rsb
.entry clex_init_output,0
movl 4(ap),clex_output
movl @8(ap),clex_width
ret
.end
$EOD
$copy sys$input LIST.MAR
$deck
.title print verb name
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.library 'clexlib'
.entry clex_print_verb,^m<r2,r3,r4,r5,r6,r7>
; 4(ap) = address of command block
movl 4(ap),r6
movzwl cmd_w_name(r6),r7
addl r6,r7
case cmd_b_subtype(r6),type=b,limit=#1,<-
_verb,-
_syntax>
movl #0,r0 ; invalid
ret
_verb: movzbl (r7),r2 ; save size of entire thing
movzbl 1(r7),r3 ; save size of verb name
_verb1: incl r7 ; point to first ascic
add_ascic_trunc r7,r3
decl r2 ; subtract off extra byte for count byte
movzbl (r7),r4 ; assume verb bigger than synonym
cmpb (r7),r3 ; is synonym bigger than verb?
bleq _verb2
movzbl r3,r4 ; if so it got truncated by CDU
add_string <' (synonym truncated)'>
_verb2: subb r4,r2 ; subtract off printed portion.
beql _verb3
addl r4,r7
tstb 1(r7)
beql _verb1 ; if zero length string , skip to next.
add_string <' , '>
brb _verb1
_verb3: brb _continue
_syntax:
add_string <'(syntax) '>
add_ascic r7
_continue:
calls #0,put_output
ret
.entry clex_get_verb_name,^m<r2,r3,r4,r5,r6,r7>
; 4(ap) = address of command block
movl 4(ap),r6
movzwl cmd_w_name(r6),r7
addl r6,r7
case cmd_b_subtype(r6),type=b,limit=#1,<-
_get_verb>
movl #0,r0 ; invalid
ret
_get_verb:
movzbl (r7),r2 ; save size of entire thing
movzbl 1(r7),r3 ; save size of verb name
incl r7 ; point to first ascic
add_ascic_trunc r7,r3
pushaq _clex_desc
pushl 8(ap)
calls #2,g^str$copy_dx
movl _clex_pos,@12(ap)
clrl _clex_pos
ret
.end
$EOD
$copy sys$input TYPE.MAR
$deck
.title print type block
; VERB Version 1.0 June 1st, 1985
; Written by Joe Meadows Jr., with thanks to the
; Fred Hutchinson Cancer Research Center for kindly
; allowing me to use their computing resources.
;
; If you have any questions, comments, ideas, or
; whatever, feel free to contact me via US Mail :
; Joe Meadows Jr.
; 4841 268th Ave. N.E.
; Redmond Wa. 98052
; or via phone : (206) 827-7296
.library 'clexlib'
.entry clex_print_type,^m<r2,r3>
; 4(ap) = address of type block
movl 4(ap),r2
movzwl type_w_name(r2),r3
addl r2,r3
add_string <'define type '>
add_ascic r3
calls #0,g^put_output
movzwl type_w_prefix(r2),r3
beql type_1
addl r2,r3
add_string <' prefix '>
add_ascic r3
calls #0,g^put_output
type_1: addl3 clex_table,type_l_keywords(r2),-(sp)
calls #1,clex_print_entity
ret
.end
$EOD
$copy sys$input VERB.COMPILE
$deck
! Source name, object name, compile command, link options, required files
!
Clexlib.mar,.mlb,Library/macro/create clexlib,%NOLINK
Verb.for,.obj,Fortran
Buffer.mar,.obj,Macro
Command.mar,.obj,Macro
Disallows.mar,.obj,Macro
Entity.mar,.obj,Macro
Evalentity.mar,.obj,Macro
Find.mar,.obj,Macro
Findentity.mar,.obj,Macro
Get_term.mar,.obj,Macro
Init.mar,.obj,Macro
List.mar,.obj,Macro
Type.mar,.obj,Macro
Sys$system:sys.stb,,,/sel
Sys$system:dcldef.stb,,,/sel
$EOD
$copy sys$input VERB.FOR
$deck
program verb_extractor
! VERB Version 1.0 June 1st, 1985
! Written by Joe Meadows Jr., with thanks to the
! Fred Hutchinson Cancer Research Center for kindly
! allowing me to use their computing resources.
!
! If you have any questions, comments, ideas, or
! whatever, feel free to contact me via US Mail :
! Joe Meadows Jr.
! 4841 268th Ave. N.E.
! Redmond Wa. 98052
! or via phone : (206) 827-7296
implicit integer (a-z)
character buffer*80,comment*132,verb*32,symbol*80
logical all,out,list, found, anyfound, openfile
external lib$put_output,output,lib$find_image_symbol
byte term_char(8)
integer*2 term_width
equivalence (term_char(3),term_width)
integer cli$_entnf/'38934'x/
comment=
1 '!***************************************'
1//'****************************************'
1//'****************************************'
1//'************' ! I just love a huge comment...
! let user specifywidth of output stream (for the heck of it, okay?)
if (cli$present('width')) then
call error(cli$get_value('width',buffer,buff_len))
call error(ots$cvt_ti_l(buffer(:buff_len),width))
else
i=get_terminal_characteristics('SYS$INPUT',term_char)
if (.not.i) term_width=132
width=term_width ! default to screen width for the heck of it
end if
! just want a listng of the verbs?
list=cli$present('list')
! use file or actual process mapped version?
if (cli$present('table')) then
call error(cli$get_value('Table',buffer,buff_len))
call error(clex_use_command_table(buffer(:buff_len)))
elseif (cli$present('image')) then
! is there an image spec?
call error(cli$get_value('Image',buffer,buff_len))
call error(cli$get_value('Symbol',symbol,symb_len))
call error(lib$find_image_symbol(buffer(:buff_len)
1 ,symbol(:symb_len)
2 ,tableaddr))
call clex_use_image(tableaddr)
else
call clex_use_process_table
end if
! is output going to a file?
if (cli$get_value('output',buffer,buff_len)) then
openfile=.true. ! wait till we've found a verb before opening file
call clex_init_output(output,width)
out=.true.
else
call clex_init_output(lib$put_output,width)
end if
anyfound=.false.
! they want all the verbs?
if (cli$present('all')) then
verb='*'
verb_len=1
goto 15
end if
! get the next verb down the line
10 i=cli$get_value('Verb',verb,verb_len)
if (.not.i) then
if (anyfound) then
call exit
else
call exit(cli$_entnf)
end if
end if
call str$upcase(verb(:verb_len),verb(:verb_len))
15 j=0
! locate the little bugger
found = .false.
20 i=clex_find_verb(verb(:verb_len),j,cmd_block)
if (.not.i) then
if (found) then
goto 10
else
call lib$signal(%val(cli$_entnf-4))
goto 10
end if
end if
anyfound=.true.
found=.true.
if (openfile) then ! we need to open the output file
open(file=buffer(:buff_len),err=30,unit=1,status='new'
1 ,defaultfile='.CLD',carriagecontrol='list')
openfile=.false.
end if
! get ready to output the verb
if (list) then
i=clex_print_verb(%val(cmd_block))
else
call clex_get_verb_name(%val(cmd_block),buffer,buff_len)
i=min(width,132)
k=i/2-buff_len/2
if (k.lt.1) k=1
i=max(i-buff_len,0) ! center verb name in middle of comment
if (out) then
call output
1 (comment(:k)//buffer(:buff_len)//comment(k+1:i))
else
call lib$put_output
1 (comment(:k)//buffer(:buff_len)//comment(k+1:i))
end if
! okay, here it is
i=clex_print_command(%val(cmd_block))
end if
j=j+1 ! continue search with next verb
goto 20
30 end
subroutine error(i)
if (.not.i) call exit(i)
return
end
integer function output (a)
character*(*) a
output=0
write(1,'(a)',err=10) a
output=1
10 return
end
$EOD
$copy sys$input VERBS.COM
$deck
$ verb/list/out=verbs.list/all/table
$ open/read list verbs.list
$ open/write output verbs.dif
$ on control_y then goto no_more_verbs
$loop:
$ read/end=no_more_verbs list command
$ command:='f$element(0,",",command)
$ write output "Testing ''command'"
$ verb/out='command'/table 'command
$ set command 'command
$ verb/out='command'/table 'command
$ diff 'command'.cld/out=nla0:
$ x='$status
$ if x.eq.%x6c8013 then write output "Difference found in ''command'"
$ delete 'command'.cld;*
$ goto loop
$no_more_verbs:
$ close list
$ close output
$eod
$copy sys$input VERB.CLD
$deck
!*************************************VERB**************************************
define verb VERB
image EXE$DIR:VERB
parameter P1 , label=VERB , prompt="Verb"
value (list)
qualifier ALL
nonnegatable
qualifier PROCESS
nonnegatable
qualifier TABLE
nonnegatable
value (default="SYS$SHARE:DCLTABLES",type=$infile)
qualifier OUTPUT
nonnegatable
value (type=$outfile)
qualifier WIDTH
nonnegatable
value (required,type=$number)
qualifier IMAGE
nonnegatable
value (required,type=$infile)
qualifier SYMBOL
nonnegatable
value (required)
qualifier LIST
nonnegatable
disallow ((TABLE and PROCESS) or (TABLE and IMAGE) or (PROCESS and IMAGE))
$eod
$ write sys$output "Compiling VERB program"
$ @compile.com verb
$ write sys$output "Defining VERB command"
$ set command VERB
$ write sys$output "Try VERB VERB, and, have a nice day!"
$ write sys$output "Cheers."