% VAX-11 Librarian V03-00To*+   CLISTR  _ .title god$cli $clidef $cliservdef  .macro $pushop name0 pushl #cli$k_cliserv! .endm ! .macro bgtrw dest, ?x blss x brw destx: .endm;; general-purpose interface; .entry god$cli, ^m<> pushal 4(ap) calls #1, sys$cli ret; ; pause!!!; .entry god$pause, ^m<> $pushop pause brw cal l_it;; enable control y; .entry god$ctrl_y, ^m<> $pushop enabctrly brw call_it;; enable control t; .entry god$ctrl_t, ^m<> $pushop enaboob brw call_it;; disable control y;" .entry god$no_ctrl_y, ^m<> $pushop disactrly brw call_it;; disable control t;" .entry god$no_ctrl_t, ^m<> $pushop disaoob brw call_it;; define a DCL symbol;-; call god$set_sym( symbol, value [, flag ]);" .entry god$set_sym, ^m movl #3, r01 bsbw getn ; get the third arg2 cmpl r0, #3 ; third arg too big? bgtrw invarg4 bsbw strings_2 ; push the string info6 cmpl r0, #1 ; is the local flag set? bneq 10$  $pushop deflocal brw call_it10$: $pushop defglobal brw call_it;; define a logical name;.; call god$set_log( logname, value [, flag ]);" .entry god$set_log, ^m movl #3, r01 bsbw getn ; get the third arg2 cmpl r0, #3 ; third arg too big? bgtrw invarg3 cmpl r0, #1 ; user mode flag set? bneq 10$ J pushl #0 ; use sys$crelog to make a user mode logname pushl 8(ap) pushl 4(ap) pushl #2 calls #4, sys$crelog ret10$:4 bsbw strings_2 ; push the string info $pushop crealog brw call_it;; delete a DCL symbol;&; call god$del_sym( symbol [, flag ]);" .entry god$del_sym, ^m movl #2, r02 bsbw getn ; get the second arg3 cmpl r0, #3 ; second arg too big? bgtrw invarg4 bsbw strings_1 ; push the string info6 cmpl r0, #1 ; is the local flag set? bneq 10$  $pushop delelcl brw call_it10$: $pushop delegbl brw call_it;; delete a logical name;&; call god$del_log( lognam [, flag ]);" .entry god$del_log, ^m movl #2, r02 bsbw getn ; get the second arg3 cmpl r0, #3 ; second arg too big? bgtrw invarg3 cmpl r0, #1 ; user mode flag set? bneq 10$ J pushl #0 ; use sys$dellog to kill a user mode logname pushl 4(ap) pushl #2 calls #3, sys$dellog ret10$:4 bsbw strings_1 ; push the string info $pushop delelog brw call_it;; translate a DCL symbol;-; call god$get_sym( symbol, value [, vlen ]);" .entry god$get_sym, ^m cmpl (ap), #3 blss 10$ pushl 12(ap) brb 20$10$: pushal -(sp)420$: bsbw strings_2 ; push the string info $pushop getsym brw call_it;; translate a logical name;.; call god$get_log( logname, value [, vlen ]);" .entry god$get_log, ^m movl #2, r02 bsbw getn ; get the second arg3 cmpl r0, #3 ; second arg too big? bgtrw invarg3 cmpl r0, #1 ; user mode flag set? bneq 10$ J pushl #0 ; use sys$dellog to make a user mode logname pushl 4(ap) pushl #2 calls #3, sys$dellog ret10$:4 bsbw strings_1 ; push the string info $pushop delelog brw call_it; ; call cli;call_it: pushl sp calls #1, sys$cli ret ;E;********************************************************************; internal subroutines;; decode the n'th parameter;getn:; cmpl (ap), r0 ; is there a third parameter? bgeq 10$0 clrl r0 ; if not, return 0 rsb10$:7 movl (ap)[r0], r0 ; get the third parameter: cmpl r0, #200 ; was it passed by refrence?5 blssu 20$ ; if so, dereference it movzbl (r0), r020$:* tstl r0 ; is it < 0?3 blss invarg ; if so, it's illegal2 rsb ; if not, we're done;; we got an invalid argument;invarg: movl #lib$_invarg, r0 ret;3; break up the first 2 args as descrs and push them; strings_2: popl r2 movl 8(ap), r1 pushl 4(r1) movzwl (r1), -(sp) pushl r2;/; break up the first arg as a descr and push it; strings_1: popl r2 movl 4(ap), r1 pushl 4(r1) movzwl (r1), -(sp) jmp (r2) .end  +;?CLI$K_ATTACH = 00000010+;?CLI$K_CHAIN = 00000004+;?CLI$K_COMMAND  = 00000005+;?CLI$K_GETSYM = 0000000A+;?CLI$K_GLOBAL_SYM = 00000002+;?CLI$K_LOCAL_SYM = 00000001+;?CLI$K_SPAWN = 0000000F ww@ .title god$str -- assorted string manipulation functions;; summary of entry points:*; all entry points return longword values;#; len( str ) - length of strB; len_l( str ) - length of str not counting preceeding blanks8; l_blank( str ) - number  of preceeding blanks in str@; len_r( str ) - length of str not counting trailing blanks6; r_blank( str ) - number of trailing blanks in strN; len_l_r( str ) - length of str not counting preceeding or trailing blanksE; l_r_blank( str )- number of preceeding and trailing blanks in str?; ljust( str ) - left-justifies string, returns new length7; upcase( str ) - uppercases string, returns length7; lowcase( str ) - lowercases string, returns lengthO; unquote( instr [, outstr ])- unquotes instr into outstr, returns new length; ;; useful constants:;c_blank = ^a/ /c_quote = ^a/"/c_biga = ^a/A/c_bigz = ^a/Z/c_lita = ^a/a/c_litz = ^a/z/case_diff = c_lita - c_biga ;; string length ; i = len( str );  .entry len, ^m<>: movzwl @4(ap), r0 ; this one is easy ret ;.; string length not counting preceeding blanks; i = len_l( str ); .entry len_l, ^m<> @ movq @4(ap), r0 ; load descr into r0, r1;10$: ; beginning of loopF tstw r0 ; looked at entire string yet? blequ 20$J cmpb (r1)+, #c_blank ; have we hit the first non-blank? bneq 20$C decw r0 ; decrement # of chars left2 brb 10$ ; and loop>20$: ; loop has been exited=  movzwl r0, r0 ; convert to longword ret ;; count preceeding blanks; i = l_blank( str ); .entry l_blank, ^m<>E callg (ap), len_l ; get len without prec blanks movzwl @4(ap), r1@ subl3 r0, r1, r0 ; subtract from real len ret ;,; string length not counting trailing blanks; i = len_r( str ); .entry len_r, ^m<>@ movq @4(ap), r0 ; load descr  into r0, r1D movzwl r0, r0 ; convert length to longwordB addl2 r0, r1 ; r1 gets 1 past last char;10$: ; beginning of loopF tstl r0 ; looked at entire string yet? blequ 20$J cmpb -(r1), #c_blank ; have we hit the first non-blank? bneq 20$C decl r0 ; decrement # of chars left2 brb 10$  ; and loop>20$: ; loop has been exited ret ;; count trailing blanks; i = r_blank( str ); .entry r_blank, ^m<>F callg (ap), len_r ; get len without trail blanks movzwl @4(ap), r1@ subl3 r0, r1, r0 ; subtract from real len ret ;:; string length not counting preceeding or trailing blanks; i = len_l_r( str ); .entry len_l_r, ^mE callg  (ap), len_l ; get len without prec blanks5 movl r0, r2 ; remember itO beql 10$ ; if the string is blank, can stop hereF callg (ap), len_r ; get len without trail blanks2 addl2 r2, r0 ; add them movzwl @4(ap), r1C subl2 r1, r0 ; subtract off the real len910$: ; done, so return ret ;&; count preceeding and trailing blanks; i = l_r_blank( str ); .entry l_r_blank, ^m movzwl @4(ap), r2G mull2 #2, r2 ; start with twice the real lenE callg (ap), len_l ; get len without prec blanksB tstl r0 ; if string is all blanks,7 beql 10$ ; special case= subl2 r0, r2 ; subtract into totalF callg (ap), len_r ; get  len without trail blanks= subl3 r0, r2, r0 ; subtract into total ret910$: ; string is blank? movzwl @4(ap), r0 ; so return it's length ret ;0; left-justify a string ( new length of string ); i = ljust( str );( .entry ljust, ^mD callg (ap), l_blank ; get # of blanks to cut off5 movl r0, r6 ; remember itD beql ! 10$ ; if none, skip the next bitE movq @4(ap), r2 ; load descr for easy munging subw3 r6, r2, r0 addl3 r6, r3, r1+ movc5 r0, (r1), #c_blank, r2, (r3)10$: movzwl @4(ap), r0> subl2 r6, r0 ; calculate new length ret ;.; translate all lowercase letters to uppercase; i = upcase( str ); .entry upcase, ^mK movq @4(ap), r0 ; load the s "tring descr into r0, r1;10$: ; beginning of loopF decw r0 ; looked at entire string yet?3 bgequ 20$ ; if so...< movzwl @4(ap), r0 ; get string length8 ret ; and return itE20$: ; otherwise, look at the char movb (r1)+, r3L cmpb r3, #c_lita ; don't upcase if not a lowcase ch#ar blss 10$ cmpb r3, #c_litz bgtr 10$: subb2 #case_diff, <-1>(r1) ; if it is, upcase2 brb 10$ ; and loop ;.; translate all uppercase letters to lowercase; i = lowcase( str ); .entry lowcase, ^mK movq @4(ap), r0 ; load the string descr into r0, r1;10$: ; beginning of loopF decw r0 ; looked at entire string $yet?3 bgequ 20$ ; if so...< movzwl @4(ap), r0 ; get string length8 ret ; and return itE20$: ; otherwise, look at the char movb (r1)+, r3M cmpb r3, #c_biga ; don't lowcase if not an upcase char blss 10$ cmpb r3, #c_bigz bgtr 10$; addb2 #case_diff, <-1>(r1) ; if it is, lowcase2 brb 10$ % ; and loop ;/; translate a quoted string, return it's length"; i = unquote( instr [, outstr ])3; if outstr is omitted, string is returned in instr;;- .entry unquote, ^mO movb #c_blank, r4 ; string is treated as preceeded by ' '= clrb r6 ; start not in quotesH movq @4(ap), r0 ; read descr for instr to r0, r1; cmpl (ap), #2 ; are th&ere 2 args? blss 10$A tstl 8(ap) ; is the second one null? beql 10$I movq @8(ap), r2 ; load descr for outstr to r2, r3 brb 20$10$:G movq r0, r2 ; or, if not present, use instr20$:@ movw r2, r7 ; remember output length 1100$: ; beginning of loopK tstw r0 ; are we out of input to translate?; ' blequ 200$ ; if so, break loopD tstw r2 ; same if out of output room blequ 200$ < movb r4, r5 ; remember last char7 movb (r1)+, r4 ; get this char decw r0 I cmpb r4, #c_quote ; if next char is a quote then... bneq 110$> incl r6 ; toggle inquote flag; blbc r6, 100$ ; i(f now in quotesD cmpb r5, #c_quote ; and last char was a quote bneq 100$= movb r4, (r3)+ ; copy it to output decw r2 brb 100$110$:; blbc r6, 120$ ; else if in quotes@ movb r4, (r3)+ ; copy a char to output decw r2 brb 100$120$:E cmpb r4, #c_blank ; else if input char is a ' ' bneq 130$> cmpb) r5, #c_blank ; if last char <> ' ' beql 100$= movb r4, (r3)+ ; copy it to output decw r2 brb 100$130$:C cmpb r4, #c_lita ; else if char is lowercase blss 140$ cmpb r4, #c_litz bgtr 140$G subb3 #case_diff, r4, (r3)+ ; upcase it and copy to output decw r2 brb 100$140$:> movb r4, (r3)+ ; else, co*py to output decw r2 brb 100$ +200$: ; end of loopG subw2 r2, r7 ; calculate output length in r79 blbs r6, 210$ ; if not inquotes= cmpb r4, #c_blank ; and last char = ' ' bneq 210$C tstw r7 ; and there was SOME output blequ 210$D decw r7 ; forget the trailing blank210$:M movc5 (sp), #0, #c_blank, r2, (r3) ; fill output string with blanksD movzwl r7, r0 ; convert length to longword7 ret ; and return it .endww