1 /* ***********************************************************
2 * *
3 * *
4 * Copyright, C Honeywell Information Systems Inc., 1981 *
5 * *
6 * *
7 *********************************************************** */
8
9 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */
10 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */
11 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */
12 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */
13
14 xdw_defaults_: procedure;
15
16 /* automatic */
17
18 dcl code fixed binary 35;
19 dcl wdir char 168;
20
21 dcl 1 cdsa aligned like cds_args;
22
23 dcl 1 lists aligned,
24 2 xdw,
25 3 name_count fixed binary,
26 3 path_count fixed binary,
27 3 names 1 char 32,
28 3 paths 2 like search_path;
29
30 /* based */
31
32 dcl 1 search_path based,
33 2 type fixed binary,
34 2 pathname char 168;
35
36 dcl addr hbound null size unspec builtin;
37
38 /* entry */
39
40 dcl com_err_ entry options variable;
41 dcl create_data_segment_ entry pointer fixed binary 35;
42 dcl get_wdir_ entry returns char 168;
43 ^L
44 %include sl_info;
45 %include cds_args;
46 ^L
47 /* program */
48
49 lists.xdw.name_count = hbound lists.xdw.names 1;
50 lists.xdw.path_count = hbound lists.xdw.paths 1;
51 lists.xdw.names 1 = "xdw";
52 lists.xdw.paths 1.type = REFERENCING_DIR;
53 lists.xdw.paths 1.pathname = "-referencing_dir";
54 lists.xdw.paths 2.type = WORKING_DIR;
55 lists.xdw.paths 2.pathname = "-working_dir";
56
57 unspec cdsa = ""b;
58 cdsa.sections 1.p = addr lists;
59 cdsa.sections 1.len = size lists;
60 cdsa.sections 1.struct_name = "lists";
61 cdsa.sections 2.p = null;
62 cdsa.sections 2.struct_name = "";
63 cdsa.seg_name = "xdw_defaults_";
64 cdsa.exclude_array_ptr = null;
65 cdsa.switches.have_text = "1"b;
66
67 call create_data_segment_ addr cdsa code;
68 if code ^= 0
69 then do;
70 call com_err_ code "xdw_defaults_";
71 return;
72 end;
73
74 wdir = get_wdir_ ;
75
76 call add_search_names lists.xdw.names *;
77
78 return;
79
80 add_search_names: proc name_array;
81
82 dcl name_array dimension * char 32 aligned parameter;
83
84 dcl hbound builtin;
85 dcl lbound builtin;
86
87 dcl error_table_$segnamedup fixed bin 35 ext static;
88
89 dcl hcs_$chname_file entry char * char * char * char *
90 fixed bin 35;
91
92 dcl i fixed bin;
93 dcl extra_name char 32;
94
95 do i = lbound name_array 1 to hbound name_array 1;
96 extra_name = rtrim name_array i || ".search";
97 call hcs_$chname_file wdir "xdw_defaults_" "" extra_name code;
98 if code ^= 0
99 then if code ^= error_table_$segnamedup
100 then call com_err_ code "xdw_defaults_" "Adding name ^a"
101 extra_name;
102 end;
103
104 return;
105 end add_search_names;
106
107 end xdw_defaults_;