.title PARSE_UIC ...just like it sounds .ident /V2.06B/ .sbttl Documentation ; ; This routine accepts as input a text uic, and returns as ; output the group and member numbers as words, or the uic ; as a longword. It will return an error status of SS$_INVIDENT ; if it cannot parse the UIC. Wild card UIC's and IDs are ; accepted. ; ; Eric F. Richards ; 07-Apr-86 ; Gould OSD VAXcluster VMS V4.2 ; .sbttl Macros and constants ; ht = 9 ; TAB character textuic = 4 ; AP offset for text UIC descriptor outuic = 8 ; offset for longword output uic outgrp = 8 ; offset for word output group outmem = 12 ; offset for word output member minargs = 2 ; offset for min arg count $ssdef ; define system service offsets $uicdef ; define UIC wild cards .disable traceback, debug ; hands off with the debugger .enable suppression ; clean up the listing files ; .sbttl Main code .page .psect $code, long, exe, pic, shr, nowrt .entry parse_uic, ^m cmpb #minargs, (ap) ; did we get enough arguments? bleq 10$ ; if so, skip the error handler movzwl #ss$_insfarg, r0 ; this is the error, ret ; ...and this is how we handle it assume uic$k_match_all eq -1 ; make next inst work 10$: mnegl #1, r7 ; set wild card UIC value moval -(sp), r8 ; make a buffer for the ID value ; ; Take a look at the input string. Leading and trailing spaces, tabs ; and nulls are ignored. However, any embedded spaces, tabs or nulls ; are illegal and will return a SS$_IVIDENT status. ; movl textuic(ap), r0 ; take a look at that text decriptor movzwl (r0), r9 ; ...r9 has its length beql 30$ ; if 0, bad ID... error out ; ; Scan from the end until a good character is found. ; movl 4(r0), r10 ; r10 has its address addl3 r9, r10, r0 ; r0 now looks at the end of the string 22$: movb -(r0), r2 ; r2 has the current byte to move: bsbw check ; is it a forbidden character? bneq 24$ ; if not, we're all right now sobgtr r9, 22$ ; else loop until no more trash char's brb 30$ ; nothing but trash: error out ; ; Scan forward until a good character is found ; 24$: movb (r10), r2 ; look at the char's from other side bsbw check ; is it a forbidden character? bneq 32$ ; if not, then we're done incl r10 ; increment counter sobgtr r9, 24$ ; loop until string is parsed 30$: brb 83$ ; get out with an "invalid ID" error ; ; Any troublesome characters in the middle? ; 32$: locc #ht, r9, (r10) ; any embedded tabs? bneq 30$ ; if so, error out locc #^a/ /, r9, (r10) ; any embedded spaces? bneq 30$ ; if so, error out locc #0, r9, (r10) ; any embedded nulls? bneq 30$ ; if so, error out ; ; Now, build a descriptor for this string and parse it. ; pushl r10 ; build a dummy descr for input string pushl r9 ; ...this is the length movl sp, r11 ; save a ptr to this new descr locc #^a/[/, r9, (r10) ; look for beginning of UIC beql 40$ ; if no "[", look for "<" movl r1, r2 ; save pointer to that char locc #^a/]/, r9, (r10) ; look for end of UIC brb 45$ ; go to common code 40$: locc #^a//, r9, (r10) ; look for ">" 45$: beql 83$ ; if not found, error out cmpl r2, r10 ; start delim should be 1st char bneq 83$ ; if not, error cmpl #1, r0 ; last delim should be last char bneq 83$ ; if not, error subl3 #1, r1, r3 ; save, correct ptr to end of UIC locc #^a/,/, r9, (r10) ; look for comma bneq 80$ ; if found, go to numeric/alpha part addl3 #1, r2, 4(r11) ; screw up beginning of descriptor subl3 r2, r3, (r11) ; screw up its length 50$: bsbw ident ; translate as an ID blbs r0, done ; on success goto success exit ret ; otherwise, return error status 80$: movl #uic$k_max_uic, r7 ; set wild card field for UIC wild subl3 #1, r1, r6 ; save comma ptr for second use subl3 r1, r3, (r11) ; descr only looks at member now addl3 #1, r1, 4(r11) ; botch starting address bsbb octal ; try using octal translation blbc r0, 87$ ; if error, try as literal ID cmpl (r8), #uic$k_wild_member; are we an oversized member number? blequ 95$ ; if not, join common code 83$: movzwl #ss$_ivident, r0 ; error -- bad UIC format 85$: ret ; return with error status 87$: bsbb ident ; try identifier translation blbc r0, 85$ ; on error get out cmpl (r8), r7 ; is it too big to be a UIC? bgtru 83$ ; if so, error out 95$: movw (r8), r4 ; save member number for later subl3 r2, r6, (r11) ; botch desc len to look at group only addl3 #1, r2, 4(r11) ; screw up address for string beginning bsbb octal ; attempt translation as an octal value blbc r0, 102$ ; if error, try a text translation cmpl (r8), #uic$k_wild_group ; are we too large a group number? bgtru 83$ ; if so, error out! ashl #16, (r8), (r8) ; get group number in high word brb 105$ ; continue on here 102$: bsbb ident ; attempt translation as an ID blbc r0, 85$ ; on error get sick movl (r8), r5 ; save value for next step cmpl r5, r7 ; are we too big to be a UIC? bgtru 83$ ; if so, consistency error cmpw #uic$k_wild_member, r5 ; is it a wild card in the member spot? bneq 83$ ; if not, error out. 105$: movw r4, (r8) ; restore member only done: cmpb #minargs, (ap) ; do we have more than the min. args? beql 10$ ; if not, skip this stuff movw (r8), @outmem(ap) ; return member as a word ashl #-16, (r8), r1 ; move group to a low word for return movw r1, @outgrp(ap) ; return group as a word ret ; return 10$: movl (r8), @outuic(ap) ; return UIC as a longword ret ; return -- all done! .sbttl Support subroutines .page .align long ; check for space, tab, or null check: cmpb r2, #^a/ / ; is it a space? beql 10$ ; if so, skip tstb r2 ; is it a null? beql 10$ ; if so, skip cmpb r2, #ht ; is it a tab? 10$: rsb ; return with condition codes .align long ; trans octal text to longword octal: pushl r8 ; push output buffer pushl r11 ; push input descriptor calls #2, g^ots$cvt_to_l ; call the function rsb ; go back to caller .align long ; trans ID, wild card to longword ident: $asctoid_s name=(r11), - ; call system service: r8 is output, id=(r8) ; ...r11 is input descriptor blbs r0, 10$ ; if successful, return cmpw #1, (r11) ; check for wild cards -- bneq 10$ ; ...must be 1 char long cmpb #^a/*/, @4(r11) ; wild card char is a star -- bneq 10$ ; ...is it present? movl r7, (r8) ; if so, set wild card UIC movzwl #ss$_normal, r0 ; set success status 10$: rsb ; and go back to caller .end ; th-th-that's all, folks!