1 
  2 /****^  HISTORY COMMENTS:
  3   1) change(2019-08-17,GDixon), approve(2019-10-25,MCR10069),
  4      audit(2020-01-20,Swenson), install(2020-01-20,MR12.6g-0035):
  5      Command/AF to display pathnames for items in Multics Libraries (or current
  6      library descriptor) as seen by the mbuild Subsystem.  An mbuild equivalent
  7      of the library_pathname command. Also implements the mbuild subsystem
  8      request:  library_pathname (lpn)
  9                                                    END HISTORY COMMENTS */
 10 
 11 mbuild_lpn:
 12 mblpn:
 13      proc options(variable);
 14 
 15 
 16 display_usage:
 17           proc;
 18 
 19           call ioa_ ("^(^a^)",
 20 "Syntax as a command:  mblpn {-lb library_name} star_name
 21 
 22 
 23 Syntax as an active function:  [mblpn {-lb library_name} star_name]
 24 ");
 25           goto EXIT;
 26           end display_usage;
 27 
 28   dcl  ioa_ entry() options(variable);
 29 
 30   dcl (error_table_$bad_arg,
 31        error_table_$badopt,
 32        error_table_$noarg,
 33        error_table_$not_act_fnc,
 34        error_table_$too_many_names) fixed bin(35) ext static;
 35 
 36 %page;
 37 /* ======================================================================
 38  *
 39  * COMMAND/AF:  mbuild_lpn, mblpn
 40  *
 41  * ====================================================================== */
 42 
 43   dcl  PROC    char(10) internal static options(constant) init("mbuild_lpn");
 44   dcl  VERSION char(16) internal static options(constant) init("mbuild_lpn___1.0");
 45 
 46   dcl 1 C aligned,                                          /* Structure to hold control information.                 */
 47       2 sciP ptr,                                           /*   ssu_ invocation pointer.                             */
 48       2 args,
 49         3 name char(32) unal,                               /*   star_name                                            */
 50         3 library char(32) unal;                            /*   -library library_name                                */
 51 
 52                                                             /* Setup cleanup on-unit for ssu_ standalone invocation.  */
 53      isStandalone = T;                                      /*   Command is running as standalone invocation.         */
 54      C.sciP = null();                                       /*   Invocation has not been created yet.                 */
 55      on cleanup call standalone_cleanup_handler(isStandalone, C.sciP);
 56 
 57      call ssu_$standalone_invocation (C.sciP, PROC, VERSION, cu_$arg_list_ptr(), abort_to_EXIT, code);
 58                                                             /* Initialize control data used by command & requests.    */
 59      goto COMMON;
 60 
 61 
 62 /* ======================================================================
 63  *
 64  * REQUEST:  library_pathname, lpn
 65  *
 66  * ====================================================================== */
 67 
 68 lpn_request:
 69      entry (AsciP, AinfoP);
 70 
 71   dcl  AsciP ptr;                                           /* sci_ptr maintained by ssu_                             */
 72   dcl  AinfoP ptr;                                          /* info structure for communicating between requests.     */
 73                                                             /*   This is not used for mbuild_type command or requests.*/
 74      isStandalone = F;
 75      C.sciP = AsciP;
 76      goto COMMON;
 77 
 78 %page;
 79 /* ------------------------------------------------------------
 80  * Setup to process incoming command/request arguments.
 81  * ------------------------------------------------------------ */
 82 
 83 COMMON:
 84      call arg_setup (C.sciP);
 85 
 86      if ^args_remain() then do;                             /* If no args given...                                    */
 87           if isStandalone & ^isAF then                      /*  - command displays usage                              */
 88                call display_usage();
 89 
 90           C.args = "";                                      /*  - AF or ssu_ requests do default action.              */
 91           end;
 92      else call controlArgs(C, 0);                           /* Get seg_name or -control_arg                           */
 93 
 94 /* ------------------------------------------------------------
 95    Process incoming command/request arguments.
 96    ------------------------------------------------------------ */
 97 
 98   dcl  paths (1000) char(200) var;                          /* Array of paths matching starname found in libraries.   */
 99   dcl  pathsN fixed bin;                                    /* Number of paths actually returned.                     */
100   dcl  pathI fixed bin;
101 
102   dcl  mbuild_library_$library_directories entry (char(*) var, (*) char(200) var, fixed bin, fixed bin(35));
103 
104      if C.library = "" then
105           C.library = "**";
106      else do;                                               /* Validate -lb operand                                   */
107           call mbuild_library_$library_directories ((C.library), paths, pathsN, code);
108           if code ^= 0 | pathsN = 0 then
109                call ssu_$abort_line (C.sciP, code, "^[Unknown Multics Library ^]-lb ^a",
110                     (pathsN = 0 & code = error_table_$bad_arg), C.library);
111           end;
112 
113   dcl  mbuild_library_$search entry (char(*) var, char(*) var, (*) char(200) var, fixed bin, fixed bin(35));
114 
115      call mbuild_library_$search ((C.library), (C.name), paths, pathsN, code);
116      if code ^= 0 then
117           call ssu_$abort_line (C.sciP, code, "Getting paths for: ^[[^]^a -lb ^a ^a^[]^]",
118                isAF, "mblpn", C.library, C.name, isAF);
119 
120      if ^isAF then
121           call ioa_ ("^v(^/^a^)", pathsN, paths) ;
122 
123      else if isAF & code = 0 then do;
124           do pathI = 1 to pathsN;
125                af_ret = af_ret || paths(pathI) || " ";
126                end;
127           end;
128 
129 EXIT:
130      call standalone_cleanup_handler(isStandalone, C.sciP);
131      return;
132 %page;
133 /* ------------------------------------------------------------
134    Process segment_name and -control_arg arguments.
135    ------------------------------------------------------------ */
136 
137 controlArgs:
138      proc (c, code);
139 
140   dcl 1 c aligned like C;                                   /*  control arg specification data                   (in) */
141   dcl  code fixed bin (35);                                 /*  status code, reporting missing arg, conversion        */
142                                                             /*   error, unknown options, etc.                         */
143      c.args = "";
144      code = 0;
145 
146   dcl  next_arg_is_library bit(1) aligned init(F);
147 
148      do while (args_remain());
149           call ssu_$arg_ptr (c.sciP, argI+1, argP, argL);   /* Conditionally read next argument to call command/af.   */
150           if next_arg_is_library then do;
151                c.library = arg;
152                next_arg_is_library = F;
153                end;
154 
155           else if isControlArg(arg) then do;
156 
157                /* Global options */
158                if       arg = "-lb"     | arg = "-library"      then next_arg_is_library = T;
159 
160                else call ssu_$print_message (c.sciP, error_table_$badopt,
161                     "Ignoring unsupported control arg: ^a", arg);
162                end;
163 
164           else c.name = arg;
165 
166           argI = argI + 1;                                  /* Note that we processed the arg just examined above.    */
167           end;
168 
169      end controlArgs;
170 
171 %page;
172 %include ssu_standalone_command_;
173 
174 %page;
175 %include mbuild_info_;
176 
177      end mbuild_lpn;
178 
179