1 /* BEGIN INCLUDE FILE ... pl1_macro_value_procs.incl.pl1 */
  2 bit_value:
  3      procedure (token_num) returns (bit (253) varying );
  4           declare token_num              fixed binary;
  5           declare b_length               fixed binary;
  6 
  7 /* this assumes that the caller has checked that the token_type  bit_string
  8    and we remove the trailing b and dequote to gewt all 1's and 0's */
  9 
 10           b_length = token (token_num).string_size - 3;
 11           return (bit (dequote_string_ (substr (token (token_num).string_ptr ->
 12                  based_chars, 1, b_length + 2)), b_length));
 13 
 14      end bit_value;
 15 
 16 arith_value:
 17      procedure (token_num) returns (fixed binary (35));
 18           declare token_num              fixed binary;
 19 
 20 /* assumes caller has checked type of token */
 21 
 22           return (fixed (substr (token (token_num).string_ptr -> based_chars, 1, token (token_num).string_size), 35));
 23      end arith_value;
 24 
 25 char_value:
 26      procedure (token_num) returns (char (256) varying);
 27           declare token_num              fixed binary;
 28 
 29           return (dequote_string_ (substr (token (token_num).string_ptr -> based_chars, 1, token (token_num).string_size)));
 30 
 31      end char_value;
 32 
 33 requote_string_:
 34      procedure (instring) returns (char (256) varying);
 35           declare instring               char (*);          /* INPUT: string to be requoted */
 36           declare outstring              char (256);
 37           declare (inlength, outlength, indx, scan)
 38                                          fixed binary (21);
 39           declare (index, length, substr)
 40                                          builtin;
 41 
 42           inlength = length (instring);
 43           outlength = 1;
 44           indx = 1;
 45           substr (outstring, 1, 1) = QUOTE;
 46 
 47           do while (indx <= inlength);
 48                scan = index (substr (instring, indx), QUOTE);
 49                                                             /* how many chars till the QUOTE */
 50                if scan = 0                                  /* no more QUOTES, just rest of string */
 51                then do;                                     /* copy the remainder  */
 52                          substr (outstring, outlength + 1, inlength - indx + 1) = substr (instring, indx);
 53                          outlength = outlength + inlength - indx + 1;
 54                          indx = inlength + 1;
 55                     end;
 56                else do;                                     /* tack on till the QUOTE and a QUOTEQUOTE */
 57                          substr (outstring, outlength + 1, scan - 1) = substr (instring, indx, scan - 1);
 58                          outlength = outlength + scan;
 59                          substr (outstring, outlength, 2) = QUOTEQUOTE;
 60                          outlength = outlength + 1;
 61                          indx = indx + scan;
 62                     end /* else clause */;
 63           end /* while loop */;
 64 
 65 /* take on the final  QUOTE and return */
 66 
 67           outlength = outlength + 1;
 68           substr (outstring, outlength, 1) = QUOTE;
 69           return (substr (outstring, 1, outlength));
 70 
 71      end requote_string_;
 72 
 73 dequote_string_:
 74      procedure (instring) returns (char (256) varying);
 75           declare instring               char (*);          /* INPUT: string to be requoted */
 76           declare outstring              char (256);
 77           declare NULLSTRING             char (0) internal static options (constant) initial ("");
 78           declare (inlength, outlength, indx, scan)
 79                                          fixed binary (21);
 80           declare (index, length, substr)
 81                                          builtin;
 82 
 83           inlength = length (instring);
 84 
 85           if inlength < 2 then return (NULLSTRING);
 86           if substr (instring,1,1) ^= QUOTE | substr (instring, inlength,1) ^= QUOTE
 87           then return (NULLSTRING);
 88 
 89           outlength = 0;
 90           indx = 2;
 91 
 92 
 93           do while (indx <= inlength - 1);
 94                scan = index (substr (instring, indx, inlength - indx), QUOTE) -1 ;
 95                                                             /* how many chars till the QUOTE */
 96                if scan = -1                                 /* no more QUOTES, just rest of string */
 97                then do;                                     /* copy the remainder  */
 98                          substr (outstring, outlength + 1, inlength - indx) = substr (instring, indx, inlength -indx);
 99                          outlength = outlength + inlength - indx;
100                          indx = inlength + 1;
101                     end;
102                else do;                                     /* tack on till the QUOTE and replace QUOTE with QUOTEQUOTE */
103                          substr (outstring, outlength + 1, scan ) = substr (instring, indx, scan );
104                          outlength = outlength + scan;
105                          indx = indx + scan;
106                          if substr (instring,indx, 2) ^= QUOTEQUOTE
107                          then return (NULLSTRING);
108                           substr (outstring, outlength+1, 1 )= QUOTE;indx = indx + 2;
109                          outlength = outlength + 1;
110                     end /* else clause */;
111           end /* while loop */;
112 
113           return (substr (outstring, 1, outlength));
114 
115      end dequote_string_;
116 
117 /* END INCLUDE FILE ... pl1_macro_value_procs.incl.pl1 */