algol68/a68-low-reals.o \
algol68/a68-low-complex.o \
algol68/a68-low-bits.o \
- algol68/a68-low-posix.o \
algol68/a68-low-prelude.o \
algol68/a68-low-ranges.o \
algol68/a68-low-runtime.o \
}
/* Get a moif with the exports for module named MODULE. If no exports can be
- found then return NULL. */
+ found then return NULL.
+
+ If BASENAME is not NULL then it specifies the basefile of the file to open
+ for the module exports: BASENAME.o, libBASENAME.so, etc. If BASENAME is
+ NULL then the filename is derived from the module name. */
MOIF_T *
-a68_open_packet (const char *module)
+a68_open_packet (const char *module, const char *basename)
{
/* We may have a suitable moif already decoded for the requested module. If
so, use it. */
if (moif == NO_MOIF)
{
char *filename;
- const char **pfilename = A68_MODULE_FILES->get (module);
- if (pfilename == NULL)
- {
- /* Turn the module indicant in MODULE to lower-case. */
- filename = (char *) alloca (strlen (module) + 1);
- size_t i = 0;
- for (; i < strlen (module); i++)
- filename[i] = TOLOWER (module[i]);
- filename[i] = '\0';
- }
+ if (basename != NULL)
+ filename = xstrdup (basename);
else
{
- size_t len = strlen (*pfilename) + 1;
- filename = (char *) alloca (len);
- memcpy (filename, *pfilename, len);
+ const char **pfilename = A68_MODULE_FILES->get (module);
+ if (pfilename == NULL)
+ {
+ /* Turn the module indicant in MODULE to lower-case. */
+ filename = (char *) alloca (strlen (module) + 1);
+ size_t i = 0;
+ for (; i < strlen (module); i++)
+ filename[i] = TOLOWER (module[i]);
+ filename[i] = '\0';
+ }
+ else
+ {
+ size_t len = strlen (*pfilename) + 1;
+ filename = (char *) alloca (len);
+ memcpy (filename, *pfilename, len);
+ }
}
/* Try to read exports data in a buffer. */
else
wrapped_nargs += 1;
}
+ if (SUB (m) == M_STRING)
+ wrapped_nargs += 2;
/* Now build the type of the wrapped function. */
-
+ tree wrapper_ret_type = TREE_TYPE (TREE_TYPE (wrapper));
+ tree wrapped_ret_type = (SUB (m) == M_STRING
+ ? void_type_node : wrapper_ret_type);
tree *wrapped_args_types = XALLOCAVEC (tree, wrapped_nargs);
int nwrappedarg = 0;
for (PACK_T *z = PACK (m); z != NO_PACK; FORWARD (z))
}
}
- tree wrapper_ret_type = TREE_TYPE (TREE_TYPE (wrapper));
- tree wrapped_type = build_function_type_array (wrapper_ret_type,
+ if (SUB (m) == M_STRING)
+ {
+ wrapped_args_types[nwrappedarg++]
+ = build_pointer_type (build_pointer_type (a68_char_type));
+ wrapped_args_types[nwrappedarg++]
+ = build_pointer_type (size_type_node);
+ }
+
+ tree wrapped_type = build_function_type_array (wrapped_ret_type,
wrapped_nargs,
wrapped_args_types);
-
+
/* And a decl for the wrapped function. */
tree wrapped = build_decl (UNKNOWN_LOCATION,
FUNCTION_DECL,
}
DECL_ARGUMENTS (wrapper) = nreverse (DECL_ARGUMENTS (wrapper));
+ tree body = NULL_TREE;
a68_push_function_range (wrapper, wrapper_ret_type);
-
- /* We need a pointer to a function type. */
- if (!POINTER_TYPE_P (TREE_TYPE (wrapped)))
- wrapped = fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (wrapped)),
- wrapped);
-
- tree body = build_call_vec (TREE_TYPE (wrapped_type), wrapped, wrapped_args);
+ {
+ /* Note how we need a pointer to a function type for the call. */
+ if (!POINTER_TYPE_P (TREE_TYPE (wrapped)))
+ wrapped = fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (wrapped)),
+ wrapped);
+ if (SUB (m) == M_STRING
+ || (IS_REF (SUB (m)) && SUB (SUB (m)) == M_STRING))
+ {
+ a68_push_range (SUB (m));
+ tree ptrchar_type = build_pointer_type (a68_char_type);
+ tree r = a68_lower_tmpvar ("r%", ptrchar_type, build_int_cst (ptrchar_type, 0));
+ tree rlen = a68_lower_tmpvar ("rlen%", sizetype, size_int (0));
+ TREE_ADDRESSABLE (r) = 1;
+ TREE_ADDRESSABLE (rlen) = 1;
+
+ /* Add two additional arguments to the wrapped call if the wrapper
+ returns a string. */
+ wrapped_args->quick_push (fold_build1 (ADDR_EXPR,
+ build_pointer_type (ptrchar_type), r));
+ wrapped_args->quick_push (fold_build1 (ADDR_EXPR,
+ build_pointer_type (sizetype), rlen));
+
+ /* Call to the wrapped function. */
+ tree call = build_call_vec (TREE_TYPE (wrapped_type), wrapped, wrapped_args);
+ a68_add_stmt (call);
+
+ /* Build the result string. */
+ tree lower_bound = ssize_int (1);
+ tree upper_bound = fold_convert (ssizetype, rlen);
+ tree relems_size = fold_build2 (MULT_EXPR, sizetype,
+ rlen, size_in_bytes (a68_char_type));
+
+
+ if (SUB (m) == M_STRING)
+ a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+ r, relems_size, &lower_bound, &upper_bound));
+ else
+ {
+ /* Return a ref to string. */
+ gcc_assert (IS_REF (SUB (m)) && SUB (SUB (m)) == M_STRING);
+ a68_add_stmt (a68_row_malloc (M_STRING, 1 /* dim */,
+ r, relems_size,
+ &lower_bound, &upper_bound));
+ }
+ body = a68_pop_range ();
+ }
+ else
+ body = build_call_vec (TREE_TYPE (wrapped_type), wrapped, wrapped_args);
+ }
a68_pop_function_range (body);
}
+++ /dev/null
-/* Lowering routines for the POSIX prelude.
- Copyright (C) 2025 Jose E. Marchesi.
-
- Written by Jose E. Marchesi.
-
- GCC is free software; you can redistribute it and/or modify it
- under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 3, or (at your option)
- any later version.
-
- GCC is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
- License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GCC; see the file COPYING3. If not see
- <http://www.gnu.org/licenses/>. */
-
-#define INCLUDE_MEMORY
-#include "config.h"
-#include "system.h"
-#include "coretypes.h"
-
-#include "tree.h"
-#include "fold-const.h"
-#include "diagnostic.h"
-#include "langhooks.h"
-#include "tm.h"
-#include "function.h"
-#include "cgraph.h"
-#include "toplev.h"
-#include "varasm.h"
-#include "predict.h"
-#include "stor-layout.h"
-#include "tree-iterator.h"
-#include "stringpool.h"
-#include "print-tree.h"
-#include "gimplify.h"
-#include "dumpfile.h"
-#include "convert.h"
-
-#include "a68.h"
-
-/* Number of command line arguments passed to the program. */
-
-tree
-a68_posix_argc (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_ARGC);
-}
-
-/* Gets the Nth command line argument passed to the program. If N is out of
- range the result is an empty string. */
-
-tree
-a68_posix_argv (void)
-{
- static tree argv_fndecl;
-
- if (argv_fndecl == NULL_TREE)
- {
- argv_fndecl
- = a68_low_toplevel_func_decl ("argv",
- build_function_type_list (CTYPE (M_STRING),
- a68_int_type,
- NULL_TREE));
- announce_function (argv_fndecl);
-
- tree param = a68_low_func_param (argv_fndecl, "n", a68_int_type);
- DECL_ARGUMENTS (argv_fndecl) = param;
-
- a68_push_function_range (argv_fndecl, CTYPE (M_STRING),
- true /* top_level */);
-
- a68_push_range (M_STRING);
- tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
- TREE_ADDRESSABLE (len) = 1;
-
- tree ptrtochar_type = build_pointer_type (a68_char_type);
- tree elems = a68_lower_tmpvar ("elems%", ptrtochar_type,
- a68_build_libcall (A68_LIBCALL_POSIX_ARGV,
- ptrtochar_type, 2,
- param,
- fold_build1 (ADDR_EXPR, build_pointer_type (sizetype),
- len)));
- tree lower_bound = ssize_int (1);
- tree upper_bound = fold_convert (ssizetype, len);
- tree elems_size = fold_build2 (MULT_EXPR, sizetype,
- len,
- size_in_bytes (a68_char_type));
- a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
- elems, elems_size,
- &lower_bound, &upper_bound));
- tree body = a68_pop_range ();
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (argv_fndecl)),
- argv_fndecl);
-}
-
-/* Gets the value of an environment variable, or an empty string if the
- variable is not set. */
-
-tree
-a68_posix_getenv (void)
-{
- static tree getenv_fndecl;
-
- if (getenv_fndecl == NULL_TREE)
- {
- getenv_fndecl
- = a68_low_toplevel_func_decl ("getenv",
- build_function_type_list (CTYPE (M_STRING),
- CTYPE (M_STRING),
- NULL_TREE));
- announce_function (getenv_fndecl);
-
- tree param = a68_low_func_param (getenv_fndecl, "varname", CTYPE (M_STRING));
- DECL_ARGUMENTS (getenv_fndecl) = param;
-
- a68_push_function_range (getenv_fndecl, CTYPE (M_STRING),
- true /* top_level */);
-
- a68_push_range (M_STRING);
-
- tree varname = a68_lower_tmpvar ("varname%", CTYPE (M_STRING),
- param);
-
- tree ptrtochar_type = build_pointer_type (a68_char_type);
- tree convelems = a68_lower_tmpvar ("convelems%", ptrtochar_type,
- build_int_cst (ptrtochar_type, 0));
- TREE_ADDRESSABLE (convelems) = 1;
- tree convelemslen = a68_lower_tmpvar ("convelemslen%", sizetype,
- size_int (0));
- TREE_ADDRESSABLE (convelemslen) = 1;
-
- tree call = a68_build_libcall (A68_LIBCALL_POSIX_GETENV,
- void_type_node, 5,
- a68_multiple_elements (varname),
- a68_multiple_num_elems (varname),
- a68_multiple_stride (varname, size_zero_node),
- fold_build1 (ADDR_EXPR, build_pointer_type (ptrtochar_type),
- convelems),
- fold_build1 (ADDR_EXPR, build_pointer_type (sizetype),
- convelemslen));
- a68_add_stmt (call);
- tree lower_bound = ssize_int (1);
- tree upper_bound = fold_convert (ssizetype, convelemslen);
- tree convelems_size = fold_build2 (MULT_EXPR, sizetype,
- convelemslen,
- size_in_bytes (a68_char_type));
- a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
- convelems, convelems_size,
- &lower_bound, &upper_bound));
- tree body = a68_pop_range ();
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (getenv_fndecl)),
- getenv_fndecl);
-}
-
-tree
-a68_posix_putchar (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_PUTCHAR);
-}
-
-tree
-a68_posix_puts (void)
-{
- static tree puts_fndecl;
-
- if (puts_fndecl == NULL_TREE)
- {
- puts_fndecl
- = a68_low_toplevel_func_decl ("puts",
- build_function_type_list (void_type_node,
- CTYPE (M_STRING),
- NULL_TREE));
- announce_function (puts_fndecl);
-
- tree param = a68_low_func_param (puts_fndecl, "str", CTYPE (M_STRING));
- DECL_ARGUMENTS (puts_fndecl) = param;
-
- a68_push_function_range (puts_fndecl, void_type_node,
- true /* top_level */);
-
- tree call = a68_build_libcall (A68_LIBCALL_POSIX_PUTS,
- void_type_node, 3,
- a68_multiple_elements (param),
- a68_multiple_num_elems (param),
- a68_multiple_stride (param, size_zero_node));
- a68_pop_function_range (call);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (puts_fndecl)),
- puts_fndecl);
-}
-
-tree
-a68_posix_fconnect (void)
-{
- static tree fconnect_fndecl;
-
- if (fconnect_fndecl == NULL_TREE)
- {
- fconnect_fndecl
- = a68_low_toplevel_func_decl ("fconnect",
- build_function_type_list (a68_int_type,
- CTYPE (M_STRING),
- a68_bits_type,
- NULL_TREE));
- announce_function (fconnect_fndecl);
-
- tree host = a68_low_func_param (fconnect_fndecl, "host", CTYPE (M_STRING));
- tree port = a68_low_func_param (fconnect_fndecl, "port", a68_int_type);
- DECL_ARGUMENTS (fconnect_fndecl) = chainon (host, port);
-
- a68_push_function_range (fconnect_fndecl, a68_int_type,
- true /* top_level */);
-
-
- tree body = a68_build_libcall (A68_LIBCALL_POSIX_FCONNECT,
- a68_int_type, 4,
- a68_multiple_elements (host),
- a68_multiple_num_elems (host),
- a68_multiple_stride (host, size_zero_node),
- port);
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fconnect_fndecl)),
- fconnect_fndecl);
-}
-
-tree
-a68_posix_fcreate (void)
-{
- static tree fcreate_fndecl;
-
- if (fcreate_fndecl == NULL_TREE)
- {
- fcreate_fndecl
- = a68_low_toplevel_func_decl ("fcreate",
- build_function_type_list (a68_int_type,
- CTYPE (M_STRING),
- a68_bits_type,
- NULL_TREE));
- announce_function (fcreate_fndecl);
-
- tree pathname = a68_low_func_param (fcreate_fndecl, "pathname", CTYPE (M_STRING));
- tree mode = a68_low_func_param (fcreate_fndecl, "mode", a68_int_type);
- DECL_ARGUMENTS (fcreate_fndecl) = chainon (pathname, mode);
-
- a68_push_function_range (fcreate_fndecl, a68_int_type,
- true /* top_level */);
-
-
- tree body = a68_build_libcall (A68_LIBCALL_POSIX_FCREATE,
- a68_int_type, 4,
- a68_multiple_elements (pathname),
- a68_multiple_num_elems (pathname),
- a68_multiple_stride (pathname, size_zero_node),
- mode);
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fcreate_fndecl)),
- fcreate_fndecl);
-}
-
-tree
-a68_posix_fopen (void)
-{
- static tree fopen_fndecl;
-
- if (fopen_fndecl == NULL_TREE)
- {
- fopen_fndecl
- = a68_low_toplevel_func_decl ("fopen",
- build_function_type_list (a68_int_type,
- CTYPE (M_STRING),
- a68_bits_type,
- NULL_TREE));
- announce_function (fopen_fndecl);
-
- tree pathname = a68_low_func_param (fopen_fndecl, "pathname", CTYPE (M_STRING));
- tree flags = a68_low_func_param (fopen_fndecl, "flags", a68_int_type);
- DECL_ARGUMENTS (fopen_fndecl) = chainon (pathname, flags);
-
- a68_push_function_range (fopen_fndecl, a68_int_type,
- true /* top_level */);
-
-
- tree body = a68_build_libcall (A68_LIBCALL_POSIX_FOPEN,
- a68_int_type, 4,
- a68_multiple_elements (pathname),
- a68_multiple_num_elems (pathname),
- a68_multiple_stride (pathname, size_zero_node),
- flags);
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fopen_fndecl)),
- fopen_fndecl);
-}
-
-tree
-a68_posix_fclose (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_FCLOSE);
-}
-
-tree
-a68_posix_fsize (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_FSIZE);
-}
-
-tree
-a68_posix_lseek (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_LSEEK);
-}
-
-tree
-a68_posix_errno (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_ERRNO);
-}
-
-tree
-a68_posix_exit (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_EXIT);
-}
-
-tree
-a68_posix_perror (void)
-{
- static tree perror_fndecl;
-
- if (perror_fndecl == NULL_TREE)
- {
- perror_fndecl
- = a68_low_toplevel_func_decl ("perror",
- build_function_type_list (void_type_node,
- CTYPE (M_STRING),
- NULL_TREE));
- announce_function (perror_fndecl);
-
- tree str = a68_low_func_param (perror_fndecl, "str", CTYPE (M_STRING));
- DECL_ARGUMENTS (perror_fndecl) = str;
-
- a68_push_function_range (perror_fndecl, void_type_node,
- true /* top_level */);
-
- tree body = a68_build_libcall (A68_LIBCALL_POSIX_PERROR,
- a68_int_type, 3,
- a68_multiple_elements (str),
- a68_multiple_num_elems (str),
- a68_multiple_stride (str, size_zero_node));
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (perror_fndecl)),
- perror_fndecl);
-}
-
-tree
-a68_posix_strerror (void)
-{
- static tree strerror_fndecl;
-
- if (strerror_fndecl == NULL_TREE)
- {
- strerror_fndecl
- = a68_low_toplevel_func_decl ("strerror",
- build_function_type_list (CTYPE (M_STRING),
- a68_int_type,
- NULL_TREE));
- announce_function (strerror_fndecl);
-
- tree errnum = a68_low_func_param (strerror_fndecl, "errnum", a68_int_type);
- DECL_ARGUMENTS (strerror_fndecl) = errnum;
-
- a68_push_function_range (strerror_fndecl, CTYPE (M_STRING),
- true /* top_level */);
-
- tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
- TREE_ADDRESSABLE (len) = 1;
-
- tree call = a68_build_libcall (A68_LIBCALL_POSIX_STRERROR,
- void_type_node, 2,
- errnum,
- fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len));
- tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call);
-
- tree lower_bound = ssize_int (1);
- tree upper_bound = fold_convert (ssizetype, len);
- tree elems_size = fold_build2 (MULT_EXPR, sizetype,
- len, size_in_bytes (a68_char_type));
-
- tree body = a68_row_value (CTYPE (M_STRING), 1 /* dim */,
- elems, elems_size,
- &lower_bound, &upper_bound);
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (strerror_fndecl)),
- strerror_fndecl);
-}
-
-tree
-a68_posix_getchar (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_GETCHAR);
-}
-
-tree
-a68_posix_fgetc (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_FGETC);
-}
-
-tree
-a68_posix_fputc (void)
-{
- return a68_get_libcall (A68_LIBCALL_POSIX_FPUTC);
-}
-
-tree
-a68_posix_fputs (void)
-{
- static tree fputs_fndecl;
-
- if (fputs_fndecl == NULL_TREE)
- {
- fputs_fndecl
- = a68_low_toplevel_func_decl ("fputs",
- build_function_type_list (a68_int_type,
- a68_int_type,
- CTYPE (M_STRING),
- NULL_TREE));
- announce_function (fputs_fndecl);
-
- tree fd = a68_low_func_param (fputs_fndecl, "fd", a68_int_type);
- tree str = a68_low_func_param (fputs_fndecl, "str", CTYPE (M_STRING));
- DECL_ARGUMENTS (fputs_fndecl) = chainon (fd, str);
-
- a68_push_function_range (fputs_fndecl, a68_int_type,
- true /* top_level */);
-
-
- tree body = a68_build_libcall (A68_LIBCALL_POSIX_FPUTS,
- a68_int_type, 4,
- fd,
- a68_multiple_elements (str),
- a68_multiple_num_elems (str),
- a68_multiple_stride (str, size_zero_node));
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fputs_fndecl)),
- fputs_fndecl);
-}
-
-tree
-a68_posix_fgets (void)
-{
- static tree fgets_fndecl;
-
- if (fgets_fndecl == NULL_TREE)
- {
- fgets_fndecl
- = a68_low_toplevel_func_decl ("fgets",
- build_function_type_list (CTYPE (M_REF_STRING),
- a68_int_type,
- a68_int_type,
- NULL_TREE));
- announce_function (fgets_fndecl);
-
- tree fd = a68_low_func_param (fgets_fndecl, "fd", a68_int_type);
- tree n = a68_low_func_param (fgets_fndecl, "n", a68_int_type);
- DECL_ARGUMENTS (fgets_fndecl) = chainon (fd, n);
-
- a68_push_function_range (fgets_fndecl, CTYPE (M_REF_STRING),
- true /* top_level */);
-
- tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
- TREE_ADDRESSABLE (len) = 1;
-
- tree call = a68_build_libcall (A68_LIBCALL_POSIX_FGETS,
- CTYPE (M_REF_STRING), 3,
- fd, n,
- fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len));
- tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call);
-
- tree lower_bound = ssize_int (1);
- tree upper_bound = fold_convert (ssizetype, len);
- tree elems_size = fold_build2 (MULT_EXPR, sizetype,
- len, size_in_bytes (a68_char_type));
- tree body = a68_row_malloc (M_STRING, 1 /* dim */,
- elems, elems_size,
- &lower_bound, &upper_bound);
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fgets_fndecl)),
- fgets_fndecl);
-}
-
-tree
-a68_posix_gets (void)
-{
- static tree gets_fndecl;
-
- if (gets_fndecl == NULL_TREE)
- {
- gets_fndecl
- = a68_low_toplevel_func_decl ("gets",
- build_function_type_list (CTYPE (M_REF_STRING),
- a68_int_type,
- NULL_TREE));
- announce_function (gets_fndecl);
-
- tree n = a68_low_func_param (gets_fndecl, "n", a68_int_type);
- DECL_ARGUMENTS (gets_fndecl) = n;
-
- a68_push_function_range (gets_fndecl, CTYPE (M_REF_STRING),
- true /* top_level */);
-
- tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
- TREE_ADDRESSABLE (len) = 1;
-
- tree call = a68_build_libcall (A68_LIBCALL_POSIX_GETS,
- CTYPE (M_REF_STRING), 2,
- n, fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len));
- tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call);
-
- tree lower_bound = ssize_int (1);
- tree upper_bound = fold_convert (ssizetype, len);
- tree elems_size = fold_build2 (MULT_EXPR, sizetype,
- len, size_in_bytes (a68_char_type));
- tree body = a68_row_malloc (M_STRING, 1 /* dim */,
- elems, elems_size,
- &lower_bound, &upper_bound);
- a68_pop_function_range (body);
- }
-
- return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (gets_fndecl)),
- gets_fndecl);
-}
{
return a68_get_libcall (A68_LIBCALL_LONGLONGRANDOM);
}
-
-/********* POSIX prelude. ***************/
-
-tree
-a68_lower_posixargc (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_argc ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixargv (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_argv ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixgetenv (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_getenv ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixputchar (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_putchar ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixputs (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_puts ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixfconnect (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fconnect ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixfopen (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fopen ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixfcreate (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fcreate ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixfclose (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fclose ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixfsize (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fsize ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixlseek (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_lseek ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixseekcur (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- return build_int_cst (a68_int_type, 0);
-}
-
-tree
-a68_lower_posixseekend (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- return build_int_cst (a68_int_type, 1);
-}
-
-tree
-a68_lower_posixseekset (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- return build_int_cst (a68_int_type, 2);
-}
-
-tree
-a68_lower_posixstdinfiledes (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- return build_int_cst (a68_int_type, 0);
-}
-
-tree
-a68_lower_posixstdoutfiledes (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- return build_int_cst (a68_int_type, 1);
-}
-
-tree
-a68_lower_posixstderrfiledes (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- return build_int_cst (a68_int_type, 2);
-}
-
-tree
-a68_lower_posixfileodefault (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- /* Please keep in sync with libga68/ga68-posix.c */
- return build_int_cst (a68_bits_type, 0x99999999);
-}
-
-tree
-a68_lower_posixfileordwr (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- /* Please keep in sync with libga68/ga68-posix.c */
- return build_int_cst (a68_bits_type, 0x2);
-}
-
-tree
-a68_lower_posixfileordonly (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- /* Please keep in sync with libga68/ga68-posix.c */
- return build_int_cst (a68_bits_type, 0x0);
-}
-
-tree
-a68_lower_posixfileowronly (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- /* Please keep in sync with libga68/ga68-posix.c */
- return build_int_cst (a68_bits_type, 0x1);
-}
-
-tree
-a68_lower_posixfileotrunc (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- /* Please keep in sync with libga68/ga68-posix.c */
- return build_int_cst (a68_bits_type, 0x8);
-}
-
-tree
-a68_lower_posixerrno (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_errno ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixexit (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_exit ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixperror (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_perror ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixstrerror (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_strerror ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixfputc (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fputc ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixfputs (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fputs ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixgetchar (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_getchar ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-
-tree
-a68_lower_posixfgetc (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fgetc ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixgets (NODE_T *p ATTRIBUTE_UNUSED,
- LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_gets ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
-
-tree
-a68_lower_posixfgets (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
-{
- tree t = a68_posix_fgets ();
- if (CAN_HAVE_LOCATION_P (t))
- SET_EXPR_LOCATION (t, a68_get_node_location (p));
- return t;
-}
DEF_A68_RUNTIME (RANDOM, "_libga68_random", RT(FLOAT), P0(), 0)
DEF_A68_RUNTIME (LONGRANDOM, "_libga68_longrandom", RT(DOUBLE), P0(), 0)
DEF_A68_RUNTIME (LONGLONGRANDOM, "_libga68_longlongrandom", RT(LONGDOUBLE), P0(), 0)
-DEF_A68_RUNTIME (POSIX_FCONNECT, "_libga68_posixfconnect", RT(INT), P4(UNISTRPTR,SIZE,SIZE,INT), 0)
-DEF_A68_RUNTIME (POSIX_FOPEN, "_libga68_posixfopen", RT(INT), P4(UNISTRPTR,SIZE,SIZE,UINT), 0)
-DEF_A68_RUNTIME (POSIX_FCREATE, "_libga68_posixcreat", RT(INT), P4(UNISTRPTR,SIZE,SIZE,UINT), 0)
-DEF_A68_RUNTIME (POSIX_FCLOSE, "_libga68_posixclose", RT(INT), P0(), 0)
-DEF_A68_RUNTIME (POSIX_FSIZE, "_libga68_posixfsize", RT(LONGLONGINT), P1(INT), 0)
-DEF_A68_RUNTIME (POSIX_ARGC, "_libga68_posixargc", RT(INT), P0(), 0)
-DEF_A68_RUNTIME (POSIX_ARGV, "_libga68_posixargv", RT(UNISTRPTR), P2(INT, SIZEPTR), 0)
-DEF_A68_RUNTIME (POSIX_PUTCHAR, "_libga68_posixputchar", RT(CHAR), P1(CHAR), 0)
-DEF_A68_RUNTIME (POSIX_FPUTC, "_libga68_posixfputc", RT(CHAR), P2(INT,CHAR), 0)
-DEF_A68_RUNTIME (POSIX_PUTS, "_libga68_posixputs", RT(VOID), P3(UNISTR,SIZE,SIZE), 0)
-DEF_A68_RUNTIME (POSIX_FPUTS, "_libga68_posixfputs", RT(INT), P4(INT,UNISTRPTR,SIZE,SIZE), 0)
-DEF_A68_RUNTIME (POSIX_GETCHAR, "_libga68_posixgetchar", RT(CHAR), P0(), 0)
-DEF_A68_RUNTIME (POSIX_FGETC, "_libga68_posixfgetc", RT(CHAR), P1(INT), 0)
-DEF_A68_RUNTIME (POSIX_GETS, "_libga68_posixgets", RT(UNISTRPTR), P2(INT,SIZEPTR), 0)
-DEF_A68_RUNTIME (POSIX_FGETS, "_libga68_posixfgets", RT(UNISTRPTR), P3(INT,INT,SIZEPTR), 0)
-DEF_A68_RUNTIME (POSIX_GETENV, "_libga68_posixgetenv", RT(VOID), P5(UNISTR,SIZE,SIZE,UNISTRPTR,SIZEPTR), 0)
-DEF_A68_RUNTIME (POSIX_ERRNO, "_libga68_posixerrno", RT(INT), P0(), 0)
-DEF_A68_RUNTIME (POSIX_EXIT, "_libga68_posixexit", RT(VOID), P1(INT), 0)
-DEF_A68_RUNTIME (POSIX_PERROR, "_libga68_posixperror", RT(VOID), P3(UNISTR,SIZE,SIZE), 0)
-DEF_A68_RUNTIME (POSIX_STRERROR, "_libga68_posixstrerror", RT(UNISTRPTR), P2(INT, SIZEPTR), 0)
-DEF_A68_RUNTIME (POSIX_LSEEK, "_libga68_posixlseek", RT(LONGLONGINT), P3(INT,LONGLONGINT,INT), 0)
DEF_A68_RUNTIME (U32_CMP2, "_libga68_u32_cmp2", RT(INT), P6(UNISTR, SIZE, SIZE, UNISTR, SIZE, SIZE), 0)
#undef P0
#include "gimplify.h"
#include "dumpfile.h"
#include "convert.h"
+#include "options.h"
#include "a68.h"
return decl;
}
-/* Make an extern declaration for a formal hole. */
+/* Make an extern declaration for a formal hole.
+
+ Note that this function is not used for formal holes with proc modes, called
+ from a68_wrap_formal_var_hole. See a68_wrap_formal_proc_hole. */
tree
a68_make_formal_hole_decl (NODE_T *p, const char *extern_symbol)
{
- /* The CTYPE of MODE is a pointer to a function. We need the pointed
- function type for the FUNCTION_DECL. */
- tree type = (IS (MOID (p), PROC_SYMBOL)
- ? TREE_TYPE (CTYPE (MOID (p)))
- : CTYPE (MOID (p)));
+ gcc_assert (!IS (MOID (p), PROC_SYMBOL));
+ tree type = CTYPE (MOID (p));
const char *sym = (strlen (extern_symbol) > 0 && extern_symbol[0] == '&'
? extern_symbol + 1
: extern_symbol);
return NULL_TREE;
}
+/* Lower the declaration of a prelude or postlude. */
+
+static tree
+lower_lude_decl (const char *module, bool postludep)
+{
+ char *symbol = xasprintf ("%s__%s",
+ module,
+ postludep ? "postlude" : "prelude");
+ tree fdecl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL,
+ get_identifier (symbol),
+ build_function_type (void_type_node, void_list_node));
+ free (symbol);
+ DECL_EXTERNAL (fdecl) = 1;
+ TREE_PUBLIC (fdecl) = 1;
+ return fdecl;
+}
+
/* Lower a module text.
module text : revelation part, def part, postlude part, fed symbol ;
{
a68_push_stmt_list (NULL);
{
+ if (!flag_building_libga68)
+ {
+ /* Add calls to implicitly accessed standard preludes. */
+ tree standard_prelude = lower_lude_decl ("STANDARD", false);
+ tree posix_prelude = lower_lude_decl ("POSIX", false);
+ a68_add_stmt (build_call_expr_loc (UNKNOWN_LOCATION, standard_prelude, 0));
+ a68_add_stmt (build_call_expr_loc (UNKNOWN_LOCATION, posix_prelude, 0));
+ }
+
/* Add calls to preludes of modules in REVELATION_PART. */
lower_revelations (revelation_part, ctx, true /* prelude */);
a68_add_stmt (a68_lower_tree (prelude_enquiry, ctx));
{
a68_push_stmt_list (NULL);
{
- /* Add calls to postludes of modules in REVELATION_PART. */
- lower_revelations (revelation_part, ctx, false /* prelude */);
/* Perhaps the postlude code, if there is one. */
NODE_T *postlude_serial = NO_NODE;
if (postlude_part != NO_NODE)
postlude_serial = NEXT_SUB (postlude_part);
if (postlude_serial != NO_NODE)
a68_add_stmt (a68_lower_tree (postlude_serial, ctx));
+
+ /* Add calls to postludes of modules in REVELATION_PART. */
+ lower_revelations (revelation_part, ctx, false /* prelude */);
+
+ if (!flag_building_libga68)
+ {
+ /* Add calls to implicitly accessed standard postludes. */
+ tree standard_postlude = lower_lude_decl ("STANDARD", true);
+ tree posix_postlude = lower_lude_decl ("POSIX", true);
+ a68_add_stmt (build_call_expr_loc (UNKNOWN_LOCATION, posix_postlude, 0));
+ a68_add_stmt (build_call_expr_loc (UNKNOWN_LOCATION, standard_postlude, 0));
+ }
}
tree do_postlude = a68_pop_stmt_list ();
void_type_node /* result_type */);
/* Lower the body of the function. */
+
+ tree standard_prelude = lower_lude_decl ("STANDARD", false);
+ tree standard_postlude = lower_lude_decl ("STANDARD", true);
+ tree posix_prelude = lower_lude_decl ("POSIX", false);
+ tree posix_postlude = lower_lude_decl ("POSIX", true);
+
NODE_T *enclosed_clause = (IS (SUB (p), ENCLOSED_CLAUSE)
? SUB (p) : NEXT (SUB (p)));
- tree body_expr = a68_lower_tree (enclosed_clause, ctx);
- a68_pop_function_range (body_expr);
+
+ a68_push_range (M_VOID);
+ a68_add_stmt (build_call_expr_loc (UNKNOWN_LOCATION, standard_prelude, 0));
+ a68_add_stmt (build_call_expr_loc (UNKNOWN_LOCATION, posix_prelude, 0));
+ a68_add_stmt (a68_lower_tree (enclosed_clause, ctx));
+ a68_add_stmt (build_call_expr_loc (UNKNOWN_LOCATION, posix_postlude, 0));
+ a68_add_stmt (build_call_expr_loc (UNKNOWN_LOCATION, standard_postlude, 0));
+
+ tree body = a68_pop_range ();
+ a68_pop_function_range (body);
return NULL_TREE;
}
return a68_is_c_mode (SUB (m), level + 1);
else if (IS (m, PROC_SYMBOL))
{
- bool yielded_mode_valid = a68_is_c_mode (SUB (m));
+ bool yielded_mode_valid =
+ ((level == 0
+ && (SUB (m) == M_STRING
+ || (IS_REF (SUB (m)) && SUB (SUB (m)) == M_STRING)))
+ || a68_is_c_mode (SUB (m), level + 1));
bool params_valid = true;
for (PACK_T *z = PACK (m); z != NO_PACK; FORWARD (z))
return p;
}
-/* Extract the revelation associated with the module MODULE. The node Q is
- used for symbol table and diagnostic purposes. Publicized modules are
- recursively extracted as well. This call may result in one or more
- errors. */
+/* Extract the revelation associated with the module MODULE.
-static void
-extract_revelation (NODE_T *q, const char *module, TAG_T *tag)
+ The node Q is used for symbol table and diagnostic purposes
+
+ Publicized modules are recursively extracted as well. This call may result
+ in one or more errors.
+
+ If FILENAME is not NULL then the module exports are looked in
+ libFILENAME.so, FILENAME.o, etc. If it is NULL, the filename is derived
+ from the module name.
+
+ This function is visible externally because it is used to extract
+ revelations of modules distributed as part of libga68, in
+ a68-parser-prelude.cc */
+
+void
+a68_extract_revelation (NODE_T *q, const char *module, const char *filename,
+ TAG_T *tag)
{
/* Import the MOIF and install it in the tag. */
- MOIF_T *moif = a68_open_packet (module);
+ MOIF_T *moif = a68_open_packet (module, filename);
if (moif == NULL)
{
a68_error (q, "cannot find module Z", module);
extract_revelation calls is properly done. */
for (EXTRACT_T *e : MODULES (moif))
- extract_revelation (q, EXTRACT_SYMBOL (e), NO_TAG);
+ a68_extract_revelation (q, EXTRACT_SYMBOL (e), filename, NO_TAG);
/* Store mode indicants from the MOIF in the symbol table,
and also in the moid list. */
/* INDICANT node. */
NODE_T *n = a68_some_node (a68_demangle_symbol (NAME (moif),
EXTRACT_SYMBOL (e)));
+ MOID (n) = EXTRACT_MODE (e);
/* EQUALS_SYMBOL node. */
NEXT (n) = a68_some_node ("=");
ATTRIBUTE (NEXT (n)) = EQUALS_SYMBOL;
}
}
+/* This version of a68_extract_revelation gets a symbol table and line info
+ rather than a node. It is used to extract revelations from standard modules
+ distributed in the run-time library. See a68-parser-prelude.cc */
+
+void
+a68_extract_revelation (TABLE_T *t, LINE_T *l,
+ const char *module, const char *filename,
+ TAG_T *tag)
+{
+ NODE_T *q = a68_some_node ("");
+ TABLE (q) = t;
+ LINE (INFO (q)) = l;
+ a68_extract_revelation (q, module, filename, tag);
+}
+
/* Search [MODE|MODULE] A = .., B = ..
and ACCESS A, B, ..
and store indicants. */
{
TAG_T *tag = a68_add_tag (TABLE (bold_tag), MODULE_SYMBOL, bold_tag, NO_MOID, STOP);
gcc_assert (tag != NO_TAG);
- extract_revelation (bold_tag, NSYMBOL (bold_tag), tag);
+ a68_extract_revelation (bold_tag, NSYMBOL (bold_tag),
+ NULL /* filename */, tag);
}
}
}
#include "config.h"
#include "system.h"
#include "coretypes.h"
+#include "options.h"
#include "a68.h"
m = a68_proc (M_VOID, M_SEMA, NO_MOID);
a68_op (A68_STD, "UP", m);
a68_op (A68_STD, "DOWN", m);
+
+
+ /* Load Algol 68 parts. */
+ if (!flag_building_libga68)
+ a68_extract_revelation (A68_STANDENV, LINE (INFO (TOP_NODE (&A68_JOB))),
+ "STANDARD", "ga68");
+}
+
+/* Transput. */
+
+static void
+stand_transput (void)
+{
+ // if (!flag_building_libga68)
+ // a68_extract_revelation (A68_STANDENV, LINE (INFO (TOP_NODE (&A68_JOB))),
+ // "TRANSPUT", "ga68");
}
/* GNU extensions for the standenv. */
static void
posix_prelude (void)
{
- MOID_T *m = NO_MOID;
-
- /* Environment variables. */
- m = a68_proc (M_STRING, M_STRING, NO_MOID);
- a68_idf (A68_EXT, "getenv", m, a68_lower_posixgetenv);
- /* Exit status handling. */
- m = a68_proc (M_VOID, M_INT, NO_MOID);
- a68_idf (A68_EXT, "posixexit", m, a68_lower_posixexit);
- /* Argument handling. */
- m = A68_MCACHE (proc_int);
- a68_idf (A68_EXT, "argc", m, a68_lower_posixargc);
- m = a68_proc (M_STRING, M_INT, NO_MOID);
- a68_idf (A68_EXT, "argv", m, a68_lower_posixargv);
- /* Error procedures. */
- m = A68_MCACHE (proc_int);
- a68_idf (A68_EXT, "errno", m, a68_lower_posixerrno);
- m = a68_proc (M_VOID, M_STRING, NO_MOID);
- a68_idf (A68_EXT, "perror", m, a68_lower_posixperror);
- m = a68_proc (M_STRING, M_INT, NO_MOID);
- a68_idf (A68_EXT, "strerror", m, a68_lower_posixstrerror);
- /* I/O identifiers. */
- a68_idf (A68_EXT, "stdin", M_INT, a68_lower_posixstdinfiledes);
- a68_idf (A68_EXT, "stdout", M_INT, a68_lower_posixstdoutfiledes);
- a68_idf (A68_EXT, "stderr", M_INT, a68_lower_posixstderrfiledes);
- a68_idf (A68_EXT, "fileodefault", M_BITS, a68_lower_posixfileodefault);
- a68_idf (A68_EXT, "fileordwr", M_BITS, a68_lower_posixfileordwr);
- a68_idf (A68_EXT, "fileordonly", M_BITS, a68_lower_posixfileordonly);
- a68_idf (A68_EXT, "fileowronly", M_BITS, a68_lower_posixfileowronly);
- a68_idf (A68_EXT, "fileotrunc", M_BITS, a68_lower_posixfileotrunc);
- /* Opening and closing files. */
- m = a68_proc (M_INT, M_STRING, M_BITS, NO_MOID);
- a68_idf (A68_EXT, "fopen", m, a68_lower_posixfopen);
- a68_idf (A68_EXT, "fcreate", m, a68_lower_posixfcreate);
- m = A68_MCACHE (proc_int_int);
- a68_idf (A68_EXT, "fclose", m, a68_lower_posixfclose);
- /* Getting properties of files. */
- m = a68_proc (M_LONG_LONG_INT, M_INT, NO_MOID);
- a68_idf (A68_EXT, "fsize", m, a68_lower_posixfsize);
- m = a68_proc (M_LONG_LONG_INT, M_INT, M_LONG_LONG_INT, M_INT, NO_MOID);
- a68_idf (A68_EXT, "lseek", m, a68_lower_posixlseek);
- a68_idf (A68_EXT, "seekcur", M_INT, a68_lower_posixseekcur);
- a68_idf (A68_EXT, "seekend", M_INT, a68_lower_posixseekend);
- a68_idf (A68_EXT, "seekset", M_INT, a68_lower_posixseekset);
- /* Sockets. */
- m = a68_proc (M_INT, M_STRING, M_INT, NO_MOID);
- a68_idf (A68_EXT, "fconnect", m, a68_lower_posixfconnect);
- /* String and character output. */
- m = a68_proc (M_CHAR, M_CHAR, NO_MOID);
- a68_idf (A68_EXT, "putchar", m, a68_lower_posixputchar);
- m = a68_proc (M_VOID, M_STRING, NO_MOID);
- a68_idf (A68_EXT, "puts", m, a68_lower_posixputs);
- m = a68_proc (M_CHAR, M_INT, M_CHAR, NO_MOID);
- a68_idf (A68_EXT, "fputc", m, a68_lower_posixfputc);
- m = a68_proc (M_INT, M_INT, M_STRING, NO_MOID);
- a68_idf (A68_EXT, "fputs", m, a68_lower_posixfputs);
- /* String and character input. */
- m = A68_MCACHE (proc_char);
- a68_idf (A68_EXT, "getchar", m, a68_lower_posixgetchar);
- m = a68_proc (M_CHAR, M_INT, NO_MOID);
- a68_idf (A68_EXT, "fgetc", m, a68_lower_posixfgetc);
- m = a68_proc (M_REF_STRING, M_INT, NO_MOID);
- a68_idf (A68_EXT, "gets", m, a68_lower_posixgets);
- m = a68_proc (M_REF_STRING, M_INT, M_INT, NO_MOID);
- a68_idf (A68_EXT, "fgets", m, a68_lower_posixfgets);
-}
-
-/* Transput. */
-
-static void
-stand_transput (void)
-{
- /* Most of the standard transput is implemented in Algol 68 and doesn't
- require compiler support. See libga68/transput.a68.in */
+ if (!flag_building_libga68)
+ a68_extract_revelation (A68_STANDENV, LINE (INFO (TOP_NODE (&A68_JOB))),
+ "POSIX", "ga68");
}
-/* Build the standard environ symbol table. */
-
void
a68_make_standard_environ (void)
{
void a68_extract_labels (NODE_T *p, int expect);
void a68_extract_declarations (NODE_T *p);
void a68_elaborate_bold_tags (NODE_T *p);
+void a68_extract_revelation (NODE_T *q, const char *module,
+ const char *filename, TAG_T *tag = NO_TAG);
+void a68_extract_revelation (TABLE_T *t, LINE_T *l, const char *module,
+ const char *filename, TAG_T *tag = NO_TAG);
/* a68-parser-keywords.cc */
tree a68_complex_conj (MOID_T *mode, tree z);
tree a68_complex_widen_from_real (MOID_T *mode, tree r);
-/* a68-low-posix.cc */
-
-tree a68_posix_argc (void);
-tree a68_posix_argv (void);
-tree a68_posix_getenv (void);
-tree a68_posix_putchar (void);
-tree a68_posix_puts (void);
-tree a68_posix_fconnect (void);
-tree a68_posix_fcreate (void);
-tree a68_posix_fopen (void);
-tree a68_posix_fclose (void);
-tree a68_posix_fsize (void);
-tree a68_posix_lseek (void);
-tree a68_posix_errno (void);
-tree a68_posix_exit (void);
-tree a68_posix_perror (void);
-tree a68_posix_strerror (void);
-tree a68_posix_getchar (void);
-tree a68_posix_fgetc (void);
-tree a68_posix_fputc (void);
-tree a68_posix_fputs (void);
-tree a68_posix_gets (void);
-tree a68_posix_fgets (void);
-
/* a68-low-reals.cc */
tree a68_get_real_skip_tree (MOID_T *m);
tree a68_lower_set3 (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_clear3 (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_test3 (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixargc (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixargv (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixputchar (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixputs (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfputc (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfputs (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixgetenv (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfconnect (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfopen (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfcreate (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfclose (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfsize (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixlseek (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixseekcur (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixseekend (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixseekset (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixstdinfiledes (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixstdoutfiledes (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixstderrfiledes (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfileodefault (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfileordwr (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfileordonly (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfileowronly (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfileotrunc (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixerrno (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixexit (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixperror (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixstrerror (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixgetchar (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfgetc (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixgets (NODE_T *p, LOW_CTX_T ctx);
-tree a68_lower_posixfgets (NODE_T *p, LOW_CTX_T ctx);
/* a68-exports.cc */
/* a68-imports.cc */
-MOIF_T *a68_open_packet (const char *module);
+MOIF_T *a68_open_packet (const char *module, const char *filename = NULL);
bool a68_process_module_map (const char *map, const char **errmsg);
char *a68_find_object_export_data (const std::string &filename,
int fd, off_t offset, size_t *size);
Algol68 RejectNegative JoinedOrMissing
-fcheck=[...] Specify which runtime checks are to be performed.
+fbuilding-libga68
+Algol68 Undocumented Var(flag_building_libga68)
+
fa68-dump-modes
Algol68 Var(flag_a68_dump_modes)
Dump Algol 68 modes after parsing.
-begin string s =
+begin []string s =
nest C "lala"; { dg-error "" }
union(int,real) x =
nest C "x"; { dg-error "" }
{ dg-options "-Whidden-declarations=none" }
begin real b;
- begin int getchar = 10;
+ begin int maxint = 10;
int b;
op UPB = (int i, union (int,string) v) int:
(v | (string s): UPB s | 0);
{ dg-options "-Whidden-declarations=prelude" }
begin real b;
- begin int getchar = 10; { dg-warning "hides" }
+ begin int maxint = 10; { dg-warning "hides" }
int b;
op UPB = (int i, union (int,string) v) int: { dg-warning "hides" }
(v | (string s): UPB s | 0);
set specpath [get_multilibs]
}
set algol68_init_set_ALGOL68_UNDER_TEST 1
- set ALGOL68_UNDER_TEST [findfile $base_dir/../../ga68 "$base_dir/../../ga68 -B$base_dir/../../ -B$specpath/libga68/" [findfile $base_dir/ga68 "$base_dir/ga68 -B$base_dir/" [transform ga68]]]
+ set ALGOL68_UNDER_TEST [findfile $base_dir/../../ga68 "$base_dir/../../ga68 -B$base_dir/../.. -B$specpath/libga68 -I$base_dir/../../.libs -I$specpath/libga68/.libs" [findfile $base_dir/ga68 "$base_dir/ga68 -B$base_dir" [transform ga68]]]
}
}
}
libga68_la_CFLAGS = $(LIBGA68_GCFLAGS) $(LIBGA68_BOEHM_GC_INCLUDES)
libga68_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` \
$(version_arg) $(lt_host_flags) $(extra_darwin_ldflags_libga68)
-libga68_la_DEPENDENCIES = libga68.spec $(version_dep) transput.lo
-libga68_la_LIBADD = $(LIBGA68_BOEHM_GC_LIBS) transput.lo
+libga68_la_DEPENDENCIES = libga68.spec $(version_dep) transput.lo standard.lo posix.lo
+libga68_la_LIBADD = $(LIBGA68_BOEHM_GC_LIBS) transput.lo standard.lo posix.lo
# Rules to build the Algol 68 code in the library.
--mode=compile $(A68) $(AM_A68FLAGS)
.a68.o:
- $(A68) -o $@ $(A68FLAGS) -c $<
+ $(A68) -o $@ $(A68FLAGS) -fbuilding-libga68 -c $<
.a68.lo:
- $(LTA68COMPILE) $(A68FLAGS) $(MULTIFLAGS) -c -o $@ $<
+ $(LTA68COMPILE) $(A68FLAGS) $(MULTIFLAGS) -fbuilding-libga68 -c -o $@ $<
transput.a68 : transput.a68.in
$(AWK) -f $(srcdir)/sppp.awk $< > $@
-BUILT_SOURCES = transput.a68
+standard.a68 : standard.a68.in
+ $(AWK) -f $(srcdir)/sppp.awk $< > $@
+
+BUILT_SOURCES = transput.a68 standard.a68
# target overrides
-include $(tmake_file)
libga68_la_LDFLAGS = -version-info `grep -v '^\#' $(srcdir)/libtool-version` \
$(version_arg) $(lt_host_flags) $(extra_darwin_ldflags_libga68)
-libga68_la_DEPENDENCIES = libga68.spec $(version_dep) transput.lo
-libga68_la_LIBADD = $(LIBGA68_BOEHM_GC_LIBS) transput.lo
+libga68_la_DEPENDENCIES = libga68.spec $(version_dep) transput.lo standard.lo posix.lo
+libga68_la_LIBADD = $(LIBGA68_BOEHM_GC_LIBS) transput.lo standard.lo posix.lo
# Rules to build the Algol 68 code in the library.
LTA68COMPILE = $(LIBTOOL) --tag=A68 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \
--mode=compile $(A68) $(AM_A68FLAGS)
-BUILT_SOURCES = transput.a68
+BUILT_SOURCES = transput.a68 standard.a68
MULTISRCTOP =
MULTIBUILDTOP =
MULTIDIRS =
@LIBGA68_USE_SYMVER_SUN_TRUE@@LIBGA68_USE_SYMVER_TRUE@ > $@ || (rm -f $@ ; exit 1)
.a68.o:
- $(A68) -o $@ $(A68FLAGS) -c $<
+ $(A68) -o $@ $(A68FLAGS) -fbuilding-libga68 -c $<
.a68.lo:
- $(LTA68COMPILE) $(A68FLAGS) $(MULTIFLAGS) -c -o $@ $<
+ $(LTA68COMPILE) $(A68FLAGS) $(MULTIFLAGS) -fbuilding-libga68 -c -o $@ $<
transput.a68 : transput.a68.in
$(AWK) -f $(srcdir)/sppp.awk $< > $@
+standard.a68 : standard.a68.in
+ $(AWK) -f $(srcdir)/sppp.awk $< > $@
+
# target overrides
-include $(tmake_file)
/* Simple I/O based on POSIX file descriptors. */
+int _libga68_stdin = 0;
+int _libga68_stdout = 1;
+int _libga68_stderr = 2;
+
int
_libga68_posixerrno (void)
{
_libga68_free_internal (u8str);
}
-uint32_t *
-_libga68_posixstrerror (int errnum, size_t *len)
+void
+_libga68_posixstrerror (int errnum, uint32_t **r, size_t *rlen)
{
const char *str = strerror (errnum);
- return _libga68_u8_to_u32 ((const uint8_t *)str, strlen (str), NULL, len);
+ *r = _libga68_u8_to_u32 ((const uint8_t *)str, strlen (str), NULL, rlen);
}
/* Helper for _libga68_posixfopen. */
return fd;
}
-#define FILE_O_DEFAULT 0x99999999
-#define FILE_O_RDONLY 0x0
-#define FILE_O_WRONLY 0x1
-#define FILE_O_RDWR 0x2
-#define FILE_O_TRUNC 0x8
+unsigned int _libga68_file_o_default = 0x99999999;
+unsigned int _libga68_file_o_rdonly = 0x0;
+unsigned int _libga68_file_o_wronly = 0x1;
+unsigned int _libga68_file_o_rdwr = 0x2;
+unsigned int _libga68_file_o_trunc = 0x8;
int
_libga68_posixfopen (const uint32_t *pathname, size_t len, size_t stride,
/* Default mode: try read-write initially.
If that fails, then try read-only.
If that fails, then try write-only. */
- if (flags == FILE_O_DEFAULT)
+ if (flags == _libga68_file_o_default)
{
openflags = O_RDWR;
if ((fd = _libga68_open (filepath, openflags)) < 0)
return fd;
}
- if (flags & FILE_O_RDONLY)
+ if (flags & _libga68_file_o_rdonly)
openflags |= O_RDONLY;
- if (flags & FILE_O_WRONLY)
+ if (flags & _libga68_file_o_wronly)
openflags |= O_WRONLY;
- if (flags & FILE_O_RDWR)
+ if (flags & _libga68_file_o_rdwr)
openflags |= O_RDWR;
- if (flags & FILE_O_TRUNC)
+ if (flags & _libga68_file_o_trunc)
openflags |= O_TRUNC;
fd = _libga68_open (filepath, openflags);
/* Implementation of the posix prelude `posix argv'. */
-uint32_t *
-_libga68_posixargv (int n, size_t *len)
+void
+_libga68_posixargv (int n, uint32_t **r, size_t *rlen)
{
if (n < 0 || n > _libga68_argc)
{
/* Return an empty string. */
- *len = 0;
- return NULL;
+ *rlen = 0;
+ *r = NULL;
}
else
{
char *arg = _libga68_argv[n - 1];
- return _libga68_u8_to_u32 (arg, strlen (arg), NULL, len);
+ *r = _libga68_u8_to_u32 (arg, strlen (arg), NULL, rlen);
}
}
/* Implementation of the posix prelude `posix fgets'. */
-uint32_t *
-_libga68_posixfgets (int fd, int nchars, size_t *len)
+void
+_libga68_posixfgets (int fd, int nchars, uint32_t **r, size_t *rlen)
{
uint32_t *res = NULL;
int n = 0;
res = _libga68_realloc (res, n * 80 * sizeof (uint32_t));
}
- *len = n;
- return res;
+ *rlen = n;
+ *r = res;
}
/* Implementation of the posix prelude `posix gets'. */
-uint32_t *
-_libga68_posixgets (int nchars, size_t *len)
+void
+_libga68_posixgets (int nchars, uint32_t **r, size_t *rlen)
{
- return _libga68_posixfgets (0, nchars, len);
+ _libga68_posixfgets (0, nchars, r, rlen);
}
/* Implementation of the posix prelude `fconnect'. */
}
/* Implementation of the posix prelude `lseek'. */
+
#define A68_SEEK_CUR 0
#define A68_SEEK_END 1
#define A68_SEEK_SET 2
+const int _libga68_seek_cur = A68_SEEK_CUR;
+const int _libga68_seek_end = A68_SEEK_END;
+const int _libga68_seek_set = A68_SEEK_SET;
+
long long int
_libga68_posixlseek (int fd, long long int offset, int whence)
{
int _libga68_posixerrno (void);
void _libga68_posixexit (int) __attribute__ ((__noreturn__));
void _libga68_posixperror (uint32_t *s, size_t len, size_t stride);
-uint32_t *_libga68_posixstrerror (int errnum, size_t *len);
+void _libga68_posixstrerror (int errnum, uint32_t **r, size_t *rlen);
long long int _libga68_posixfsize (int fd);
int _libga68_posixfopen (const uint32_t *pathname, size_t len, size_t stride,
unsigned int flags);
int _libga68_posixcreat (uint32_t *pathname, size_t len, size_t stride, uint32_t mode);
int _libga68_posixclose (int fd);
int _libga68_posixargc (void);
-uint32_t *_libga68_posixargv (int n, size_t *len);
+void _libga68_posixargv (int n, uint32_t **r, size_t *rlen);
void _libga68_posixgetenv (uint32_t *s, size_t len, size_t stride,
uint32_t **r, size_t *rlen);
void _libga68_posixputs (uint32_t *s, size_t len, size_t stride);
uint32_t _libga68_posixgetchar (void);
uint32_t _libga68_posixfgetc (int fd);
-uint32_t *_libga68_posixfgets (int fd, int nchars, size_t *len);
-uint32_t *_libga68_posixgets (int nchars, size_t *len);
+void _libga68_posixfgets (int fd, int nchars, uint32_t **r, size_t *rlen);
+void _libga68_posixgets (int nchars, uint32_t **r, size_t *rlen);
int _libga68_posixfconnect (uint32_t *str, size_t len, size_t stride,
int port);
--- /dev/null
+{ posix.a68 - POSIX prelude.
+
+ Copyright (C) 2026 Jose E. Marchesi
+
+ GCC is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 3, or (at your option) any later
+ version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License
+ and a copy of the GCC Runtime Library Exception along with this
+ program; see the files COPYING3 and COPYING.RUNTIME respectively.
+ If not, see <http://www.gnu.org/licenses/>. }
+
+module POSIX =
+def
+ pub int stdin = nest C "_libga68_stdin",
+ stdout = nest C "_libga68_stdout",
+ stderr = nest C "_libga68_stderr";
+
+ pub bits file_o_default = nest C "_libga68_file_o_default",
+ file_o_rdwr = nest C "_libga68_file_o_rdwr",
+ file_o_rdonly = nest C "_libga68_file_o_rdonly",
+ file_o_wronly = nest C "_libga68_file_o_wronly",
+ file_o_trunc = nest C "_libga68_file_o_trunc";
+
+ pub int seekcur = nest C "_libga68_seek_cur",
+ seekend = nest C "_libga68_seek_end",
+ seekset = nest C "_libga68_seek_set";
+
+ pub proc int errno = nest C "_libga68_posixerrno",
+ argc = nest C "_libga68_posixargc";
+ pub proc(int)string argv = nest C "_libga68_posixargv";
+ pub proc(int)string strerror = nest C "_libga68_posixstrerror";
+ pub proc(string,bits)int fopen = nest C "_libga68_posixfopen",
+ fcreate = nest C "_libga68_posixcreat";
+ pub proc(string,int)int fconnect = nest C "_libga68_posixfconnect";
+ pub proc(int)int fclose = nest C "_libga68_posixclose";
+ pub proc(int)long long int
+ fsize = nest C "_libga68_posixfsize";
+ pub proc(int,long long int,int)long long int
+ lseek = nest C "_libga68_posixlseek";
+ pub proc char getchar = nest C "_libga68_posixgetchar";
+ pub proc(char)char putchar = nest C "_libga68_posixputchar";
+ pub proc(int)char fgetc = nest C "_libga68_posixfgetc";
+ pub proc(int,char)char fputc = nest C "_libga68_posixfputc";
+ pub proc(int)ref string gets = nest C "_libga68_posixgets";
+ pub proc(string)void puts = nest C "_libga68_posixputs";
+ pub proc(int,int)ref string fgets = nest C "_libga68_posixfgets";
+ pub proc(int,string)int fputs = nest C "_libga68_posixfputs";
+ pub proc(int)void posix_exit = nest C "_libga68_posixexit";
+ pub proc(string)void perror = nest C "_libga68_posixperror";
+ pub proc(string)string getenv = nest C "_libga68_posixgetenv";
+
+ skip
+fed
--- /dev/null
+{ Process this file with sppp.awk -*- mode: a68 -*- }
+
+{ standard.a68.in - Standard prelude, a68 part.
+
+ Copyright (C) 2026 Jose E. Marchesi
+
+ GCC is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 3, or (at your option) any later
+ version.
+
+ GCC is distributed in the hope that it will be useful, but WITHOUT
+ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+ License for more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License
+ and a copy of the GCC Runtime Library Exception along with this
+ program; see the files COPYING3 and COPYING.RUNTIME respectively.
+ If not, see <http://www.gnu.org/licenses/>. }
+
+module Standard =
+def
+ skip
+fed
-{ Process this file with sppp.awk }
+{ Process this file with sppp.awk -*- mode: a68 -*- }
{ transput.a68.in - Standard transput.
projects / thirdparty / gcc.git / commitdiff
