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_;