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           /* string           an active function which returns its input arguments, strung together */
 15           /*                  in a quoted character string and separated by blanks.  An arbitrary   */
 16           /*                  number of input arguments can be handled (0 to infinite).  The only   */
 17           /*                  bound on their number of length is the maximum command line size.     */
 18           /*                  When invoked as a command, string has the effect of:                  */
 19           /*                            ioa_ [string ...]                                           */
 20           /*                                                                                        */
 21           /* U^H__^Hs_^Ha_^Hg_^He                                                                                       */
 22           /*                                                                                        */
 23           /*        [string arg1^H_ ... arg_^Hn]                                                    */
 24           /* or      string arg1^H_ ... arg_^Hn                                                     */
 25           /*                                                                                        */
 26           /* 1) arg_^Hi       are optional input arguments which are returned as a single quoted    */
 27           /*                  string.                                                               */
 28           /*                                                                                        */
 29           /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
 30 /* TR7417, call iox_$put_chars only once for command invocation  10/31/80 S. Herbst */
 31 ^L
 32 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 33 
 34 
 35 string:   procedure;                                        /* active function which returns its input args,  */
 36                                                             /* separated by blanks, as a quoted string.       */
 37 
 38      dcl                                                    /*        automatic variables                     */
 39           Larg                          fixed bin (21),     /* length of an input arg.                        */
 40           Lmax                          fixed bin (21),     /* max estimate for string to print               */
 41           Lret                          fixed bin (21),     /* maximum length of our return value.            */
 42           Nargs                         fixed bin,          /* number of arguments we were passed.            */
 43           Parg                          ptr,                /* ptr to an input argument.                      */
 44           Parg_list                     ptr,                /* ptr to the argument list                       */
 45           Pret                          ptr,                /* ptr to our return value.                       */
 46           code                          fixed bin (35),     /* an error code value.                           */
 47           i                             fixed bin;          /* a do-group index.                              */
 48 
 49 
 50      dcl                                                    /*        based variables                         */
 51           arg                           char(Larg) based (Parg),
 52                                                             /* an input argument.                             */
 53           ret                           char(Lret) varying based (Pret);
 54                                                             /* overlay for portions of our return value.      */
 55 
 56 
 57      dcl (addr, addrel, length, search) builtin;
 58 
 59 
 60      dcl                                                    /*        entries                                 */
 61           cu_$af_return_arg             entry (fixed bin, ptr, fixed bin (21), fixed bin(35)),
 62          (cu_$af_arg_ptr,
 63           cu_$arg_ptr)                  entry (fixed bin, ptr, fixed bin (21), fixed bin(35)),
 64           cu_$arg_list_ptr              entry (ptr),
 65           cu_$arg_ptr_rel               entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr),
 66           iox_$put_chars                entry (ptr, ptr, fixed bin, fixed bin(35));
 67 
 68 
 69      dcl                                                    /*        static variables                        */
 70           NL                            char(1) int static init ("
 71 "),
 72           SPACE                         char(1) int static init (" "),
 73           iox_$user_output              ptr ext static;
 74 ^L
 75 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  **  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
 76 
 77 
 78           call cu_$af_return_arg (Nargs, Pret, Lret, code); /* see how we were called.                        */
 79           if code = 0 then do;                              /* as an active function.                         */
 80                if Nargs = 0 then do;                        /* no input args.  Return a null string.          */
 81                     ret = """""";
 82                     return;
 83                     end;
 84                ret = """";
 85                call cu_$af_arg_ptr (1, Parg, Larg, code);   /* add first argument to return string.           */
 86                if search (arg, """") > 0 then
 87                     ret = ret || double_quotes (arg);
 88                else ret = ret || arg;
 89                do i = 2 to Nargs;                           /* add remaining args to return string.           */
 90                     ret = ret || " ";
 91                     call cu_$af_arg_ptr (i, Parg, Larg, code);
 92                     if search (arg, """") > 0 then
 93                          ret = ret || double_quotes (arg);
 94                     else ret = ret || arg;
 95                     end;
 96                ret = ret || """";
 97                end;
 98           else do;                                          /* command merely output's its args, separated by */
 99                Lmax = 1;                                    /* allow for NL always */
100                do i = 1 to Nargs;
101                     call cu_$arg_ptr (i, Parg, Larg, code);
102                     Lmax = Lmax + Larg + 1;
103                end;
104 
105                call cu_$arg_list_ptr (Parg_list);
106 begin;
107 
108 dcl the_string char (Lmax) varying;
109 dcl i fixed bin;
110 
111                the_string = "";
112                do i = 1 to Nargs;
113                     call cu_$arg_ptr_rel (i, Parg, Larg, code, Parg_list);
114                     if i ^= 1 then the_string = the_string || SPACE;
115                     the_string = the_string || arg;
116                end;
117                the_string = the_string || NL;
118                call iox_$put_chars (iox_$user_output, addrel (addr (the_string), 1), length (the_string), code);
119 end;
120                end;
121 ^L
122 double_quotes:      procedure (string) returns (char(*) varying);
123                                                             /* internal procedure to double all quotes in     */
124                                                             /* a "to be quoted" string.                       */
125 
126      dcl  string                        char(*);
127 
128      dcl (i, j)                         fixed bin;
129 
130 
131      dcl  copied_string                 char(length(string)*2) varying;
132 
133      dcl  string_begin                  char(i-1) based (addr(string_array(j))),
134           string_end                    char(length(string)-(j-1)) based(addr(string_array(j))),
135           string_array (length(string)) char(1) based (addr(string));
136 
137           i = search(string,"""");
138           if i = 0 then return(string);
139           j = 1;
140           copied_string = "";
141           do while (i > 0);
142                copied_string = copied_string || string_begin;
143                copied_string = copied_string || """""";
144                j = i+j;
145                i = search (string_end, """");
146                end;
147           copied_string = copied_string || string_end;
148           return (copied_string);
149 
150 
151           end double_quotes;
152 
153 
154           end string;