; 0001 0 module set_file_overide (main=main, ; 0002 0 addressing_mode(external=general)) = ; 0003 1 begin ; 0004 1 ; 0005 1 !+ ; 0006 1 ! Abstract: ; 0007 1 ! ; 0008 1 ! This procedure set the ownership of a file while the ; 0009 1 ! file has been locked by another user. ; 0010 1 !- ; 0011 1 library 'sys$library:starlet'; ; 0012 1 library 'sys$library:tpamac'; ; 0013 1 ; 0014 1 own ; 0015 1 converted_uic; ! Converted UIC value ; 0016 1 ; 0017 1 external routine ; 0018 1 lib$find_file, ! Find the full name of a file. ; 0019 1 lib$find_file_end, ! End the context for a lib$find_file ; 0020 1 cli$present, ! Verify the existance of an entity. ; 0021 1 cli$get_value, ! Get the value of that entity. ; 0022 1 lib$tparse; ! For parsing the UIC. ; 0023 1 ; 0024 1 forward routine ; 0025 1 main , ! Main entry point. Errors are signaled. ; 0026 1 get_cli, ! Get the command argument ; 0027 1 set_file, ! set the file information. ; 0028 1 parse_uic; ! Parse out the UIC given by the user. ; 0029 1 ; 0030 1 routine main = ; 0031 1 !+ ; 0032 1 ! This routine is the main control. It calls the various other routines ; 0033 1 ! to parse and then affect the other file attributes. ; 0034 1 ! ; 0035 1 ! Inputs: ; 0036 1 ! ; 0037 1 ! None. ; 0038 1 ! ; 0039 1 ! Outputs: ; 0040 1 ! ; 0041 1 ! None. ; 0042 1 ! ; 0043 1 ! Returns: ; 0044 1 ! ; 0045 1 ! Status from all other functions. ; 0046 1 ! ; 0047 1 !- ; 0048 2 begin ; 0049 2 ; 0050 2 local ; 0051 2 status, ; 0052 2 file_id : $bblock[6], ; 0053 2 uic_value, ; 0054 2 channel; ; 0055 2 ; 0056 2 status = get_cli(uic_value, channel, file_id[0,0,0,0]); ; 0057 2 if not .status then signal(.status); ; 0058 2 ; 0059 2 if .status then ; 0060 3 begin ; 0061 3 status = set_file(.uic_value, .channel, file_id[0,0,0,0]); ; 0062 3 if not .status then signal(.status); ; 0063 2 end; ; 0064 2 ; 0065 2 return (.status or STS$M_INHIB_MSG); ; 0066 1 end; .TITLE SET_FILE_OVERIDE .PSECT $OWN$,NOEXE,2 ;CONVERTED_UIC U.1: .BLKB 4 ; 00000 .EXTRN LIB$FIND_FILE, LIB$FIND_FILE_END, CLI$PRESENT, CLI$GET_VALUE, LIB$TPARSE .PSECT $CODE$,NOWRT,2 ;MAIN U.2: .WORD ^M ;Save R2,R3 0030 000C 00000 MOVAB G^LIB$SIGNAL, R3 ;LIB$SIGNAL, R3 53 00000000G 00 9E 00002 SUBL2 #16, SP ;#16, SP 5E 10 C2 00009 PUSHAB 8(SP) ;FILE_ID 0056 08 AE 9F 0000C PUSHAB 4(SP) ;CHANNEL 04 AE 9F 0000F PUSHAB 12(SP) ;UIC_VALUE 0C AE 9F 00012 CALLS #3, W^U.3 ;#3, U.3 0000V CF 03 FB 00015 MOVL R0, R2 ;R0, STATUS 52 50 D0 0001A BLBS R2, 1$ ;STATUS, 1$ 0057 08 52 E8 0001D PUSHL R2 ;STATUS 52 DD 00020 CALLS #1, (R3) ;#1, LIB$SIGNAL 63 01 FB 00022 BLBC R2, 2$ ;STATUS, 2$ 0059 19 52 E9 00025 1$: PUSHAB 8(SP) ;FILE_ID 0061 08 AE 9F 00028 PUSHL 4(SP) ;CHANNEL 04 AE DD 0002B PUSHL 12(SP) ;UIC_VALUE 0C AE DD 0002E CALLS #3, W^U.4 ;#3, U.4 0000V CF 03 FB 00031 MOVL R0, R2 ;R0, STATUS 52 50 D0 00036 BLBS R2, 2$ ;STATUS, 2$ 0062 05 52 E8 00039 PUSHL R2 ;STATUS 52 DD 0003C CALLS #1, (R3) ;#1, LIB$SIGNAL 63 01 FB 0003E 2$: BISL3 #268435456, R2, R0 ;#268435456, STATUS, R0 0065 52 10000000 8F C9 00041 ; 50 00048 RET ; 04 00049 ; Routine Size: 74 bytes, Routine Base: $CODE$ + 0000 ; 0067 1 ; 0068 1 routine get_cli (uic : ref vector[1,long], ; 0069 1 channel : ref vector[1,long], ; 0070 1 fid : ref $bblock) = ; 0071 1 !+ ; 0072 1 ! This routine obtains parameters from the command line and converts ; 0073 1 ! them into something useful for the ACP to use. ; 0074 1 ! ; 0075 1 ! Inputs: ; 0076 1 ! ; 0077 1 ! UIC: Address of a longword receive the value of the cli UIC ; 0078 1 ! channel:Address of a longword to receive the disk channel ; 0079 1 ! FID: Address of a block to recieve the file identification. ; 0080 1 ! ; 0081 1 ! Implied Inputs: ; 0082 1 ! ; 0083 1 ! From the users CLI, get the command line file name and UIC ; 0084 1 ! ; 0085 1 ! Outputs: ; 0086 1 ! ; 0087 1 ! Input values are filled in by this routine. ; 0088 1 ! ; 0089 1 ! returns: ; 0090 1 ! ; 0091 1 ! SS$_NORMAL, any status from CLI$GET_VALUE, LIB$ and $ASCTOID ; 0092 1 ! ; 0093 1 !- ; 0094 2 begin ; 0095 2 ; 0096 2 bind file_name_d = $descriptor('FILE_NAME'), ; 0097 2 uic_string_d = $descriptor('OWNER_UIC'); ; 0098 2 local ; 0099 2 status, ; 0100 2 iosb: vector[4,word], ; 0101 2 context, ; 0102 2 file_name : $bblock[dsc$k_d_bln], ; 0103 2 full_file_name: $bblock[dsc$k_d_bln], ; 0104 2 uic_string : $bblock[dsc$k_d_bln], ; 0105 2 disk_name : $bblock[dsc$k_d_bln], ; 0106 2 result_string : $bblock[nam$c_maxrss], ; 0107 2 fab: $bblock[fab$c_bln], ! Allocate a $FAB structure. ; 0108 2 nam: $bblock[nam$c_bln]; ! Allocate a $NAM structure. ; 0109 2 ; 0110 2 $init_dyndesc(file_name); ; 0111 2 $init_dyndesc(full_file_name); ; 0112 2 $init_dyndesc(uic_string); ; 0113 2 !+ ; 0114 2 ! Get the value of the command line parameters. ; 0115 2 !- ; 0116 3 if not (status = cli$get_value(file_name_d, file_name)) ; 0117 2 then return .status; ; 0118 3 if not (status = cli$get_value(uic_string_d, uic_string)) ; 0119 2 then ; 0120 3 begin ; 0121 3 local ; 0122 3 itmlst : $itmlst_decl(), ; 0123 3 my_uic; ; 0124 3 ! ; 0125 3 ! Since we did not specify an owner, assume us. ; 0126 3 ! ; P 0127 3 $itmlst_init(itmlst=itmlst, ; 0128 3 (itmcod=jpi$_uic, bufadr=.uic)); ; P 0129 3 status = $getjpiw(itmlst = itmlst, ; P 0130 3 iosb=iosb ; 0131 3 ); ; 0132 3 if .status then status = .iosb[0]; ; 0133 3 end ; 0134 2 else ; 0135 2 status = parse_uic(uic_string, .uic); ; 0136 2 ; 0137 2 if not .status then return .status; ; 0138 2 !+ ; 0139 2 ! Get the full file spec from lib$find_file and pass it to ; 0140 2 ! SYS$PARSE to get a DISK to assign a channel against. ; 0141 2 ! Then get the FID of the file we want to open. ; 0142 2 !- ; 0143 3 if not (status = lib$find_file(file_name, full_file_name, context)) ; 0144 2 then return .status; ; 0145 2 lib$find_file_end(context); ; P 0146 2 $fab_init(fab=fab, ! Initialize the structures ; P 0147 2 fns=.full_file_name[dsc$w_length], ; P 0148 2 fna=.full_file_name[dsc$a_pointer], ; 0149 2 nam=nam); ; P 0150 2 $nam_init(nam=nam, ess=nam$c_maxrss, esa=result_string, ; 0151 2 rss=nam$c_maxrss, rsa=result_string); ; 0152 3 if not (status = $parse(fab=fab)) ; 0153 2 then return .status; ; 0154 2 ; 0155 3 if not (status = $search(fab=fab)) ; 0156 2 then return .status; ; 0157 2 ; 0158 2 fid[fid$w_num] = .nam[nam$w_fid_num]; ; 0159 2 fid[fid$w_seq] = .nam[nam$w_fid_seq]; ; 0160 2 fid[fid$w_rvn] = .nam[nam$w_fid_rvn]; ; 0161 2 ; 0162 2 !+ ; 0163 2 ! Now create a string descriptor of the disk name ; 0164 2 ! and assign a channel to that disk. ; 0165 2 !- ; 0166 2 disk_name[dsc$b_dtype] = dsc$k_dtype_t; ; 0167 2 disk_name[dsc$b_class] = dsc$k_class_s; ; 0168 2 disk_name[dsc$w_length] = .nam[nam$b_dev]; ; 0169 2 disk_name[dsc$a_pointer] = .nam[nam$l_dev]; ; 0170 2 ; 0171 2 return $assign(devnam=disk_name, chan=.channel); ; 0172 2 ; 0173 1 end; .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAB: .ASCII \FILE_NAME\ ; 4D 41 4E 5F 45 4C 49 46 00000 ; 45 00008 .BLKB 3 ; 00009 P.AAA: .LONG 9 ; 00000009 0000C .ADDRESS P.AAB ; 00000000' 00010 P.AAD: .ASCII \OWNER_UIC\ ; 49 55 5F 52 45 4E 57 4F 00014 ; 43 0001C .BLKB 3 ; 0001D P.AAC: .LONG 9 ; 00000009 00020 .ADDRESS P.AAD ; 00000000' 00024 U.6= P.AAA U.7= P.AAC .EXTRN SYS$GETJPIW, SYS$PARSE, SYS$SEARCH, SYS$ASSIGN .PSECT $CODE$,NOWRT,2 ;GET_CLI U.3: .WORD ^M ;Save R2,R3,R4,R5,R6,R7 0068 00FC 00000 MOVAB G^CLI$GET_VALUE, R7 ;CLI$GET_VALUE, R7 57 00000000G 00 9E 00002 MOVAB -492(SP), SP ;-492(SP), SP 5E FE14 CE 9E 00009 MOVL #34471936, -16(FP) ;#34471936, _D 0110 F0 AD 020E0000 8F D0 0000E CLRL -12(FP) ;_D+4 F4 AD D4 00016 MOVL #34471936, -24(FP) ;#34471936, _D 0111 E8 AD 020E0000 8F D0 00019 CLRL -20(FP) ;_D+4 EC AD D4 00021 MOVL #34471936, -32(FP) ;#34471936, _D 0112 E0 AD 020E0000 8F D0 00024 CLRL -28(FP) ;_D+4 E4 AD D4 0002C PUSHAB -16(FP) ;FILE_NAME 0116 F0 AD 9F 0002F PUSHAB W^U.6 ;U.6 0000' CF 9F 00032 CALLS #2, (R7) ;#2, CLI$GET_VALUE 67 02 FB 00036 MOVL R0, R6 ;R0, STATUS 56 50 D0 00039 BLBC R6, 3$ ;STATUS, 3$ 63 56 E9 0003C PUSHAB -32(FP) ;UIC_STRING 0118 E0 AD 9F 0003F PUSHAB W^U.7 ;U.7 0000' CF 9F 00042 CALLS #2, (R7) ;#2, CLI$GET_VALUE 67 02 FB 00046 MOVL R0, R6 ;R0, STATUS 56 50 D0 00049 BLBS R6, 1$ ;STATUS, 1$ 30 56 E8 0004C MOVAB 4(SP), R0 ;ITMLST, $$ITMBLKPTR 0128 50 04 AE 9E 0004F MOVL #50593796, (R0)+ ;#50593796, ($$ITMBLKPTR)+ 80 03040004 8F D0 00053 MOVL 4(AP), (R0)+ ;UIC, ($$ITMBLKPTR)+ 80 04 AC D0 0005A CLRQ (R0)+ ;($$ITMBLKPTR)+ 80 7C 0005E CLRQ -(SP) ;-(SP) 0130 7E 7C 00060 PUSHAB -8(FP) ;IOSB F8 AD 9F 00062 PUSHAB 16(SP) ;ITMLST 10 AE 9F 00065 CLRQ -(SP) ;-(SP) 7E 7C 00068 CLRL -(SP) ;-(SP) 7E D4 0006A CALLS #7, G^SYS$GETJPIW ;#7, SYS$GETJPIW 00000000G 00 07 FB 0006C MOVL R0, R6 ;R0, STATUS 56 50 D0 00073 BLBC R6, 3$ ;STATUS, 3$ 0132 29 56 E9 00076 MOVZWL -8(FP), R6 ;IOSB, STATUS 56 F8 AD 3C 00079 BRB 2$ ;2$ 0E 11 0007D 1$: PUSHL 4(AP) ;UIC 0135 04 AC DD 0007F PUSHAB -32(FP) ;UIC_STRING E0 AD 9F 00082 CALLS #2, W^U.5 ;#2, U.5 0000V CF 02 FB 00085 MOVL R0, R6 ;R0, STATUS 56 50 D0 0008A 2$: BLBC R6, 4$ ;STATUS, 4$ 0137 79 56 E9 0008D PUSHL SP ;SP 0143 5E DD 00090 PUSHAB -24(FP) ;FULL_FILE_NAME E8 AD 9F 00092 PUSHAB -16(FP) ;FILE_NAME F0 AD 9F 00095 CALLS #3, G^LIB$FIND_FILE ;#3, LIB$FIND_FILE 00000000G 00 03 FB 00098 MOVL R0, R6 ;R0, STATUS 56 50 D0 0009F 3$: BLBC R6, 5$ ;STATUS, 5$ 77 56 E9 000A2 PUSHL SP ;SP 0145 5E DD 000A5 CALLS #1, G^LIB$FIND_FILE_END ;#1, LIB$FIND_FILE_END 00000000G 00 01 FB 000A7 MOVC5 #0, (SP), #0, #80, 116(SP) ;#0, (SP), #0, #80, $RMS_PTR 0149 6E 00 2C 000AE ; 0050 8F 00 000B1 ; 74 AE 000B5 MOVW #20483, 116(SP) ;#20483, $RMS_PTR 74 AE 5003 8F B0 000B7 MOVB #2, 138(SP) ;#2, $RMS_PTR+22 008A CE 02 90 000BD MOVB #2, 147(SP) ;#2, $RMS_PTR+31 0093 CE 02 90 000C2 MOVAB 20(SP), 156(SP) ;NAM, $RMS_PTR+40 009C CE 14 AE 9E 000C7 MOVL -20(FP), 160(SP) ;FULL_FILE_NAME+4, $RMS_PTR+44 00A0 CE EC AD D0 000CD MOVB -24(FP), 168(SP) ;FULL_FILE_NAME, $RMS_PTR+52 00A8 CE E8 AD 90 000D3 MOVC5 #0, (SP), #0, #96, 20(SP) ;#0, (SP), #0, #96, $RMS_PTR 0151 6E 00 2C 000D9 ; 0060 8F 00 000DC ; 14 AE 000E0 MOVW #24578, 20(SP) ;#24578, $RMS_PTR 14 AE 6002 8F B0 000E2 MNEGB #1, 22(SP) ;#1, $RMS_PTR+2 16 AE 01 8E 000E8 MOVAB 196(SP), 24(SP) ;RESULT_STRING, $RMS_PTR+4 18 AE 00C4 CE 9E 000EC MNEGB #1, 30(SP) ;#1, $RMS_PTR+10 1E AE 01 8E 000F2 MOVAB 196(SP), 32(SP) ;RESULT_STRING, $RMS_PTR+12 20 AE 00C4 CE 9E 000F6 PUSHAB 116(SP) ;FAB 0152 74 AE 9F 000FC CALLS #1, G^SYS$PARSE ;#1, SYS$PARSE 00000000G 00 01 FB 000FF MOVL R0, R6 ;R0, STATUS 56 50 D0 00106 4$: BLBC R6, 5$ ;STATUS, 5$ 10 56 E9 00109 PUSHAB 116(SP) ;FAB 0155 74 AE 9F 0010C CALLS #1, G^SYS$SEARCH ;#1, SYS$SEARCH 00000000G 00 01 FB 0010F MOVL R0, R6 ;R0, STATUS 56 50 D0 00116 BLBS R6, 6$ ;STATUS, 6$ 04 56 E8 00119 5$: MOVL R6, R0 ;STATUS, R0 0156 50 56 D0 0011C RET ; 04 0011F 6$: MOVL 12(AP), R0 ;FID, R0 0158 50 0C AC D0 00120 MOVL 56(SP), (R0) ;NAM+36, (R0) 0159 60 38 AE D0 00124 MOVW 60(SP), 4(R0) ;NAM+40, 4(R0) 0160 04 A0 3C AE B0 00128 MOVW #270, -38(FP) ;#270, DISK_NAME+2 0167 DA AD 010E 8F B0 0012D MOVZBW 77(SP), -40(FP) ;NAM+57, DISK_NAME 0168 D8 AD 4D AE 9B 00133 MOVL 88(SP), -36(FP) ;NAM+68, DISK_NAME+4 0169 DC AD 58 AE D0 00138 CLRQ -(SP) ;-(SP) 0171 7E 7C 0013D PUSHL 8(AP) ;CHANNEL 08 AC DD 0013F PUSHAB -40(FP) ;DISK_NAME D8 AD 9F 00142 CALLS #4, G^SYS$ASSIGN ;#4, SYS$ASSIGN 00000000G 00 04 FB 00145 RET ; 04 0014C ; Routine Size: 333 bytes, Routine Base: $CODE$ + 004A ; 0174 1 ; 0175 1 routine set_file(uic, channel, fid : ref $bblock) = ; 0176 1 !+ ; 0177 1 ! Given the input file channel and the FID ; 0178 1 ! this routine sets the file withthe value of the UIC. ; 0179 1 ! ; 0180 1 ! Inputs: ; 0181 1 ! ; 0182 1 ! UIC: longword containg the UIC of the file. ; 0183 1 ! Channel: longword containing the channel of the disk ; 0184 1 ! Fid: Address of a FID block contianign the file id. ; 0185 1 ! ; 0186 1 ! Outputs: ; 0187 1 ! ; 0188 1 ! None ; 0189 1 ! ; 0190 1 ! Returns: ; 0191 1 ! ; 0192 1 ! Normal system service values or SS$_NORMAL ; 0193 1 !- ; 0194 2 begin ; 0195 2 local ; 0196 2 status, ; 0197 2 iosb : vector[4, word], ; 0198 2 atr_list : $bblock[1*8+4], ; 0199 2 fib : $bblock[fib$k_length], ; 0200 2 fib_desc : vector[2] initial (long (fib$k_length, fib)); ; 0201 2 ; 0202 2 ch$fill(0, fib$k_length, fib); ! Clear the FIB block ; 0203 2 ; 0204 2 fib[fib$l_acctl] = FIB$M_WRITE OR FIB$M_NOLOCK; ; 0205 2 FIB[FIB$W_FID_NUM] = .FID[FID$W_NUM]; ; 0206 2 FIB[FIB$W_FID_SEQ] = .FID[FID$W_SEQ]; ; 0207 2 FIB[FIB$W_FID_RVN] = .FID[FID$W_RVN]; ; 0208 2 ; 0209 2 ATR_LIST [ATR$W_SIZE] = ATR$S_UIC; ; 0210 2 ATR_LIST [ATR$W_TYPE] = ATR$C_UIC; ; 0211 2 ATR_LIST [ATR$L_ADDR] = UIC; ; 0212 2 ATR_LIST [8, 0, 32, 0] = 0; ! End of list ; 0213 2 !+ ; 0214 2 ! Open the file to gain access. ; 0215 2 !- ; P 0216 2 status = $qiow(chan=.channel, ; P 0217 2 func=io$_access or io$m_access, ; P 0218 2 iosb=iosb, ; 0219 2 p1=fib_desc); ; 0220 2 if .status then status = .iosb[0]; ; 0221 2 if not .status then return .status; ; 0222 2 !+ ; 0223 2 ! Change the attribute on the deaccess of the file. ; 0224 2 !- ; P 0225 2 status = $qiow(chan=.channel, ; P 0226 2 func=io$_deaccess, ; P 0227 2 iosb=iosb, ; P 0228 2 p1=fib_desc, ; 0229 2 p5=atr_list); ; 0230 2 if .status then status = .iosb[0]; ; 0231 2 if not .status then return .status; ; 0232 2 ; 0233 2 return $dassgn(chan=.channel); ; 0234 2 ; 0235 2 ; 0236 1 end; .EXTRN SYS$QIOW, SYS$DASSGN ;SET_FILE U.4: .WORD ^M ;Save R2,R3,R4,R5,R6 0175 007C 00000 MOVAB G^SYS$QIOW, R6 ;SYS$QIOW, R6 56 00000000G 00 9E 00002 MOVAB -88(SP), SP ;-88(SP), SP 5E A8 AE 9E 00009 MOVZBL #64, -(SP) ;#64, FIB_DESC 0200 7E 40 8F 9A 0000D MOVAB 8(SP), 4(SP) ;FIB, FIB_DESC+4 04 AE 08 AE 9E 00011 MOVC5 #0, (SP), #0, #64, 8(SP) ;#0, (SP), #0, #64, FIB 0202 6E 00 2C 00016 ; 0040 8F 00 00019 ; 08 AE 0001D MOVL #1048832, 8(SP) ;#1048832, FIB 0204 08 AE 00100100 8F D0 0001F MOVL 12(AP), R0 ;FID, R0 0205 50 0C AC D0 00027 MOVL (R0), 12(SP) ;(R0), FIB+4 0206 0C AE 60 D0 0002B MOVW 4(R0), 16(SP) ;4(R0), FIB+8 0207 10 AE 04 A0 B0 0002F MOVL #1376260, 72(SP) ;#1376260, ATR_LIST 0210 48 AE 00150004 8F D0 00034 MOVAB 4(AP), 76(SP) ;UIC, ATR_LIST+4 0211 4C AE 04 AC 9E 0003C CLRL 80(SP) ;ATR_LIST+8 0212 50 AE D4 00041 CLRQ -(SP) ;-(SP) 0219 7E 7C 00044 CLRQ -(SP) ;-(SP) 7E 7C 00046 CLRL -(SP) ;-(SP) 7E D4 00048 PUSHAB 20(SP) ;FIB_DESC 14 AE 9F 0004A CLRQ -(SP) ;-(SP) 7E 7C 0004D PUSHAB 116(SP) ;IOSB 74 AE 9F 0004F MOVZBL #114, -(SP) ;#114, -(SP) 7E 72 8F 9A 00052 PUSHL 8(AP) ;CHANNEL 08 AC DD 00056 CLRL -(SP) ;-(SP) 7E D4 00059 CALLS #12, (R6) ;#12, SYS$QIOW 66 0C FB 0005B BLBC R0, 1$ ;STATUS, 1$ 0220 36 50 E9 0005E MOVZWL 84(SP), R0 ;IOSB, STATUS 50 54 AE 3C 00061 BLBC R0, 1$ ;STATUS, 1$ 0221 2F 50 E9 00065 CLRL -(SP) ;-(SP) 0229 7E D4 00068 PUSHAB 76(SP) ;ATR_LIST 4C AE 9F 0006A CLRQ -(SP) ;-(SP) 7E 7C 0006D CLRL -(SP) ;-(SP) 7E D4 0006F PUSHAB 20(SP) ;FIB_DESC 14 AE 9F 00071 CLRQ -(SP) ;-(SP) 7E 7C 00074 PUSHAB 116(SP) ;IOSB 74 AE 9F 00076 PUSHL #52 ;#52 34 DD 00079 PUSHL 8(AP) ;CHANNEL 08 AC DD 0007B CLRL -(SP) ;-(SP) 7E D4 0007E CALLS #12, (R6) ;#12, SYS$QIOW 66 0C FB 00080 BLBC R0, 1$ ;STATUS, 1$ 0230 11 50 E9 00083 MOVZWL 84(SP), R0 ;IOSB, STATUS 50 54 AE 3C 00086 BLBC R0, 1$ ;STATUS, 1$ 0231 0A 50 E9 0008A PUSHL 8(AP) ;CHANNEL 0233 08 AC DD 0008D CALLS #1, G^SYS$DASSGN ;#1, SYS$DASSGN 00000000G 00 01 FB 00090 1$: RET ; 04 00097 ; Routine Size: 152 bytes, Routine Base: $CODE$ + 0197 ; 0237 1 ; 0238 1 !+ ; 0239 1 ! Lib$Tparse macros (Code obtained from [CLIUTL]UTILSUBS.B32) ; 0240 1 !- ; 0241 1 ; 0242 1 !+ ; 0243 1 ! Parse the UIC string and store the binary value. ; 0244 1 !- ; 0245 1 $INIT_STATE (UIC_STB, UIC_KTB); ; 0246 1 ; P 0247 1 $STATE (, ; P 0248 1 (TPA$_IDENT,,,,CONVERTED_UIC) ; 0249 1 ); ; P 0250 1 $STATE (, ; P 0251 1 (TPA$_EOS,TPA$_EXIT) ; 0252 1 ); ; 0253 1 ; 0254 1 ROUTINE parse_uic (desc, uic) = ; 0255 2 BEGIN ; 0256 2 ; 0257 2 !+ ; 0258 2 ! ; 0259 2 ! This routine takes an ASCII string of the form [m,n] and attempts to parse ; 0260 2 ! the pieces into a longword UIC. If any errors are detected, an error is ; 0261 2 ! returned. ; 0262 2 ! ; 0263 2 ! Inputs ; 0264 2 ! DESC - address of ASCII descriptor of UIC string ; 0265 2 ! ; 0266 2 ! Outputs ; 0267 2 ! UIC - the longword representation is returned here. ; 0268 2 ! ; 0269 2 !- ; 0270 2 ; 0271 2 MAP ; 0272 2 desc : REF $BBLOCK, ; 0273 2 uic : REF VECTOR; ; 0274 2 ; 0275 2 LOCAL ; 0276 2 TPARSE_BLOCK : $BBLOCK [TPA$K_LENGTH0] ! TPARSE ; 0277 2 INITIAL (TPA$K_COUNT0, ! PARAMETER ; 0278 2 TPA$M_BLANKS OR ! BLOCK ; 0279 2 TPA$M_ABBREV), ; 0280 2 STATUS; ! Routine return status ; 0281 2 ; 0282 2 TPARSE_BLOCK[TPA$L_STRINGCNT] = .DESC[DSC$W_LENGTH]; ; 0283 2 TPARSE_BLOCK[TPA$L_STRINGPTR] = .DESC[DSC$A_POINTER]; ; 0284 2 ; 0285 3 IF NOT (STATUS = LIB$TPARSE (TPARSE_BLOCK, UIC_STB, UIC_KTB)) ; 0286 2 THEN RETURN .STATUS; ; 0287 2 ; 0288 2 UIC[0] = .CONVERTED_UIC; ! MAKE THE UIC LONGWORD ; 0289 2 ; 0290 2 RETURN 1; ; 0291 1 END; .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAE: .LONG 8, 3 ; 00000003 00000008 00028 .PSECT _LIB$KEY0$,NOWRT, SHR, PIC,1 UIC_KTB:: .BLKB 0 ; 00000 ;TPA$KEY0 U.14: .BLKB 0 ; 00000 .PSECT _LIB$STATE$,NOWRT, SHR, PIC,1 UIC_STB:: .BLKB 0 ; 00000 ;TPA$TYPE U.16: .WORD 17900 ; 45EC 00000 ;TPA$ADDR U.17: .LONG <-4> ; 00000000* 00002 ;TPA$TYPE U.18: .WORD 5623 ; 15F7 00006 ;TPA$TARGET U.19: .WORD -1 ; FFFF 00008 .PSECT $CODE$,NOWRT,2 ;PARSE_UIC U.5: .WORD ^M ;Save R2,R3,R4,R5 0254 003C 00000 SUBL2 #36, SP ;#36, SP 5E 24 C2 00002 MOVC5 #8, W^P.AAE, #0, #36, (SP) ;#8, P.AAE, #0, #36, TPARSE_BLOCK 0279 0000' CF 08 2C 00005 ; 24 00 0000A ; 6E 0000C MOVL 4(AP), R0 ;DESC, R0 0282 50 04 AC D0 0000D MOVZWL (R0), 8(SP) ;(R0), TPARSE_BLOCK+8 08 AE 60 3C 00011 MOVL 4(R0), 12(SP) ;4(R0), TPARSE_BLOCK+12 0283 0C AE 04 A0 D0 00015 PUSHAB W^UIC_KTB ;UIC_KTB 0285 0000' CF 9F 0001A PUSHAB W^UIC_STB ;UIC_STB 0000' CF 9F 0001E PUSHAB 8(SP) ;TPARSE_BLOCK 08 AE 9F 00022 CALLS #3, G^LIB$TPARSE ;#3, LIB$TPARSE 00000000G 00 03 FB 00025 BLBC R0, 1$ ;STATUS, 1$ 09 50 E9 0002C MOVL W^U.1, @8(AP) ;U.1, @UIC 0288 08 BC 0000' CF D0 0002F MOVL #1, R0 ;#1, R0 0290 50 01 D0 00035 1$: RET ; 04 00038 ; Routine Size: 57 bytes, Routine Base: $CODE$ + 022F ; 0292 1 ; 0293 1 ; 0294 1 end ; 0295 0 eludom .EXTRN LIB$SIGNAL ; PSECT SUMMARY ; ; Name Bytes Attributes ; ; $OWN$ 4 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $CODE$ 616 NOVEC,NOWRT, RD , EXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $PLIT$ 48 NOVEC,NOWRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; _LIB$KEY0$ 0 NOVEC,NOWRT, RD , EXE, SHR, LCL, REL, CON, PIC,ALIGN(1) ; _LIB$STATE$ 10 NOVEC,NOWRT, RD , EXE, SHR, LCL, REL, CON, PIC,ALIGN(1) ; Library Statistics ; ; -------- Symbols -------- Pages Processing ; File Total Loaded Percent Mapped Time ; ; SYS$COMMON:[SYSLIB]STARLET.L32;1 14000 112 0 813 00:00.6 ; SYS$COMMON:[SYSLIB]TPAMAC.L32;1 43 20 46 15 00:00.1 ; COMMAND QUALIFIERS ; BLISS OWNER/MAC=(ASS,UNIQ)/LIS/SOURCE=NOHEAD ; Compilation Complete .END U.2