scripts/consts.ajla

   1 {*
   2  * Copyright (C) 2024 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  *}
  18
  19 uses compiler.parser.istring;
  20
  21 const unl : bytes := bytes.[ 10 ];
  22
  23 fn locase(b : bytes) : bytes
  24 [
  25         for i := 0 to len(b) do
  26                 if b[i] >= 'A', b[i] <= 'Z' then
  27                         b[i] += 32;
  28         return b;
  29 ]
  30
  31 fn stretch(first last : bytes, tab : int) : bytes
  32 [
  33         if len(first) >= tab then
  34                 return first + " " + last;
  35         var n_tabs := (tab - len(first) + 7) div 8;
  36         return first + infinite(byte, ' ')[ .. n_tabs] + last;
  37 ]
  38
  39 fn replace_if_differ(implicit w : world, implicit d : dhandle, new old : bytes) : world
  40 [
  41         var h1 := ropen(old, 0);
  42         var h2 := ropen(new, 0);
  43         var l1 := read_lazy(h1);
  44         var l2 := read_lazy(h2);
  45         if l1 = l2 then [
  46                 unlink(old);
  47                 return;
  48         ]
  49         rename(d, new, d, old);
  50 ]
  51
  52 fn process_consts_txt(implicit w : world, implicit d : dhandle) : world
  53 [
  54         var lines := list_break_to_lines(read_lazy(ropen_lazy("scripts/consts.txt", 0)));
  55
  56         var pcode_op_1 := empty(bytes);
  57         var ex_codes_1 := empty(bytes);
  58         var ex_codes_2 := empty(bytes);
  59         var pcode_1 := empty(bytes);
  60         var pcode_2 := empty(bytes);
  61         var pcode_3 := empty(bytes);
  62
  63         var current_number := 0;
  64         var stride := 0;
  65         for l in lines do [
  66                 if len_at_least(l, 1), l[0] = ';' then
  67                         continue;
  68                 var comment := list_search(l, 9);
  69                 if comment >= 0 then
  70                         l := l[ .. comment];
  71
  72                 if l = "" then [
  73                         pcode_op_1 +<= "";
  74                         if len(ex_codes_1) > 0, ex_codes_1[len(ex_codes_1) - 1] <> "" then
  75                                 ex_codes_1 +<= "";
  76                         if len(ex_codes_2) > 0, ex_codes_2[len(ex_codes_2) - 1] <> "" then
  77                                 ex_codes_2 +<= "";
  78                         if len(pcode_1) > 0, pcode_1[len(pcode_1) - 1] <> "" then
  79                                 pcode_1 +<= "";
  80                         if len(pcode_3) > 0, pcode_3[len(pcode_3) - 1] <> "" then
  81                                 pcode_3 +<= "";
  82                         continue;
  83                 ]
  84                 var n := ston(l);
  85                 if not is_exception n then [
  86                         current_number := n;
  87                         if n < 0 then
  88                                 stride := -1;
  89                         else
  90                                 stride := 1;
  91                         continue;
  92                 ]
  93                 if l = "*" then [
  94                         current_number := 1;
  95                         stride := 0;
  96                         continue;
  97                 ]
  98
  99                 pcode_op_1 +<= stretch("#define " + l, ntos(current_number), 40);
 100
 101                 if (list_begins_with(l, "EC_") or list_begins_with(l, "AJLA_ERROR_") or list_begins_with(l, "SYSTEM_ERROR_")) and
 102                     not (l = "EC_N" or l = "AJLA_ERROR_BASE" or l = "AJLA_ERROR_N" or l = "SYSTEM_ERROR_BASE" or l = "SYSTEM_ERROR_N") then [
 103                         if list_begins_with(l, "AJLA_ERROR_") then
 104                                 l := l[5 .. ];
 105                         l := locase(l);
 106                         ex_codes_1 +<= "const " + l + " : int;";
 107                         ex_codes_2 +<= "const " + l + " : int := " + ntos(current_number) + ";";
 108                 ] else [
 109                         pcode_1 +<= "const " + l + " := " + ntos(current_number) + ";";
 110                 ]
 111
 112                 if list_begins_with(l, "P_") then [
 113                         l := l[2 .. ];
 114                         pcode_2 +<= "   if p = P_" + l + " then return """ + l + """;";
 115                 ] else if list_begins_with(l, "T_") then [
 116                         l := l[2 .. ];
 117                 ]
 118                 var p3 := "     a[#" + ntos_base(i_encode(l), 16) + "] := " + ntos(current_number) + ";";
 119                 p3 += fill(byte, '      ', (80 - len(p3)) div 8);
 120                 p3 += "// " + l;
 121                 pcode_3 +<= p3;
 122
 123                 if stride = 0 then
 124                         current_number *= 2;
 125                 else
 126                         current_number += stride;
 127         ]
 128
 129         var pcode_op := wopen("pcode-op.h.tmp", open_flag_create, open_mode_default);
 130         write(pcode_op, "/*" + unl);
 131         write(pcode_op, " * No-copyright" + unl);
 132         write(pcode_op, " * A table of numbers, generated by a script, is supposedly not copyrightable." + unl);
 133         write(pcode_op, " */" + unl);
 134         write(pcode_op, "" + unl);
 135         write(pcode_op, "#ifndef AJLA_PCODE_OP_H" + unl);
 136         write(pcode_op, "#define AJLA_PCODE_OP_H" + unl);
 137         write(pcode_op, unl);
 138         write(pcode_op, list_join(pcode_op_1, unl));
 139         write(pcode_op, unl);
 140         write(pcode_op, "#endif" + unl);
 141
 142         var ex_codes := wopen("newlib/ex_codes.ajla.tmp", open_flag_create, open_mode_default);
 143         write(ex_codes, "{*" + unl);
 144         write(ex_codes, " * No-copyright" + unl);
 145         write(ex_codes, " * A table of numbers, generated by a script, is supposedly not copyrightable." + unl);
 146         write(ex_codes, " *}" + unl);
 147         write(ex_codes, "" + unl);
 148         write(ex_codes, "private unit ex_codes;" + unl);
 149         write(ex_codes, unl);
 150         write(ex_codes, list_join(ex_codes_1, unl));
 151         write(ex_codes, unl);
 152         write(ex_codes, "implementation" + unl);
 153         write(ex_codes, unl);
 154         write(ex_codes, list_join(ex_codes_2, unl));
 155
 156         var pcode := wopen("newlib/pcode.ajla.tmp", open_flag_create, open_mode_default);
 157         write(pcode, "{*" + unl);
 158         write(pcode, " * No-copyright" + unl);
 159         write(pcode, " * A table of numbers, generated by a script, is supposedly not copyrightable." + unl);
 160         write(pcode, " *}" + unl);
 161         write(pcode, "" + unl);
 162         write(pcode, "private unit pcode;" + unl);
 163         write(pcode, unl);
 164         write(pcode, "type pcode_t := sint32;" + unl);
 165         write(pcode, "type u_pcode_t := uint32;" + unl);
 166         write(pcode, unl);
 167         write(pcode, list_join(pcode_1, unl));
 168         write(pcode, unl);
 169         write(pcode, "fn pcode_name(p : int) : bytes;" + unl);
 170         write(pcode, "fn name_to_value~cache : list(int);" + unl);
 171         write(pcode, unl);
 172         write(pcode, "implementation" + unl);
 173         write(pcode, unl);
 174         write(pcode, "fn pcode_name(p : int) : bytes" + unl);
 175         write(pcode, "[" + unl);
 176         write(pcode, list_join(pcode_2, unl));
 177         write(pcode, "  return ""Unknown code "" + ntos(p);" + unl);
 178         write(pcode, "]" + unl);
 179         write(pcode, unl);
 180         write(pcode, "fn name_to_value~cache : list(int)" + unl);
 181         write(pcode, "[" + unl);
 182         write(pcode, "  var a := infinite_uninitialized(int);" + unl);
 183         write(pcode, unl);
 184         write(pcode, list_join(pcode_3, unl));
 185         write(pcode, unl);
 186         write(pcode, "  return a;" + unl);
 187         write(pcode, "]" + unl);
 188 ]
 189
 190 fn process_socket_txt(implicit w : world, implicit d : dhandle) : world
 191 [
 192         var input := list_break_to_lines(read_lazy(ropen_lazy("scripts/socket.txt", 0)));
 193         var output_a := wopen("newlib/socket_consts.ajla.tmp", open_flag_create, open_mode_default);
 194         write(output_a, "{*" + unl);
 195         write(output_a, " * No-copyright" + unl);
 196         write(output_a, " * A table of numbers, generated by a script, is supposedly not copyrightable." + unl);
 197         write(output_a, " *}" + unl);
 198         write(output_a, "" + unl);
 199         var output_c := wopen("os_pos_s.inc.tmp", open_flag_create, open_mode_default);
 200         write(output_c, "/*" + unl);
 201         write(output_c, " * No-copyright" + unl);
 202         write(output_c, " * A table of numbers, generated by a script, is supposedly not copyrightable." + unl);
 203         write(output_c, " */" + unl);
 204         write(output_c, "" + unl);
 205
 206         var groups := list_break(input, "---");
 207
 208         write(output_a, "private unit socket_consts;" + unl);
 209
 210         for group in groups do [
 211                 while group[0] = "" or group[0][0] = ';' do [
 212                         group := group[1 .. ];
 213                 ]
 214                 var head := list_break(group[0], ',');
 215                 group := group[1 .. ];
 216
 217                 var func_name := head[0];
 218                 var rfunc_name := head[1];
 219                 var mode := head[2][0];
 220
 221                 if head[2][1] = '+' then
 222                         write(output_a, unl);
 223
 224                 var func :=
 225                         "static int " + func_name + "(int idx, ajla_error_t *err)" + unl +
 226                         "{" + unl +
 227                         "       switch (idx) {" + unl;
 228                 var rfunc :=
 229                         "static int " + rfunc_name + "(int idx, ajla_error_t *err)" + unl +
 230                         "{" + unl +
 231                         "       switch (idx) {" + unl;
 232
 233                 var count := 1;
 234                 for line in group do [
 235                         if line = "" or line[0] = ';' then
 236                                 continue;
 237
 238                         var s : int;
 239                         s := list_search(line, ' ');
 240                         if s >= 0 then
 241                                 line := line[ .. s];
 242                         s := list_search(line, '        ');
 243                         if s >= 0 then
 244                                 line := line[ .. s];
 245
 246                         if head[2][1] = '+' then
 247                                 write(output_a, "const " + locase(line) + " := " + ntos(count) + ";" + unl);
 248                         func += "#ifdef " + line + unl;
 249                         func += "               case " + ntos(count) + ": return " + line + ";" + unl;
 250                         func += "#endif" + unl;
 251
 252                         rfunc += "#ifdef " + line + unl;
 253                         rfunc += "              case " + line + ": return " + ntos(count) + ";" + unl;
 254                         rfunc += "#endif" + unl;
 255
 256                         if mode = '1' then
 257                                 count += 1;
 258                         else if mode = '2' then
 259                                 count *= 2;
 260                         else
 261                                 abort;
 262                 ]
 263
 264                 func += "               default:" + unl +
 265                         "                       fatal_mayfail(error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION), err, ""invalid value"");" + unl +
 266                         "                       return -1;" + unl +
 267                         "       }" + unl +
 268                         "}" + unl + unl;
 269                 rfunc += "              default:" + unl +
 270                         "                       fatal_mayfail(error_ajla(EC_SYNC, AJLA_ERROR_SYSTEM_RETURNED_INVALID_DATA), err, ""invalid value"");" + unl +
 271                         "                       return -1;" + unl +
 272                         "       }" + unl +
 273                         "}" + unl + unl;
 274
 275                 write(output_c, func);
 276                 if rfunc_name <> "" then
 277                         write(output_c, rfunc);
 278         ]
 279
 280         return w;
 281 ]
 282
 283 fn main(implicit w : world, implicit d : dhandle, h : list(handle), args : list(bytes), env : treemap(bytes, bytes)) : world
 284 [
 285         process_consts_txt();
 286         process_socket_txt();
 287         replace_if_differ("pcode-op.h", "pcode-op.h.tmp");
 288         replace_if_differ("newlib/ex_codes.ajla", "newlib/ex_codes.ajla.tmp");
 289         replace_if_differ("newlib/pcode.ajla", "newlib/pcode.ajla.tmp");
 290         replace_if_differ("newlib/socket_consts.ajla", "newlib/socket_consts.ajla.tmp");
 291         replace_if_differ("os_pos_s.inc", "os_pos_s.inc.tmp");
 292 ]