func_decl);
}
+/* Lower a formal hole.
+
+ formal hole : formal nest symbol, tertiary ;
+ formal nest symbol, language indicant, tertiary.
+*/
+
+tree
+a68_lower_formal_hole (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+ NODE_T *str = NEXT_SUB (p);
+ if (IS (str, LANGUAGE_INDICANT))
+ FORWARD (str);
+ gcc_assert (IS (str, TERTIARY));
+ while (str != NO_NODE && !IS (str, ROW_CHAR_DENOTATION))
+ str = SUB (str);
+ gcc_assert (IS (str, ROW_CHAR_DENOTATION));
+
+ char *symbol = a68_string_process_breaks (p, NSYMBOL (str));
+ tree decl = a68_make_formal_hole_decl (p, symbol);
+ return decl;
+}
+
/* Lower an unit.
unit : assignation; identity relation;
return decl;
}
+/* Make an extern declaration for a formal 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 (strlen (extern_symbol) > 0);
+ const char *sym = (extern_symbol[0] == '&'
+ ? extern_symbol + 1
+ : extern_symbol);
+
+ tree decl = build_decl (a68_get_node_location (p),
+ VAR_DECL,
+ get_identifier (sym),
+ type);
+ DECL_EXTERNAL (decl) = 1;
+ TREE_PUBLIC (decl) = 1;
+ DECL_INITIAL (decl) = a68_get_skip_tree (MOID (p));
+
+ if (extern_symbol[0] == '&')
+ decl = fold_build1 (ADDR_EXPR, type, decl);
+ return decl;
+}
+
/* Do a checked indirection.
P is a tree node used for its location information.
case OR_FUNCTION:
res = a68_lower_logic_function (p, ctx);
break;
+ case FORMAL_HOLE:
+ res = a68_lower_formal_hole (p, ctx);
+ break;
case IDENTITY_RELATION:
res = a68_lower_identity_relation (p, ctx);
break;
{
bool k = false;
- for (; y != NO_SOID && !k; FORWARD (y))
+ for (; y != NO_SOID && !k; FORWARD (y))
k = (!IS (MOID (y), STOWED_MODE));
if (k == false)
}
}
+/* Whether the given mode M is a valid mode for a C formal hole. See
+ metaproduction rule 561B in ga68.vw. */
+
+bool
+a68_is_c_mode (MOID_T *m)
+{
+ if (m == M_VOID || m == M_BOOL || m == M_CHAR)
+ return true;
+ else if (IS_INTEGRAL (m))
+ return true;
+ else if (IS_BITS (m))
+ return true;
+ else if (IS_REAL (m))
+ return true;
+ else if (IS_REF (m))
+ return a68_is_c_mode (SUB (m));
+ else if (IS (m, PROC_SYMBOL))
+ {
+ bool yielded_mode_valid = a68_is_c_mode (SUB (m));
+ bool params_valid = true;
+
+ for (PACK_T *z = PACK (m); z != NO_PACK; FORWARD (z))
+ params_valid &= a68_is_c_mode (MOID (z));
+
+ return yielded_mode_valid && params_valid;
+ }
+ else if (IS_STRUCT (m))
+ {
+ bool fields_valid = true;
+
+ for (PACK_T *z = PACK (m); z != NO_PACK; FORWARD (z))
+ fields_valid &= a68_is_c_mode (MOID (z));
+ return fields_valid;
+ }
+
+ return false;
+}
+
/* Insert coercion A in the tree. */
void
A68_ATTR(FORMAL_DECLARERS, "formal declarers")
A68_ATTR(FORMAL_DECLARERS_LIST, "list of formal declarers")
A68_ATTR(FORMAL_DECLARER_MARK, "formal declarer mark")
+A68_ATTR(FORMAL_HOLE, "formal hole")
A68_ATTR(FORMAL_NEST_SYMBOL, "formal-nest-symbol")
A68_ATTR(FORMULA, "formula")
A68_ATTR(FOR_PART, "for-part")
A68_ATTR(LABELED_UNIT, "labeled unit")
A68_ATTR(LABEL_IDENTIFIER, "label identifier")
A68_ATTR(LABEL_SEQUENCE, "label sequence")
+A68_ATTR(LANGUAGE_INDICANT, "language indicant")
A68_ATTR(LITERAL, "literal")
A68_ATTR(LOCAL_LABEL, "local label")
A68_ATTR(LOC_SYMBOL, "loc-symbol")
static void reduce_declaration_lists (NODE_T *p);
static void reduce_module_texts (NODE_T *p);
static void reduce_module_text_parts (NODE_T *p);
+static void reduce_formal_holes (NODE_T *p);
static NODE_T *reduce_dyadic (NODE_T *p, int u);
/* Whether a series is serial or collateral. */
reduce_right_to_left_constructs (p);
/* Reduce units and declarations. */
reduce_basic_declarations (p);
+ reduce_formal_holes (p);
reduce_units (p);
reduce_erroneous_units (p);
if (expect != UNIT)
}
}
+/* Reduce formal holes. */
+
+static void
+reduce_formal_holes (NODE_T *p)
+{
+ for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+ {
+ bool ahole = false;
+ reduce (q, NO_NOTE, &ahole, FORMAL_HOLE,
+ FORMAL_NEST_SYMBOL, TERTIARY, STOP);
+ reduce (q, NO_NOTE, &ahole, FORMAL_HOLE,
+ FORMAL_NEST_SYMBOL, LANGUAGE_INDICANT, TERTIARY, STOP);
+
+ if (ahole)
+ {
+ /* Check that the tertiary is a row of chars denotation. */
+ for (NODE_T *s = SUB (q); s != NO_NODE; FORWARD (s))
+ {
+ if (IS (s, TERTIARY)
+ && !(IS (SUB (s), SECONDARY)
+ && IS (SUB (SUB (s)), PRIMARY)
+ && IS (SUB (SUB (SUB (s))), DENOTATION)
+ && IS (SUB (SUB (SUB (SUB (s)))), ROW_CHAR_DENOTATION)))
+ {
+ a68_error (s, "expected row char denotation");
+ }
+ }
+ }
+ }
+}
+
/* Reduce units. */
static void
-reduce_units (NODE_T * p)
+reduce_units (NODE_T *p)
{
/* Stray ~ is a SKIP. */
for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
reduce (q, NO_NOTE, NO_TICK, UNIT, SKIP, STOP);
reduce (q, NO_NOTE, NO_TICK, UNIT, TERTIARY, STOP);
reduce (q, NO_NOTE, NO_TICK, UNIT, ASSERTION, STOP);
+ reduce (q, NO_NOTE, NO_TICK, UNIT, FORMAL_HOLE, STOP);
}
}
return 0;
}
-/* Fill in whether bold tag is operator, indicant or module indicant. */
+/* Fill in whether bold tag is operator, indicant, module indicant or language
+ indicant. */
void
a68_elaborate_bold_tags (NODE_T *p)
{
if (IS (q, BOLD_TAG))
{
- switch (find_tag_definition (TABLE (q), NSYMBOL (q)))
+ if (PREVIOUS (q) != NO_NODE
+ && IS (PREVIOUS (q), FORMAL_NEST_SYMBOL))
{
- case 0:
- a68_error (q, "tag S has not been declared properly");
- break;
- case INDICANT:
- ATTRIBUTE (q) = INDICANT;
- break;
- case OPERATOR:
- ATTRIBUTE (q) = OPERATOR;
- break;
- case MODULE_INDICANT:
- ATTRIBUTE (q) = MODULE_INDICANT;
- break;
+ if (strcmp (NSYMBOL (q), "C") != 0)
+ a68_error (q, "S is not a valid language indication");
+ else
+ ATTRIBUTE (q) = LANGUAGE_INDICANT;
+ }
+ else
+ {
+ switch (find_tag_definition (TABLE (q), NSYMBOL (q)))
+ {
+ case 0:
+ a68_error (q, "tag S has not been declared properly");
+ break;
+ case INDICANT:
+ ATTRIBUTE (q) = INDICANT;
+ break;
+ case OPERATOR:
+ ATTRIBUTE (q) = OPERATOR;
+ break;
+ case MODULE_INDICANT:
+ ATTRIBUTE (q) = MODULE_INDICANT;
+ break;
+ }
}
}
}
mode_check_bool_function (SUB (p), x, y);
a68_warn_for_voiding (p, x, y, OR_FUNCTION);
}
+ else if (IS (p, FORMAL_HOLE))
+ {
+ NODE_T *tertiary = NO_NODE;
+
+ for (NODE_T *q = SUB (p); q != NO_NODE; FORWARD (q))
+ {
+ if (IS (q, TERTIARY))
+ {
+ tertiary = q;
+ break;
+ }
+ }
+
+ NODE_T *str = tertiary;
+ while (str != NO_NODE && !IS (str, ROW_CHAR_DENOTATION))
+ str = SUB (str);
+ gcc_assert (IS (str, ROW_CHAR_DENOTATION));
+
+ if (SORT (x) != STRONG)
+ {
+ /* A formal hole should appear in a strong context, and its mode is
+ the goal mode of the context. */
+ a68_error (p, "formal hole should be in a strong context");
+ a68_make_soid (y, STRONG, M_ERROR, 0);
+ }
+ else if (!a68_is_c_mode (MOID (x)))
+ {
+ /* Additionally, the mode of the formal hole should be amenable to be
+ somehow "translated" to C semantics. */
+ a68_error (p, "formal hole cannot be of mode M", MOID (x));
+ a68_make_soid (y, STRONG, M_ERROR, 0);
+ }
+ else if (NSYMBOL (str)[0] == '&' && !IS_REF (MOID (x)))
+ {
+ /* A C formal whole whose string starts with & requires
+ a ref mode. */
+ a68_error (p, "formal hole should be a name (ref to a mode)");
+ a68_make_soid (y, STRONG, M_ERROR, 0);
+ }
+ else
+ {
+ SOID_T z;
+ mode_check_unit (tertiary, x, &z);
+ a68_make_soid (y, SORT (x), MOID (x), 0);
+ a68_warn_for_voiding (p, x, y, FORMAL_HOLE);
+ }
+ }
MOID (p) = MOID (y);
}
void a68_make_strong (NODE_T *n, MOID_T *p, MOID_T *q);
void a68_make_uniting_coercion (NODE_T *n, MOID_T *q);
void a68_make_void (NODE_T *p, MOID_T *q);
+bool a68_is_c_mode (MOID_T *m);
#define A68_DEPREF true
#define A68_NO_DEPREF false
tree a68_make_proc_identity_declaration_decl (NODE_T *identifier, const char *module_name = NULL,
bool indicant = false, bool external = false,
const char *extern_symbol = NULL);
+tree a68_make_formal_hole_decl (NODE_T *p, const char *extern_symbol);
tree a68_make_anonymous_routine_decl (MOID_T *mode);
tree a68_get_skip_tree (MOID_T *m);
tree a68_get_empty (void);
tree a68_lower_routine_text (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_generator (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_call (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_formal_hole (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_unit (NODE_T *p, LOW_CTX_T ctx);
/* a68-low-generator.c */
@menu
* Invoking ga68:: How to run the compiler.
* Composing programs:: Packets, modules, holes, particular programs.
+* Foreign Function Interface:: Communicating with other languages via holes.
* Comments and pragmats:: Comments and pragmas.
* Hardware representation:: Representation of programs.
* Standard prelude:: Standard modes, operators, etc.
@menu
* Packets:: Compilation units.
* Modules:: Facilities for bottom-up programming.
+* Holes:: Facilities for top-down programming.
* Particular programs:: The main program.
* The standard environment:: Environment conforming a full program.
@end menu
XXX
+@node Holes
+@section Holes
+@cindex holes
+
+@dfn{Holes} are part of the modules system and are a mechanism used
+for two main purposes:
+
+@itemize @minus
+@item Top-down programming.
+@item Communication with other programming languages.
+@end itemize
+
+
+At the moment only the second kind of holes are supported by this
+compiler. @xref{Foreign Function Interface}.
+
@node Particular programs
@section Particular programs
@cindex particular program
Subsequent sections in this manual include a detailed description of
the contents of these preludes.
+@node Foreign Function Interface
+@chapter Foreign Function Interface
+@cindex FFI
+
+It is possible to call functions written in other programming
+languages, and also to access variables and constants, using the
+following form of @dfn{formal hole}:
+
+@example
+@B{nest} @B{language_indicant} "row char denotation"
+@end example
+
+@noindent
+Where @B{language_indicant} is a bold word indicating the programming
+language we are communicating with and the row char denotation
+specifies the entity we are accessing. The interpretation of the
+later depends on the specific language.
+
+The formal hole construction is an @dfn{unit}, and can only appear in
+a strong context. It's mode is the mode expected by the strong
+context. For example, in the following declaration:
+
+@example
+int counter = nest C "_counter";
+@end example
+
+@noindent
+The mode of the formal hole is @code{@B{int}}, since it is in a strong
+context (the actual parameter of an identity declaration) in which an
+integral value is expected. Likewise, in:
+
+@example
+proc long int func = nest C "random";
+@end example
+
+@noindent
+The expected mode is a procedure that gets no arguments and returns a
+@code{@B{long} @B{int}}.
+
+The set of modes that are accepted in the formal holes depend on the
+specific language we are communicating to. These are usually
+restricted because the compiler may not know how to translate certain
+Algol 68 concepts into the foreign language ones. A compile time
+error is issued if an invalid mode is required. Specifics are
+described in the sections below.
+
+It is important to note that the language-indicants like @code{@B{C}}
+or @code{@B{Fortran}} are still available to be used as mode
+indicants, operators or module indicants: they only qualify as
+language indicants when they appear in a formal hole (@code{@B{nest}})
+construct.
+
+The following subsections document the specific supported foreign
+languages.
+
+@menu
+* Communicating with C:: Accessing C variables and functions.
+@end menu
+
+@node Communicating with C
+@section Communicating with C
+
+The language indicant @code{@B{C}} is used to access C variables and
+calling C functions:
+
+@example
+@B{nest} @B{C} "[&]symbol"
+@end example
+
+The row char denotation should contain a symbol corresponding to a C
+variable or function, optionally preceded by an ampersand @code{&}.
+It is the responsibility of the programmer to make sure the specified
+symbol actually corresponds to an entity with the right type. In case
+a malformed symbol is specified it will very likely result in an
+assembler error.
+
+For example, this is how we can access a C variable as an Algol 68
+constant:
+
+@example
+@B{int} counter = @B{nest} @B{C} "counter";
+
+@B{if} counter = 0
+@B{then} ... @B{fi};
+@end example
+
+If we wanted to be able to change the value of the C variable
+@code{counter} then we need to add a leading ampersand to the row
+denotation, and of course change the mode on the Algol 68 side to a
+@code{@B{ref} @B{int}}:
+
+@example
+@B{ref} @B{int} counter = @B{nest} @B{C} "&counter";
+
+counter +:= 1;
+@end example
+
+If we wanted to access a C pointer variable @code{int *ptr} as an
+Algol 68 name we could do:
+
+@example
+@B{ref} @B{int} ptr = @B{nest} @B{C} "ptr";
+
+ptr := 100; @{ Changes the value pointed by the C pointer ptr,
+ not of ptr itself @}
+@end example
+
+If we wanted to call the standard POSIX functions @code{random} and
+@code{srandom} we could do:
+
+@example
+@B{proc} @B{long} @B{int} random = @B{nest} @B{C} "random";
+@B{proc}(@B{bits})@B{void} srandom = @B{nest} @B{C} "srandom";
+
+@B{if} random < 100 @B{then} ... @B{fi}
+@end example
+
+The modes accepted in a formal hole for C are:
+
+@table @asis
+@item @code{@B{void}}
+As C @code{void}.
+@item @code{@B{bool}}
+As C @code{bool}.
+@item @code{@B{char}}
+As C 32-bit integer.
+@item @code{@B{int}}
+As C @code{int}.
+@item @code{@B{short} @B{int}}
+As C @code{short}.
+@item @code{@B{short} @B{short} @B{int}}
+As C @code{char}.
+@item @code{@B{long} @B{int}}
+As C @code{long} or as C @code{int}.
+@item @code{@B{long} @B{long} @B{int}}
+As C @code{long long} or as C @code{long} or as C @code{int}.
+@item @code{@B{bits}}
+As C @code{unsigned int}.
+@item @code{@B{short} @B{bits}}
+As C @code{unsigned short}.
+@item @code{@B{short} @B{short} @B{bits}}
+As C @code{unsigned char}.
+@item @code{@B{long} @B{bits}}
+As C @code{unsigned long} or as C @code{unsigned int}.
+@item @code{@B{long} @B{long} @B{bits}}
+As C @code{unsigned long long} or as C @code{unsigned long} or as C @code{unsigned int}.
+@item @code{@B{real}}
+As C @code{float}
+@item @code{@B{long} @B{real}}
+As C @code{double}
+@item @B{proc} with accepted formal parameter modes and yielded mode
+As the corresponding C functions.
+@item Structs with fields of accepted modes
+As the corresponding C structs.
+@end table
+
@node Comments and pragmats
@chapter Comments and pragmats
5.6.1 Syntax
-A) LANGUAGE :: algol sixty eight ; fortran ; c language ; cpp language.
-B) ALGOL68 :: algol sixty eight.
-C) FORTRAM :: fortran.
-D) CLANG :: c language.
-E) CPPLANG :: cpp language.
-F) DLANG :: d language.
+A) LANGUAGE :: algol sixty eight ; c language.
+B) CODE :: CAIN ; CLAN ; reference to CAIN ;
+ procedure with PERFORMERS yieling COID ;
+ procedure yielding COID.
+C) PERFORMERS :: PERFORMER ; PERFORMERS PERFORMER.
+D) PERFORMER :: CODE parameter.
+E) COID :: CODE ; void.
+F) CAIN :: real ; long real ; integral ; BITS ; boolean ; char.
a) strong MOID NEST virtual hole{5A} :
virtual nest symbol, strong MOID NEST closed clause{31a}.
strong MOID NEST ENCLOSED clause{31a,33a,c,34a,35a,36a,-}.
d) hole indication{b} :
character denotation{814a} ; row of character denotation{83a}.
-e) MOID ALGOL68 indication{b} : EMPTY.
-f) MOID FORTRAN indication{b} : bold letter f letter o letter r letter t
- letter r letter a letter n token.
-g) MOID CLANG indication{b} : bold letter c letter l letter a letter n
- letter g.
-e) MOID CPPLANG indication{b} : bold letter c letter p letter p letter l
- letter a letter n letter g.
-f) MOID DLANG indication{b} : bold letter d letter l letter a letter n
- letter g.
+e) MOID algol sixty eight indication{b} : EMPTY.
+f) COID c language indication{b} : bold letter c token.
+
+{ COID-c-language-indication restricts the `MOID's to the set for
+ which a C equivalence can be immediately determined by the compiler
+ without any additional information. }
{ Since no representation is provided for the virtual-nest-symbol, the
user is unable to construct virtual-holes for himself, but a
--- /dev/null
+begin int foo =
+ nest XYZ { dg-error "valid language" }
+ "foo";
+ skip
+end
--- /dev/null
+begin int foo =
+ nest C
+ 200; { dg-error "denotation" }
+ int bar =
+ nest
+ 3.14; { dg-error "denotation" }
+ skip
+end
--- /dev/null
+begin int foo = 10 + (nest C "foo"); { dg-error "strong context" }
+ int bar = 20 + (nest "bar"); { dg-error "strong context" }
+ assert (foo = 10)
+end
--- /dev/null
+begin string s =
+ nest C "lala"; { dg-error "" }
+ union(int,real) x =
+ nest C "x"; { dg-error "" }
+ proc(string)bool y =
+ nest C "y"; { dg-error "" }
+ skip
+end
--- /dev/null
+begin int lala = nest C "&lala"; { dg-error "name" }
+ skip
+end
--- /dev/null
+begin proc real myrandom = nest C "_libga68_random";
+ real r = myrandom;
+ assert (r >= 0.0 AND r <= 1.0)
+end
projects / thirdparty / gcc.git / commitdiff
