.title PARSE_UIC ...just like it sounds .ident /V2.05/ .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 clrl r9 ; init string counter movl textuic(ap), r0 ; take a look at that text decriptor movzwl (r0), r10 ; ...r10 has its length bneq 20$ ; if non-zero, go on brw 83$ ; else, error out 20$: movl 4(r0), r0 ; r0 has its address addl r10, r0 ; r0 now looks at the end of the string 30$: movb -(r0), r2 ; r2 has the current byte to move: cmpb r2, #^a/ / ; is it a space? beql 35$ ; if so, skip tstb r2 ; is it a null? beql 35$ ; if so, skip cmpb r2, #ht ; is it a tab? beql 35$ ; if so, skip movb r2, -(sp) ; not a tab, null, space: save it! incl r9 ; one more char in the string 35$: sobgtr r10, 30$ ; loop until done movl sp, r10 ; save the stack pointer bicl #3, sp ; longword align the stack pushl r10 ; build the new descriptor pushl r9 ; ..include the length movl sp, r11 ; save a ptr to this new string 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 ; 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 cmpb #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!