1 /* *********************************************************** 2 * * 3 * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4 * * 5 * Copyright (c) 1972 by Massachusetts Institute of * 6 * Technology and Honeywell Information Systems, Inc. * 7 * * 8 *********************************************************** */ 9 10 11 12 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 13 /* */ 14 /* N^H__^Ha_^Hm_^He: equal_ */ 15 /* */ 16 /* This program provides an interface between the obsolete routine, equal_, and */ 17 /* the routine which has replaced it, get_equal_name_. equal_ scans its character string */ 18 /* arguments to compute their length, according to the algorithm: */ 19 /* */ 20 /* do Larg = 1 to 32 while (substr (arg, Larg, 1) ^= " "); */ 21 /* end; */ 22 /* Larg = Larg - 1; */ 23 /* */ 24 /* and then calls get_equal_name_ with these arguments, and returns its results. */ 25 /* Eventually, this obsolete routine should be deleted. */ 26 /* */ 27 /* S^H__^Ht_^Ha_^Ht_^Hu_^Hs */ 28 /* */ 29 /* 0) Created: July, 1973 by G. C. Dixon */ 30 /* */ 31 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 32 33 equal_: procedure (Pentry, Pequal, Ptarget, code); 34 35 dcl Pentry ptr, /* ptr to an entry name of 32 or fewer chars.(In) */ 36 Pequal ptr, /* ptr to an equal name of 32 or fewer chars.(In) */ 37 Ptarget ptr, /* ptr to a target name of 32 chars.(In) */ 38 code fixed bin(35); /* a status code. */ 39 40 dcl Lentry fixed bin, /* length of entry name. */ 41 Lequal fixed bin, /* length of equal name. */ 42 entry char(Lentry) based (Pentry), 43 equal char(Lequal) based (Pequal), 44 (error_table_$bad_equal_name, 45 error_table_$badequal) fixed bin(35) ext static, 46 get_equal_name_ entry (char(*), char(*), char(*), fixed bin(35)), 47 substr builtin, 48 target char(32) based (Ptarget); 49 50 do Lentry = 1 to 32 while (substr (entry, Lentry, 1) ^= " "); 51 end; 52 Lentry = Lentry - 1; 53 do Lequal = 1 to 32 while (substr (equal, Lequal, 1) ^= " "); 54 end; 55 Lequal = Lequal - 1; 56 call get_equal_name_ (entry, equal, target, code); 57 if code = error_table_$bad_equal_name then 58 code = error_table_$badequal; 59 60 end equal_;